commit 0d78c0d
zzo38
·
2026-02-28 06:48:24 +0000 UTC
parent 37085b3
Add prg/elemental.tal
1 files changed,
+406,
-0
+406,
-0
1@@ -0,0 +1,406 @@
2+( Screen layout:
3+ .....................
4+ .....XX.XX.......XX..
5+ .....XX.XX.......XX..
6+ .....................
7+ ..XX.XX.XX.XX....XX..
8+ ..XX.XX.XX.XX....XX..
9+ .....................
10+ ..XX.XX.XX.XX....XX..
11+ ..XX.XX.XX.XX....XX..
12+ .....................
13+ .....XX.XX.......XX..
14+ .....XX.XX.......XX..
15+ .....................
16+ Score:00.......Mani:3
17+ list of cards in pile
18+ list of cards in pile
19+)
20+
21+|0000
22+ @Spare $40
23+ @Height $10 ( Height+(Y<<2)+X; note Height is aligned at 0x10 bytes )
24+ @Score $1
25+ @Mani $1
26+ @Cursor &X $1 &Y $1
27+ @Mark &X $1 &Y $1
28+ @Tableau-1 $1 @Tableau
29+ ( Tableau cards at: Tableau+(0xA*((Y<<2)+X)); Z(0=bottom) )
30+ ( Set high bit of cards if it is face down )
31+
32+|0100
33+ \\ Colours
34+ #a0a1 #08 DEO2k #5402 ADD2 DEO2k #bb02 ADD2 DEO2
35+ \\ Screen
36+ #00a8 #22 DEO2k #d802 ADD2 DEO2
37+ #0126 DEO
38+ \\ Sound
39+ DUP2k EOR2 #38 DEO2k #0402 ADD2 DEO2
40+ ;Wave #3c DEO2
41+ \\ Vectors
42+ ;inputVec #80 DEO2
43+ \\ Random numbers
44+ #c1 DEI2 #c3 DEI2 EOR2 INC ;random/x STA2
45+ #c5 DEI2 #c7 DEI2 ADD2 INC ;random/y STA2
46+ ;RandomExt #02 DEO2
47+ random random POP2 random random POP2
48+@reset
49+ \\ Initialize variables
50+ [& 00 0100 0000 0000 00 ]@ LITr 02 DEO2r
51+ LIT2 03 -Mani STZ
52+ \\ Set up deck
53+ #4000 [@ #01 OVR #03 AND #40 SFT SFT OVR STZ INC EORk ]?
54+ \\ Mix up cards
55+ #33 [@
56+ DUPk #04 SFT ORA DUP #02 SFT ORA DUP EQUk SFT ORA random AND LTHk
57+ [?
58+ STH2k LDZ SWPr LDZr OVR STZ SWPr STZr
59+ #01 SUB DUP
60+ ]@
61+ POP DUP #03 NEQ ]?
62+ \\ Deal cards (now the stack has #03 on top)
63+ LITr 01 [@
64+ #04 STHrk .Height ADD STZ
65+ STHrk #0a MUL deal1 deal1 deal1 deal1 POP
66+ INCr DUPr LITr 03 EQUr ADDr DUPr LITr 0c EQUr ADDr
67+ STHrk #0f NEQ ]?
68+ \\ Ready
69+ sound fd 54 4f 4c 43 4f 00
70+@display
71+ \\ Tableau
72+ LITr 01 [@
73+ STHrk #03 AND STHrk #02 SFT cursorxy
74+ .Height STHrk ADD LDZ
75+ DUP [? showcard ][ STHrk #0a MUL ADD .Tableau-1 ADD revealcard ]@
76+ INCr DUPr LITr 03 EQUr ADDr DUPr LITr 0c EQUr ADDr
77+ STHrk #0f NEQ ]?
78+ \\ Spare
79+ #0500 dispspare dispspare POP
80+ \\ Status
81+ #000d showixy [' "Score: ]' 00
82+ .Score LDZk #0a DIVk DUP [' #30 ]' ADD showc MUL SUB [' #30 ]' ADD showc
83+ #0f0d showixy [' "Mani: ]' 00
84+ LIT2 [' 30 ]' -Mani LDZ ADD showc
85+@showcursor ( -- )
86+ \\ Contents of pile
87+ #0029 DEO #702b DEO #802e DEO
88+ LIT2 03 -Cursor/X LDZ LTH [?
89+ LIT2 -Tableau -Cursor LDZ2 #20 SFT ADD STHk #0a MUL ADD
90+ LITr -Height ADDr LDZr STHk ADDr
91+ [@
92+ DUP STHrk EQU ?/x
93+ LDZk DUP #80 LTH [? POP #07 ]@ showcard
94+ INC
95+ ]! &x
96+ ]@
97+ \\ Cursor position
98+ cls2
99+ LIT2 0d -Score LDZ GTH [? #000e showixy [' "You 20 "win! ]' 00 BRK ]@
100+ .Cursor cursorat ;Cards/cursor showoverlay
101+ .Mark LDZ2k ORA [? BRK ]@ cursorat ;Cards/mark showoverlay BRK
102+
103+@deal1
104+ STH INC LDZk #80 ORA
105+ STHrk .Tableau ADD STZ
106+ STHr INC JMP2r
107+
108+@RandomExt
109+ 03 f0
110+ 4105 259c e061 11f0 963f 0026 1874 5416
111+ $1 00 10 =random
112+
113+@inputVec
114+ LIT2 &mem ff82 DEI EQUk ?/brk
115+ DUPk ,&mem STR #08 EQU ?reset
116+ LIT2 0c -Score LDZ LTH ?/brk
117+ DUPk #80 EQU ?/r #40 EQU ?/l
118+ DUPk #20 EQU ?/d #10 EQU ?/u
119+ DUP #02 EQU ?/b #01 EQU ?/a
120+ &sh showcursor &brk BRK
121+
122+ &r
123+ .Cursor/X LDZk DUP #05 LTH ADD DUP #04 EQU ADD &rsh SWP STZ
124+ !/sh
125+
126+ &l
127+ .Cursor/X LDZk DUPk DIV SUB DUP #04 EQU SUB
128+ !/rsh
129+
130+ &d
131+ .Cursor/Y LDZk DUP #03 LTH ADD
132+ !/rsh
133+
134+ &u
135+ .Cursor/Y LDZk DUPk DIV SUB
136+ !/rsh
137+
138+ &b
139+ LITr -Cursor LDZ2r DUP2r LITr 20 SFTr ADDr
140+ .Mark LDZ2 ORAk ?/un ( 00 00 )
141+ STHrk .Height ADD LDZ EQU ?/sh ( 00 )
142+ LIT2 05 -Cursor/X LDZ EQU ?/sh /nm
143+ LIT2 02 -Cursor LDZ2 #0303 ADD2 ORA AND [?
144+ \\ Move card aside
145+ LDZk NEQk LDZk DUP DIV ADD LDZk DUP DIV ADD LDZk DUP DIV ADD
146+ DUP #04 NEQ ?/s
147+ ][
148+ \\ Move top card only
149+ .Mani LDZ EQU [?
150+ STHrk topcard DUP #00 EQU ?/sh
151+ DUPr LIT2r 0009 SFT2r [& 0201 080b 0407 0e0d ]@ ADD2r LDAr
152+ STHrk topcard ?/sh
153+ #01 STHrk .Height ADD STZ
154+ STHr #0a MUL .Tableau ADD STZ
155+ LITr -Height ADDr LDZrk LITr 01 SUBr SWPr STZr
156+ LIT2 ff -Mani LDZ ADD .Mani STZ
157+ sound fe 4c 49 43 42 00
158+ ]@
159+ ]@
160+ &un DUP2k EOR2 .Mark STZ2 !display
161+
162+ &a
163+ .Cursor LDZ2
164+ .Mark LDZ2 ORAk [?
165+ \\ Not already marked, so set the mark
166+ SWP2
167+ OVR #05 NEQ [?
168+ ;Mani LDZ EQU ?/sh
169+ ;Cursor/Y LDZ LDZ
170+ ][
171+ DUP2 #20 SFT ADD .Height ADD LDZ #00
172+ ]@
173+ EQU ?/sh .Mark STZ2
174+ sound fd e0 00
175+ ][
176+ EQU2k ?/un /nm
177+ OVR #05 NEQ [?
178+ \\ Check if card should be moved from outside into the tableau
179+ LITr 00 STH STH
180+ OVR STHr EQU ?/un
181+ #20 SFT ADD
182+ DUP ,/ah STR
183+ .Height ADD LDZk
184+ DUP #0a EQU ?/un
185+ STHrk LDZ STZr ( height_address height_value card )
186+ .Mani LDZk #01 SUB SWP STZ
187+ OVR LIT &ah $1 #0a MUL .Tableau ADD ADD STZ
188+ INC SWP STZ
189+ sound fe 4c 48 43 41 00
190+ !/un
191+ ]@
192+ OVR2 OVR #05 NEQ [?
193+ \\ Check if card should be moved to spare side
194+ LDZk ?/un
195+ POP2 #20 SFT ADD STH !/s
196+ ]@
197+ #20 SFT ADD
198+ ( cx cy mx my cxy )
199+ \\ Check for moving a pile to a adjacent empty cell
200+ DUP .Height ADD LDZ [?
201+ ;Mani LDZ EQU ?/un
202+ STHk #0a MUL .Tableau ADD ;movepile/d STA
203+ \\ Check if it is adjacent
204+ SUB2k ( cx-mx-[cy<my] cy-my ) \\ 0001 0100 ff00 ffff
205+ DUP2k INC2k SUB2 EQU2k STH INC EQU2 STHk INCk EQU2k STH SWP EQU2 STH2r STHr ORA2 ORA
206+ #00 EQU ?/un
207+ \\ It is OK
208+ #20 SFT ADD
209+ DUP #0a MUL .Tableau ADD ;movepile/s STA
210+ .Height ADD LITr -Height ADDr
211+ LDZk STHr STZ #00 SWP STZ
212+ ;movepile #02 DEO2
213+ .Mani LDZk #01 SUB SWP STZ
214+ sound ff 48 4a 00
215+ !/un
216+ ]@
217+ \\ Check for scoring
218+ LITr 00 STH
219+ \\ (Difference of X coordinates must be odd, and same with Y coordinates)
220+ EOR2k AND #01 ANDk NEQ NIP ?/un
221+ #20 SFT ADD
222+ DUP topcard STHrk topcard ORA
223+ SWP STH STH2rk
224+ #030c AND2 ORA topcard STH2rk #0c03 AND2 ORA STHk topcard ORA ORA
225+ #0f NEQ ?/un
226+ ROTrk EORr EORr
227+ LIT2 0d -Score LDZ INC DUP2 EQU .Mani LDZ MUL ADD .Score STZ
228+ LIT2 03 -Mani STZ
229+ [@ LITr -Height ADDr LDZrk LITr 01 SUBr SWPr STZr STHrk ]?
230+ sound fe 3c 48 4f 54 5b 00
231+ LIT2 0d -Score LDZ GTH ?/un
232+ sound fd 30 3c 43 48 37 43 47 4a 4f 3c 48 4f 54 00
233+ !display
234+ ]@
235+ !/sh
236+
237+ &s
238+ \\ Move to spare
239+ \\ (Now the primary stack has the slot number #00 to #03)
240+ \\ (Now the secondary stack has the cursor position number #00 to #0f)
241+ STHrk INC topcard STHrk #01 SUB topcard
242+ STHrk #04 ADD topcard STHrk #04 SUB topcard
243+ ORA2 ORA #0f EOR [?
244+ LIT2 03 -Mani STZ
245+ STHrk .Height ADD LDZk DUP #01 SUB ROT STZ ( spare height )
246+ LITr 0a MULr STH ADDr LITr -Tableau-1 ADDr LDZr STH STZr
247+ sound fd 48 4c 43 48 00
248+ ]@
249+ !/un
250+
251+ \\ Make sure cursor is not on a corner
252+ &nm .Cursor LDZ2 #03 DIVk MUL SUB SWP #03 DIVk MUL SUB ORA ?return !/un
253+
254+@movepile 01 000a 0000 00 &s 00 0000 00 &d 00
255+
256+@topcard ( position -- card )
257+ DUP #10 LTH [? POP #00 JMP2r ]@
258+ DUP .Height ADD LDZ DUP [? NIP JMP2r ]@
259+ .Tableau-1 ADD SWP #0a MUL ADD LDZ JMP2r
260+
261+@cls cls2 #802e DEO JMP2r
262+@cls2 DUP2k EOR2 #28 DEO2k INC INC DEO2 #c02e DEO @return JMP2r
263+
264+@dispspare [& ]@ DUP2 cursorxy LDZk showcard INC JMP2r
265+
266+@cursorat ( addr -- )
267+ LDZ2
268+@cursorxy ( x y -- )
269+ #03 MUL INC #0005 SFT2 #2a DEO2
270+ #03 MUL INC INC #0005 SFT2 #28 DEO2
271+ JMP2r
272+
273+@random ( -- number )
274+ LIT2 &x 0001
275+ DUP2 #50 SFT2 EOR2
276+ DUP2 #03 SFT2 EOR2
277+ LIT2 &y 0001 DUP2 ,&x STR2
278+ DUP2 #01 SFT2 EOR2 EOR2
279+ ,&y STR2k POP2
280+ JMP2r
281+
282+@showc ( char -- )
283+ #0005 SFT2 ;Font ADD2 #2c DEO2
284+ #012f DEO
285+ JMP2r
286+
287+@showixy ( x y -- )
288+ #0005 SFT2 #2a DEO2
289+ #0005 SFT2 #28 DEO2
290+@showi ( -- )
291+ [@
292+ LDArk STHr INC2r DUP [? POP JMP2r ]@
293+ #0005 SFT2 ;Font ADD2 #2c DEO2
294+ #012f DEO
295+ ]!
296+
297+@revealcard ( addr -- )
298+ LDZk #7f AND SWPk STZ NIP
299+@showcard ( card -- )
300+ #0005 SFT2 ;Cards ADD2 #2c DEO2
301+ #012f DEO #112f DEO
302+ #2b DEIk STHk #08 ADD SWP DEO
303+ #212f DEO #312f DEO
304+ LITr 2b DEOr #29 DEIk #10 ADD SWP DEO
305+ JMP2r
306+
307+@showoverlay ( picture* -- )
308+ #2c DEO2
309+ #c52f DEO #d52f DEO
310+ #2b DEIk #08 ADD SWP DEO
311+ #e52f DEO #f52f DEO
312+ JMP2r
313+
314+@sound ( -- )
315+ #ee3e DEO
316+ STH2rk LDAk ,&len STR INC2 ,&addr STR2
317+ [@ STH2rk INC2r LDA ]?
318+ LIT2 00 _&time STR
319+ [; #20 DEO2 JMP2r ]@
320+ LIT &time $1 DUP [?
321+ LIT2 &addr $2 INC2k ,&addr STR2 LDA
322+ DUP [? DUP #3e DEO DUPk #20 DEO2 ]@
323+ #3f DEO
324+ POP LIT &len $1
325+ ]@ INC ,&time STR BRK
326+
327+@Cards
328+
329+@Cards/vacant
330+ \-01010101
331+ \-1.......
332+ \-0.......
333+ \-1.......
334+ \-0.......
335+ \-1.......
336+ \-0.......
337+ \-1.......;
338+
339+ \-11111111
340+ \-1.......
341+ \-1.......
342+ \-1......1
343+ \-1......1
344+ \-1......1
345+ \-1......1
346+ \-1..11111;
347+
348+ \-11111111
349+ \-1.......
350+ \-1.......
351+ \-1..11...
352+ \-1..111..
353+ \-1...111.
354+ \-1....111
355+ \-1.....11;
356+@Wave 00 7f ff 80
357+ $4
358+
359+ \-11111111
360+ \-1.......
361+ \-1....111
362+ \-1...1111
363+ \-1..111..
364+ \-1.111...
365+ \-1.11....
366+ \-1.11....;
367+
368+@Cards/cursor
369+ \=32222223
370+ \=23333332
371+ \=23......
372+ \=23......
373+ \=23......
374+ \=23......
375+ \=23......
376+ \=32......;
377+
378+@Cards/back
379+ \-11111111
380+ \-10010010
381+ \-10010010
382+ \-11111111
383+ \-10010010
384+ \-10010010
385+ \-11111111
386+ \-10010010;
387+
388+ \-11111111
389+ \-1.......
390+ \-1.......
391+ \-1......1
392+ \-1.....11
393+ \-1....111
394+ \-1...1111
395+ \-1..11111;
396+
397+@Cards/mark
398+ \=........
399+ \=........
400+ \=..232323
401+ \=..3.....
402+ \=..2.....
403+ \=..3.....
404+ \=..2.....
405+ \=..3.....;
406+
407+\mk3039 \m20~ascii.font \@Font