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

can shuffle and reshuffle stock

This commit is contained in:
~d6 2024-07-27 15:09:40 -04:00
parent 43d4f671e7
commit 9d0f454d27
1 changed files with 42 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
kodiak.tal
View File

@ -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^] )