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