d6
/
kodiak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 4 Wiki Activity

fix some bugs, document some more, dump state debugging

This commit is contained in:
~d6 2024-07-27 16:53:08 -04:00
parent 9d0f454d27
commit 1f8ec660da
1 changed files with 106 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
kodiak.tal
View File

@ -1,13 +1,15 @@
( kodiak.tal )
( BUG )
( * face-down card sometimes appears in waste when dealing )
( TODO )
( * decide if card can be put down on foundation )
( * decide if card can be put down on column )
( * support dealing more cards from the stock )
( * decide if stack can be put down on column )
( * grabbing an "empty space" sometimes produces a "weird king" )
( * restart game button )
( * music? )
( * save game file? )
( - new loop bounds may be sketchy, GTH vs LTH )
|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 ]
@ -27,8 +29,8 @@
( - #00 no card )
( - #01 ace of clubs )
( - #1a ten of diamonds )
( - #24 four of hearts )
( - #3d king of spades )
( - #24 four of spades )
( - #3d king of hearts )
( - #6c queen of hearts, face down )
( - #93 three of diamonds, held )
@ -66,6 +68,7 @@
.held #0d initialize
.dragging #05 initialize
.prev #06 initialize
shuffle-stock
deal-tableau
@ -80,6 +83,55 @@
;on-key .Controller/vect DEO2
BRK
@dump-byte ( byte^ -- )
DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP
&hex #30 ADD DUP #39 GTH #27 MUL ADD .Console/w DEO
JMP2r
@dump-mem ( start^ size^ -> )
OVR ADD SWP ( lim^ start^ )
LDZk dump-byte INC ( lim^ start+1^ )
&loop GTHk ?&ok POP2 #0a .Console/w DEO JMP2r ( lim^ pos^ )
&ok #20 .Console/w DEO LDZk dump-byte INC !&loop ( lim^ pos+1^ )
@dump-state ( -> )
,&count LDR2 INC2 ,&count STR2
LIT "d .Console/w DEO
LIT "u .Console/w DEO
LIT "m .Console/w DEO
LIT "p .Console/w DEO
#20 .Console/w DEO
LIT2 [ &count $2 ]
SWP dump-byte dump-byte
#0a .Console/w DEO
.stock #18 dump-mem
.stock #18 ADD #1c dump-mem
#0a .Console/w DEO
.waste #18 dump-mem
#0a .Console/w DEO
.foundation #04 dump-mem
#0a .Console/w DEO
.tableau
DUP #13 dump-mem #13 ADD
DUP #13 dump-mem #13 ADD
DUP #13 dump-mem #13 ADD
DUP #13 dump-mem #13 ADD
DUP #13 dump-mem #13 ADD
DUP #13 dump-mem #13 ADD
#13 dump-mem
#0a .Console/w DEO
.held #02 dump-mem
.dragging #05 dump-mem
.prev #06 dump-mem
LIT "- .Console/w DEOk DEOk DEOk DEOk DEO
#0a .Console/w DEO
JMP2r
@draw ( -> )
draw-background
draw-stock
@ -113,26 +165,29 @@
POP2 JMP2r ( )
@deal-tableau ( -> )
#33 LIT2r -tableau 00
&loop STH2kr deal-column
LIT2r 1301 ADD2r
STHkr #07 LTH ?&loop
POP2r POP JMP2r
.stock #34 find-top ( top^ )
LIT2r -tableau 00 ( top^ [tab^ 0^] )
&loop STH2kr deal-column ( top2^ [tab^ c^] )
LIT2r 1301 ADD2r ( top2^ [tab+19^ c+1^] )
STHkr #07 LTH ?&loop ( top2^ [tab+19^ c+1^] )
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 )
#00 OVR STZ ( d^ s^ [-c^] ; s<-0 )
#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 )
#00 OVR STZ ( s^ ; s<-0 )
OVR LDZ #bf AND SWP STZ ( s^ ; d<-s )
#00 OVR STZ ( s^ ; s<-0 )
#01 SUB JMP2r ( s-1^ )
@draw-stock ( -> )
.stock LDZk #00 EQU ?&empty ( stock^ )
#0008 ,&y STR2 ( ; y0<-8 )
.stock #34 OVR ADD SWP LITr 01 ( stock+52 stock^ [n^] )
#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 )
@ -141,6 +196,9 @@
,&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] )
&done POP POP2 POPr JMP2r ( )
&empty POP #0008 DUP2 ( 8* 8* )
.Screen/x DEO2 .Screen/y DEO2 ( ; x<-8, y<-8 )
#00 maybe-draw-c JMP2r ( )
@draw-waste ( -> )
#001c ,&x STR2 ( ; x0<-28 )
@ -310,24 +368,40 @@
&from-non-empty-col #00 OVR STZ #01 SUB LDZk #bf AND SWP STZ JMP2r
&above-ace LDZk #01 SUB SWP STZ JMP2r
@valid-card-foundation ( below^ above^ -> bool^ )
DUP2 #000f AND2 #0001 EQU2 ?&aces ( below^ above^ )
#3030 OVR2 AND2 EQU STH ( below^ above^ [suit-match^] )
#0f0f AND2 SWP INC EQU ( face-match^ [suit-match^] )
STHr AND JMP2r ( match^ )
&aces POP2 #01 JMP2r ( 1^ )
@valid-card-alt-color ( below^ above^ -> bool^ )
#1010 OVR2 AND2 NEQ STH ( below^ above^ [suit-match^] )
SWP INC EQU STHr AND JMP2r ( face-match&suit-match^ )
@try-release-foundation ( -> bool^ )
.held LDZ2 NEQ ?&nope ( ; stack can only have one card )
held-xy ( hx* hy* )
#0030 ,&y STR2 ( hx* hy* ; y<-48 )
LIT2r 0400 ( hx* hy* [4^ 0^] )
&loop ( hx* hy* [lim^ i^] )
OVR2 OVR2 ( hx* hy* hx* hy* [lim^ i^] )
#0008 LIT2 [ &y $2 ] ( hx* hy* hx* hy* x* y* [lim^ i^] )
card-overlap ?&found ( hx* hy* [lim^ i^] ) ( POP2 POP2 POP2 POP2 )
,&y LDR2 #0020 ADD2 ,&y STR2 ( hx* hy* [lim^ i^] ; y<-y+32 )
INCr GTHkr STHr ?&loop ( hx* hy* [lim^ i+1^] )
POP2r POP2 POP2 &nope #00 JMP2r ( 0^ )
&found ( hx* hy* [lim^ i^] )
POP2 POP2 NIPr STHr ( i^ )
.foundation ADD ( z^ )
.held LDZ LDZ #7f AND SWP STZ ( ; z<-held )
.held LDZ remove-card ( ; remove held )
#01 JMP2r ( 1^ )
.held LDZ2 NEQ ?&nope ( ; stack can only have one card )
held-xy ( hx* hy* )
#0030 ,&y STR2 ( hx* hy* ; y<-48 )
LIT2r 0400 ( hx* hy* [4^ 0^] )
&loop ( hx* hy* [lim^ i^] )
OVR2 OVR2 ( hx* hy* hx* hy* [lim^ i^] )
#0008 LIT2 [ &y $2 ] ( hx* hy* hx* hy* x* y* [lim^ i^] )
card-overlap ?&found ( hx* hy* [lim^ i^] ) ( POP2 POP2 POP2 POP2 )
,&y LDR2 #0020 ADD2 ,&y STR2 ( hx* hy* [lim^ i^] ; y<-y+32 )
INCr GTHkr STHr ?&loop ( hx* hy* [lim^ i+1^] )
POP2r POP2 POP2 &nope #00 JMP2r ( 0^ )
&found ( hx* hy* [lim^ i^] )
POP2 POP2 NIPr STHr ( i^ )
.foundation ADD ( z^ )
LDZk .held LDZ LDZ ( z^ below^ above^ )
valid-card-foundation ?&match ( z^ )
POP #00 JMP2r ( 0^ )
&match ( z^ )
.held LDZ LDZ #7f AND SWP STZ ( ; z<-held )
.held LDZ remove-card ( ; remove held from prev position )
#0000 .held STZ2 ( ; remove holding status )
#01 JMP2r ( 1^ )
@try-release-tableau ( -> bool^ )
( TODO: check if held stack intersects with top card of column )
@ -370,7 +444,7 @@
.waste DUP #18 find-top LITr -stock ( root^ src^ [dst^] )
&loop LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src^ [dst^] ; dst<-src, src<-0 )
#01 SUB INCr GTHk #00 EQU ?&loop ( root^ src-1^ [dst+1^] )
POP2 POPr JMP2r ( )
POP2 #00 STHr STZ JMP2r ( ; ensure stock ends with 00 )
@deal-from-stock
.stock LDZk ?&deal POP !reshuffle-stock ( root^ )
@ -480,6 +554,7 @@
&start POP !draw-cards )
@on-press ( -> )
dump-state
JMP2r
( .Controller/button DEI ( button^ )
.prev/button LDZ #ff EOR AND ( press^ )