commit 8a2ccd6
zzo38
·
2025-08-25 06:47:48 +0000 UTC
parent 0bce215
Add prg/dealcards.tal
1 files changed,
+50,
-0
+50,
-0
1@@ -0,0 +1,50 @@
2+|0100
3+ LIT2r ff33
4+ #c3 DEI2 INC2 ;random/x STA2
5+ #c5 DEI2 #c1 DEI2 EOR2 INC2 ;random/y STA2
6+ #17 DEI ?input
7+@begin
8+ ;deck
9+ \\ Select random card
10+ STHrk DUP #04 SFT ORA DUP #02 SFT ORA DUP #01 SFT ORA
11+ DUP [@ POP random ADD OVR AND DUP STHrk GTH ]?
12+ NIP ADD LDAk
13+ \\ Display card
14+ LIT2r =ranks STHk LITr 0f ANDr ADDr LDAr LITr 18 DEOr
15+ LIT2r =suits STH LITr 04 SFTr ADDr LDAr LITr 18 DEOr
16+ \\ Exchange card
17+ LIT2r =deck ROTrk ADDr LDAr STH2 STAr POP2r
18+ \\ Space
19+ STHrk #0d DIVk MUL NEQ #16 MUL #0a ADD #18 DEO
20+ \\ Next
21+ STHrk [? #800f DEO BRK ]@
22+ ADDrk NIPr !begin
23+
24+@deck
25+ \_@
26+ 00 01 02 03 04 05 06 07 08 09 0a 0b 0c
27+ 10 11 12 13 14 15 16 17 18 19 1a 1b 1c
28+ 20 21 22 23 24 25 26 27 28 29 2a 2b 2c
29+ 30 31 32 33 34 35 36 37 38 39 3a 3b 3c
30+ \_@1-^ff00"&[@E]
31+
32+\_@
33+@suits "cdhs
34+@ranks "A23456789TJQK
35+\_@1-^ff00"&[@E]
36+
37+@input
38+ [; #10 DEO2 BRK ]@
39+ #0417 DEI EQU ?begin
40+ random SUB #12 DEI ;random/x STA2
41+ BRK
42+
43+@random ( -- number* )
44+ ,&x LDR2
45+ DUP2 #50 SFT2 EOR2
46+ DUP2 #03 SFT2 EOR2
47+ ,&y LDR2 DUP2 ,&x STR2
48+ DUP2 #01 SFT2 EOR2 EOR2
49+ ,&y STR2k POP
50+ JMP2r
51+ &x $2 &y $2