diff --git a/kodiak.tal b/kodiak.tal index 06c0b19..5b543a5 100644 --- a/kodiak.tal +++ b/kodiak.tal @@ -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^ )