can shuffle and reshuffle stock
This commit is contained in:
parent
43d4f671e7
commit
9d0f454d27
53
kodiak.tal
53
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 ]
|
|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 ]
|
|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^] )
|
INC LTHk #00 EQU ?&loop2 ( last^ pos+1^ [zero^] )
|
||||||
POP2 POPr !&done ( )
|
POP2 POPr !&done ( )
|
||||||
|
|
||||||
@find-top ( lim^ start^ -> zp^ )
|
@find-top ( start^ size^ -> zp^ )
|
||||||
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
|
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-stock ( -> zp^ ) .stock #34 !find-top
|
||||||
@top-waste ( -> zp^ ) .waste #18 OVR ADD SWP !find-top
|
@top-waste ( -> zp^ ) .waste #18 !find-top
|
||||||
|
|
||||||
@bot-column ( i^ -> zp^ )
|
@bot-column ( i^ -> zp^ )
|
||||||
#13 MUL .tableau ADD JMP2r
|
#13 MUL .tableau ADD JMP2r
|
||||||
@top-column ( i^ -> zp^ )
|
@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^ )
|
@maybe-select-stock ( -> bool^ )
|
||||||
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 )
|
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 )
|
||||||
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 )
|
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 )
|
||||||
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 )
|
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 )
|
||||||
top-stock STHk #00 EQU ?&no2 ( [z^] ; unset card )
|
top-stock STHk #00 EQU ?&no2 ( [z^] ; unset card )
|
||||||
#0008 ( 8* [z^] )
|
deal-from-stock draw #01 JMP2r ( 1^ )
|
||||||
#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^ )
|
|
||||||
&no2 POPr &no1 #00 JMP2r ( 0^ )
|
&no2 POPr &no1 #00 JMP2r ( 0^ )
|
||||||
|
|
||||||
@start-drag ( x* y* first^ last^ -> )
|
@start-drag ( x* y* first^ last^ -> )
|
||||||
|
@ -420,6 +450,7 @@
|
||||||
LTH2 ?&match ( i^ top^ row^ [n*] )
|
LTH2 ?&match ( i^ top^ row^ [n*] )
|
||||||
POP2r POP2 &no POP #00 JMP2r ( 0^ )
|
POP2r POP2 &no POP #00 JMP2r ( 0^ )
|
||||||
&match ( i^ top^ row^ [n*] )
|
&match ( i^ top^ row^ [n*] )
|
||||||
|
LDZk #00 EQU ?&cancel ( i^ top^ row^ [n*] )
|
||||||
LDZk #40 AND ?&cancel ( i^ top^ row^ [n*] )
|
LDZk #40 AND ?&cancel ( i^ top^ row^ [n*] )
|
||||||
STH2 SWP2r column-x ( x* [top^ row^ n*] )
|
STH2 SWP2r column-x ( x* [top^ row^ n*] )
|
||||||
STH2r #0008 MUL2 #001c ADD2 ( x* y=28+8n* [top^ row^] )
|
STH2r #0008 MUL2 #001c ADD2 ( x* y=28+8n* [top^ row^] )
|
||||||
|
|
Loading…
Reference in New Issue