From 9d0f454d27f6638c34e7f7020c1d2a99af6c6152 Mon Sep 17 00:00:00 2001 From: d_m Date: Sat, 27 Jul 2024 15:09:40 -0400 Subject: [PATCH] can shuffle and reshuffle stock --- kodiak.tal | 53 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/kodiak.tal b/kodiak.tal index 90f188b..06c0b19 100644 --- a/kodiak.tal +++ b/kodiak.tal @@ -1,4 +1,13 @@ -( deck.tal ) +( kodiak.tal ) + +( 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 ) +( * grabbing an "empty space" sometimes produces a "weird king" ) +( * restart game button ) +( * music? ) +( * save game file? ) |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 ] @@ -341,27 +350,48 @@ INC LTHk #00 EQU ?&loop2 ( last^ pos+1^ [zero^] ) POP2 POPr !&done ( ) -@find-top ( lim^ start^ -> zp^ ) - &loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r +@find-top ( start^ size^ -> zp^ ) + OVR ADD SWP ( lim^ start^ ) + &loop LDZk ?&ok !&done &ok INC GTHk ?&loop + &done NIP #01 SUB JMP2r -@top-stock ( -> zp^ ) .stock #34 OVR ADD SWP !find-top -@top-waste ( -> zp^ ) .waste #18 OVR ADD SWP !find-top +@top-stock ( -> zp^ ) .stock #34 !find-top +@top-waste ( -> zp^ ) .waste #18 !find-top @bot-column ( i^ -> zp^ ) #13 MUL .tableau ADD JMP2r @top-column ( i^ -> zp^ ) - bot-column #13 OVR ADD SWP !find-top + bot-column #13 !find-top + +@max ( x^ y^ -> max[x,y]^ ) + LTHk JMP SWP NIP JMP2r + +@reshuffle-stock + .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 ( ) + +@deal-from-stock + .stock LDZk ?&deal POP !reshuffle-stock ( root^ ) + &deal DUP #34 find-top ( root^ src^ ) + .waste #18 find-top INC STH ( root^ src^ [dst^] ) + + LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src^ [dst^] ; dst<-src, src<-0 ) + #01 SUB INCr GTHk ?&done ( root^ src-1^ [dst+1] ) + + LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src-1^ [dst+1^] ; dst+1<-src-1, src-1<-0 ) + #01 SUB INCr GTHk ?&done ( root^ src-2^ [dst+2] ) + + LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src-2^ [dst+2^] ; dst+2<-src-2, src-2<-0 ) + &done POP2 POPr JMP2r ( ) @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 #01 JMP2r ( 1^ ) + deal-from-stock draw #01 JMP2r ( 1^ ) &no2 POPr &no1 #00 JMP2r ( 0^ ) @start-drag ( x* y* first^ last^ -> ) @@ -420,6 +450,7 @@ LTH2 ?&match ( i^ top^ row^ [n*] ) POP2r POP2 &no POP #00 JMP2r ( 0^ ) &match ( i^ top^ row^ [n*] ) + LDZk #00 EQU ?&cancel ( i^ top^ row^ [n*] ) LDZk #40 AND ?&cancel ( i^ top^ row^ [n*] ) STH2 SWP2r column-x ( x* [top^ row^ n*] ) STH2r #0008 MUL2 #001c ADD2 ( x* y=28+8n* [top^ row^] )