2024-07-12 22:42:41 -04:00
|
|
|
( deck.tal )
|
|
|
|
|
|
|
|
|
|
|00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
|
|
|
|
|
|10 @Console [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ]
|
|
|
|
|
|20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
|
|
|
|
|
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
|
|
|
|
|
|90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
|
|
|
|
|
|a0 @File1 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
|
|
|
|
|b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
|
|
|
|
|c0 @DateTime [ &y $2 &m $1 &d $1 &hr $1 &min $1 &sec $1 &dow $1 &doy $2 &isdst $1 ]
|
|
|
|
|
|
|
|
|
|
( 1 byte per card )
|
|
|
|
|
( #01 ace ... #0d king )
|
|
|
|
|
( #00 club #10 diamond #20 spade #30 heart )
|
|
|
|
|
( #00 face up, #40 face down )
|
|
|
|
|
( #00 normal #80 held )
|
|
|
|
|
( examples: )
|
|
|
|
|
( - #00 no card )
|
|
|
|
|
( - #01 ace of clubs )
|
|
|
|
|
( - #1a ten of diamonds )
|
|
|
|
|
( - #24 four of hearts )
|
|
|
|
|
( - #3d king of spades )
|
|
|
|
|
( - #6c queen of hearts, face down )
|
|
|
|
|
( - #93 three of diamonds, held )
|
|
|
|
|
|
|
|
|
|
|0000
|
|
|
|
|
|
2024-07-13 23:07:54 -04:00
|
|
|
@stock $34 ( draw pile - 52 bytes, 24 bytes at start )
|
2024-07-12 22:42:41 -04:00
|
|
|
@waste $18 ( face up pile - 24 bytes )
|
|
|
|
|
@foundation $4 ( one per suit - 4 bytes, 4x1 )
|
|
|
|
|
@tableau $85 ( the main board - 133 bytes, 7x19 )
|
|
|
|
|
|
|
|
|
|
@prev-button $1
|
|
|
|
|
@prev-mouse-state $1
|
|
|
|
|
@prev-mouse-x $2
|
|
|
|
|
@prev-mouse-y $2
|
|
|
|
|
@card-is-held $1
|
|
|
|
|
|
|
|
|
|
|0100
|
|
|
|
|
#2d8b .System/r DEO2
|
|
|
|
|
#2d18 .System/g DEO2
|
|
|
|
|
#2d14 .System/b DEO2
|
|
|
|
|
|
|
|
|
|
#0100 .Screen/w DEO2
|
|
|
|
|
#00c0 .Screen/h DEO2
|
|
|
|
|
|
|
|
|
|
init-rng-from-datetime
|
|
|
|
|
init-stock init-waste init-foundation
|
|
|
|
|
shuffle-stock deal-tableau
|
|
|
|
|
|
2024-07-13 23:07:54 -04:00
|
|
|
( for now, we'll deal the first 3 cards to the waste for testing )
|
|
|
|
|
( TODO: implement deal-waste )
|
|
|
|
|
#17 LDZ #bf AND .waste #00 ADD STZ #0017 STZ
|
|
|
|
|
#16 LDZ #bf AND .waste #01 ADD STZ #0016 STZ
|
|
|
|
|
#15 LDZ #bf AND .waste #02 ADD STZ #0015 STZ
|
|
|
|
|
|
|
|
|
|
draw-background
|
|
|
|
|
draw-stock
|
|
|
|
|
draw-waste
|
|
|
|
|
draw-foundation
|
|
|
|
|
draw-tableau
|
2024-07-12 22:42:41 -04:00
|
|
|
;on-mouse .Mouse/vect DEO2
|
|
|
|
|
( ;on-key .Controller/vect DEO2 )
|
|
|
|
|
BRK
|
|
|
|
|
|
|
|
|
|
@init-stock ( -> )
|
|
|
|
|
LITr -stock #8000 #4e41
|
|
|
|
|
&outer DUP2
|
|
|
|
|
&inner DUP STHkr STZ INC INCr GTHk ?&inner
|
|
|
|
|
POP2 #1010 ADD2 GTH2k ?&outer
|
|
|
|
|
POP2 POP2 POPr JMP2r
|
|
|
|
|
|
|
|
|
|
@init-waste ( -> )
|
|
|
|
|
#00 LITr -waste LITr 18 OVRr ADDr SWPr
|
|
|
|
|
&loop DUP STHkr STZ INCr GTHkr STHr ?&loop
|
|
|
|
|
POP POP2r JMP2r
|
|
|
|
|
|
|
|
|
|
@init-foundation
|
|
|
|
|
#00 .foundation
|
|
|
|
|
STZk INC STZk INC STZk INC STZk POP2
|
|
|
|
|
JMP2r
|
|
|
|
|
|
|
|
|
|
@shuffle-stock ( -> )
|
|
|
|
|
.stock #33 OVR ADD SWP ( last^ start^ )
|
|
|
|
|
&loop ( last^ pos^ )
|
|
|
|
|
SUBk INC #00 SWP ( last^ pos^ n=last-pos+1* )
|
|
|
|
|
random SWP2 ( last^ pos^ r* n* )
|
|
|
|
|
DIV2k MUL2 SUB2 NIP ( last^ pos^ i=r%n^ )
|
|
|
|
|
OVR ADD LDZk ,&c STR ( last^ pos^ alt=pos+i^ ; c<-alt )
|
|
|
|
|
STH LDZk STHr STZ STH ( last^ [pos^] ; alt<-pos )
|
|
|
|
|
LIT [ &c $1 ] STHkr STZ ( last^ [pos^] ; pos<-c )
|
|
|
|
|
STHr INC GTHk ?&loop ( last^ pos+1^ )
|
|
|
|
|
POP2 JMP2r ( )
|
|
|
|
|
|
|
|
|
|
@deal-tableau ( -> )
|
|
|
|
|
#33 LIT2r -tableau 00
|
|
|
|
|
&loop STH2kr deal-column
|
|
|
|
|
LIT2r 1301 ADD2r
|
|
|
|
|
STHkr #07 LTH ?&loop
|
|
|
|
|
POP2r POP JMP2r
|
|
|
|
|
|
|
|
|
|
@deal-column ( src^ dst^ count^ -> src2^ )
|
|
|
|
|
#00 SWP SUB STH SWP ( dst^ src^ [-count^] )
|
|
|
|
|
&loop STHkr ?&ok !&done ( d^ s^ [-c^] )
|
|
|
|
|
&ok DUP2 LDZ SWP STZ ( d^ s^ [-c^] ; d<-s|64 )
|
|
|
|
|
#01 SUB SWP INC SWP ( d+1^ s-1^ [-c^] )
|
|
|
|
|
INCr !&loop ( d+1^ s-1^ [-c+1^] )
|
|
|
|
|
&done POPr SWP ( s^ d^)
|
|
|
|
|
OVR LDZ #bf AND SWP STZ ( s^ ; d<-s )
|
2024-07-13 23:07:54 -04:00
|
|
|
#00 OVR STZ ( s^ ; s<-0 )
|
2024-07-12 22:42:41 -04:00
|
|
|
#01 SUB JMP2r ( s-1^ )
|
|
|
|
|
|
|
|
|
|
@swap-c ( src^ dst^ -> )
|
|
|
|
|
LDZk STH ( src^ dst^ [d^] )
|
|
|
|
|
OVR LDZ ( src^ dst^ s^ [d^] )
|
|
|
|
|
SWP STZ ( src^ [d^] ; dst<-s )
|
|
|
|
|
STHr SWP ( d^ src^ )
|
|
|
|
|
STZ JMP2r ( ; src<-d )
|
|
|
|
|
|
|
|
|
|
@draw-stock ( -> )
|
|
|
|
|
#0008 ,&y STR2 ( ; y0<-8 )
|
|
|
|
|
.stock #34 OVR ADD SWP LITr 01 ( stock+52 stock^ [n^] )
|
|
|
|
|
&loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ [n^] )
|
|
|
|
|
&ok ( lim^ zp^ c^ [n^] )
|
|
|
|
|
#0008 .Screen/x DEO2 ( lim^ zp^ c^ [n^] ; x<-8 )
|
|
|
|
|
LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ c^ [n^] ; y<- )
|
|
|
|
|
draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c )
|
|
|
|
|
,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 )
|
|
|
|
|
&skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] )
|
2024-07-13 23:07:54 -04:00
|
|
|
&done POP POP2 POPr JMP2r ( )
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
@draw-waste ( -> )
|
|
|
|
|
#001c ,&x STR2 ( ; x0<-28 )
|
|
|
|
|
.waste #18 OVR ADD SWP ( waste+24^ waste^ )
|
|
|
|
|
&loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ )
|
|
|
|
|
&ok ( lim^ zp^ c^ )
|
|
|
|
|
#0008 .Screen/y DEO2 ( lim^ zp^ c^ ; y<-8 )
|
|
|
|
|
LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ zp^ c^ ; x<- )
|
|
|
|
|
draw-c ( lim^ zp^ ; draw c )
|
|
|
|
|
,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 )
|
|
|
|
|
INC GTHk ?&loop ( lim^ zp+1^ )
|
2024-07-13 23:07:54 -04:00
|
|
|
&done POP POP2 JMP2r ( )
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
@draw-foundation ( -> )
|
|
|
|
|
#0030 ,&y STR2 ( ; y0<-48 )
|
|
|
|
|
.foundation #04 OVR ADD SWP ( lim^ zp^ )
|
|
|
|
|
&loop ( lim^ zp^ )
|
|
|
|
|
#0008 .Screen/x DEO2 ( lim^ zp^ ; x<-8 )
|
|
|
|
|
LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ ; y<- )
|
|
|
|
|
LDZk maybe-draw-c ( lim^ zp^ ; draw )
|
|
|
|
|
,&y LDR2 #0020 ADD2 ,&y STR2 ( lim^ zp^ ; y<-y+32 )
|
|
|
|
|
INC GTHk ?&loop ( lim^ zp+1^ )
|
|
|
|
|
POP2 JMP2r ( )
|
|
|
|
|
|
|
|
|
|
@draw-tableau
|
2024-07-13 23:07:54 -04:00
|
|
|
#0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
@draw-column ( idx^ -> )
|
|
|
|
|
#00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx )
|
|
|
|
|
#0024 ,&y STR2 ( idx^ ; y<-32 )
|
|
|
|
|
#13 MUL .tableau ADD ( pos=t+idx*19^ )
|
|
|
|
|
DUP #13 ADD SWP ( lim=pos+19^ pos^ )
|
|
|
|
|
&loop ( lim^ pos^ )
|
|
|
|
|
LDZk DUP ?&ok !&done ( lim^ pos^ c^ )
|
|
|
|
|
&ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ ; s/x<-x )
|
|
|
|
|
LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ pos^ ; s/y<-y )
|
|
|
|
|
draw-c INC ( lim^ pos+1^ )
|
|
|
|
|
,&y LDR2 #0008 ADD2 ,&y STR2 ( lim^ pos+1^ )
|
|
|
|
|
GTHk ?&loop ( lim^ pos+1^ )
|
|
|
|
|
&done POP POP2 JMP2r ( )
|
|
|
|
|
|
|
|
|
|
@maybe-draw-c
|
|
|
|
|
DUP ?{ POP !draw-mask-down } !draw-c
|
|
|
|
|
|
|
|
|
|
( assumes x/y already set )
|
|
|
|
|
@draw-c ( card^ -> )
|
|
|
|
|
DUP #40 LTH ?&norm
|
|
|
|
|
DUP #80 LTH ?&down
|
|
|
|
|
DUP #c0 LTH ?&held
|
|
|
|
|
POP !draw-mask-down
|
|
|
|
|
&norm adjust-c !draw-face-up
|
|
|
|
|
&down POP !draw-face-down
|
2024-07-13 23:07:54 -04:00
|
|
|
&held #3f AND adjust-c !draw-mask-up
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
( we map from our sparse, logical card format )
|
|
|
|
|
( to the dense, tile position card location )
|
|
|
|
|
( clubs: #01 -> #27 ... #0d -> #33 )
|
|
|
|
|
( diamonds: #11 -> #1a ... #1d -> #26 )
|
|
|
|
|
( spades: #21 -> #00 ... #2d -> #0c )
|
|
|
|
|
( hearts: #31 -> #0d ... #3d -> #19 )
|
|
|
|
|
@adjust-c ( card^ -> idx* )
|
|
|
|
|
#00 SWP
|
|
|
|
|
DUP #21 LTH ?<
|
|
|
|
|
DUP #31 LTH #03 MUL ADD #24 SUB JMP2r
|
|
|
|
|
< DUP #11 LTH #1d MUL ADD #09 ADD JMP2r
|
|
|
|
|
|
|
|
|
|
@on-mouse ( -> brk )
|
|
|
|
|
on-move
|
2024-07-13 20:45:22 -04:00
|
|
|
on-click-down
|
2024-07-12 22:42:41 -04:00
|
|
|
( on-click-up )
|
|
|
|
|
.Mouse/state DEI .prev-mouse-state STZ
|
|
|
|
|
BRK
|
|
|
|
|
|
|
|
|
|
@on-move ( -> )
|
2024-07-13 23:07:54 -04:00
|
|
|
.Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?draw-mouse
|
|
|
|
|
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?draw-mouse
|
2024-07-12 22:42:41 -04:00
|
|
|
JMP2r
|
2024-07-13 20:45:22 -04:00
|
|
|
|
|
|
|
|
@draw-mouse ( -> )
|
|
|
|
|
#00 .Screen/auto DEO
|
|
|
|
|
clear-prev-mouse !draw-curr-mouse
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
@clear-prev-mouse ( -> )
|
|
|
|
|
.prev-mouse-x LDZ2 .Screen/x DEO2
|
|
|
|
|
.prev-mouse-y LDZ2 .Screen/y DEO2
|
|
|
|
|
;blank .Screen/addr DEO2
|
|
|
|
|
#41 .Screen/sprite DEO JMP2r
|
|
|
|
|
|
|
|
|
|
@draw-curr-mouse ( -> )
|
|
|
|
|
.Mouse/x DEI2 DUP2 .prev-mouse-x STZ2 .Screen/x DEO2
|
|
|
|
|
.Mouse/y DEI2 DUP2 .prev-mouse-y STZ2 .Screen/y DEO2
|
|
|
|
|
;cursor .Screen/addr DEO2
|
|
|
|
|
#43 .Screen/sprite DEO JMP2r
|
|
|
|
|
|
|
|
|
|
@on-click-down ( -> )
|
|
|
|
|
.Mouse/state DEI ( state^ )
|
|
|
|
|
.prev-mouse-state LDZ #ff EOR AND ( down^ )
|
2024-07-13 23:07:54 -04:00
|
|
|
#01 AND ?&ok JMP2r &ok
|
2024-07-13 20:45:22 -04:00
|
|
|
maybe-select-stock ?&done
|
2024-07-13 23:07:54 -04:00
|
|
|
maybe-select-waste ?&done
|
|
|
|
|
maybe-select-tableau ?&done
|
2024-07-13 20:45:22 -04:00
|
|
|
&done JMP2r
|
|
|
|
|
|
2024-07-13 23:07:54 -04:00
|
|
|
@find-top ( lim^ start^ -> zp^ )
|
2024-07-13 20:45:22 -04:00
|
|
|
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
|
|
|
|
|
|
2024-07-13 23:07:54 -04:00
|
|
|
@top-stock ( -> zp^ ) .stock #34 OVR ADD SWP !find-top
|
|
|
|
|
@top-waste ( -> zp^ ) .waste #18 OVR ADD SWP !find-top
|
|
|
|
|
|
|
|
|
|
@top-column ( i^ -> zp^ )
|
|
|
|
|
#13 MUL .tableau ADD #13 OVR ADD SWP !find-top
|
|
|
|
|
|
|
|
|
|
@maybe-select-stock ( -> bool^ )
|
|
|
|
|
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 )
|
|
|
|
|
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 )
|
|
|
|
|
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 )
|
|
|
|
|
top-stock STHk #00 EQU ?&no2 ( [z^] ; unset card )
|
|
|
|
|
#0008 ( 8* [z^] )
|
|
|
|
|
#00 STHkr .stock SUB #03 SFT2 SUB2 ( min=8-[z-stock]/8* [z^] )
|
|
|
|
|
.Mouse/y DEI2 GTH2 ?&no2 ( [z^] )
|
|
|
|
|
STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 )
|
|
|
|
|
draw-stock #01 JMP2r ( 1^ )
|
|
|
|
|
&no2 POPr &no1 #00 JMP2r ( 0^ )
|
|
|
|
|
|
|
|
|
|
@maybe-select-waste ( -> bool^ )
|
|
|
|
|
.Mouse/y DEI2 #0008 LTH2 ?&no1
|
|
|
|
|
.Mouse/y DEI2 #0020 GTH2 ?&no1
|
|
|
|
|
top-waste STHk #00 EQU ?&no2
|
|
|
|
|
#001c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x1c+8*index* )
|
|
|
|
|
.Mouse/x DEI2 GTH2 ?&no2
|
|
|
|
|
#002c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x2c+8*index* )
|
|
|
|
|
.Mouse/x DEI2 LTH2 ?&no2
|
|
|
|
|
STHr LDZk #80 EOR SWP STZ draw-waste #01 JMP2r
|
|
|
|
|
&no2 POPr &no1 #00 JMP2r
|
|
|
|
|
|
|
|
|
|
@maybe-select-tableau ( -> bool^ )
|
|
|
|
|
.Mouse/y DEI2 #0024 LTH2 ?&no1
|
|
|
|
|
.Mouse/x DEI2 #0030 LTH2 ?&no1
|
|
|
|
|
.Mouse/x DEI2 #00cf GTH2 ?&no1
|
|
|
|
|
|
|
|
|
|
#0040 LIT2r 0700
|
|
|
|
|
&loop
|
|
|
|
|
.Mouse/x DEI2 OVR2 LTH2 ?&col #0008 ADD2
|
|
|
|
|
.Mouse/x DEI2 OVR2 LTH2 ?&no2
|
|
|
|
|
#0010 ADD2 INCr GTHkr STHr ?&loop
|
|
|
|
|
&no2 POP2 POP2r &no1 #00 JMP2r
|
|
|
|
|
|
|
|
|
|
&col
|
|
|
|
|
POP2 NIPr STHr
|
|
|
|
|
LIT "1 OVR ADD .Console/w DEO #0a .Console/w DEO
|
|
|
|
|
POP #00 JMP2r
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
@on-click-up ( -> )
|
|
|
|
|
.Mouse/state DEI #ff EOR ( not-state^ )
|
|
|
|
|
.prev-mouse-state LDZ AND ( up^ )
|
2024-07-13 20:45:22 -04:00
|
|
|
#01 AND ?{ JMP2r } JMP2r ( TODO: anything to do here? )
|
2024-07-12 22:42:41 -04:00
|
|
|
|
|
|
|
|
( @on-key ( -> brk )
|
|
|
|
|
on-press on-release
|
|
|
|
|
.Controller/button DEI .prev-button STZ
|
|
|
|
|
BRK )
|
|
|
|
|
|
|
|
|
|
( @on-release ( -> )
|
|
|
|
|
.Controller/button DEI #ff EOR ( not-button^ )
|
|
|
|
|
.prev-button LDZ AND ( release^ )
|
|
|
|
|
DUP #00 EQU ?&skip
|
|
|
|
|
DUP #08 AND ?&start
|
|
|
|
|
&skip POP JMP2r
|
|
|
|
|
&start POP !draw-cards )
|
|
|
|
|
|
|
|
|
|
( @on-press ( -> )
|
|
|
|
|
.Controller/button DEI ( button^ )
|
|
|
|
|
.prev-button LDZ #ff EOR AND ( press^ )
|
|
|
|
|
DUP #00 EQU ?&skip
|
|
|
|
|
DUP #01 AND ?&ctrl
|
|
|
|
|
DUP #02 AND ?&alt
|
|
|
|
|
DUP #04 AND ?&select
|
|
|
|
|
DUP #08 AND ?&start
|
|
|
|
|
&skip POP JMP2r
|
|
|
|
|
&ctrl POP !try-to-flip
|
|
|
|
|
&alt POP !flip-all-cards
|
|
|
|
|
&select POP !randomize
|
|
|
|
|
&start POP !reset )
|
|
|
|
|
|
|
|
|
|
~cards.tal
|
