allow moves from foundation back to tableau
This commit is contained in:
parent
1adb09817c
commit
56d8141bbd
27
kodiak.tal
27
kodiak.tal
|
@ -456,11 +456,17 @@
|
||||||
&loop ( lim^ zp^ )
|
&loop ( lim^ zp^ )
|
||||||
#0008 .Screen/x DEO2 ( lim^ zp^ ; x<-8 )
|
#0008 .Screen/x DEO2 ( lim^ zp^ ; x<-8 )
|
||||||
LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ ; y<- )
|
LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ ; y<- )
|
||||||
LDZk maybe-draw-c ( lim^ zp^ ; draw )
|
LDZk draw-foundation-c ( lim^ zp^ ; draw )
|
||||||
,&y LDR2 #0020 ADD2 ,&y STR2 ( lim^ zp^ ; y<-y+32 )
|
,&y LDR2 #0020 ADD2 ,&y STR2 ( lim^ zp^ ; y<-y+32 )
|
||||||
INC GTHk ?&loop ( lim^ zp+1^ )
|
INC GTHk ?&loop ( lim^ zp+1^ )
|
||||||
POP2 JMP2r ( )
|
POP2 JMP2r ( )
|
||||||
|
|
||||||
|
@draw-foundation-c ( c^ -> )
|
||||||
|
DUP #80 AND #00 EQU ?maybe-draw-c
|
||||||
|
#7f AND DUP #0f AND #01 GTH ?&under-card
|
||||||
|
POP #00 !maybe-draw-c
|
||||||
|
&under-card #ff ADD !maybe-draw-c
|
||||||
|
|
||||||
@draw-tableau
|
@draw-tableau
|
||||||
#0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
|
#0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
|
||||||
|
|
||||||
|
@ -767,9 +773,9 @@
|
||||||
DUP .tableau SUB #13 DIVk MUL SUB ( z^ (z-tab)%19^ )
|
DUP .tableau SUB #13 DIVk MUL SUB ( z^ (z-tab)%19^ )
|
||||||
?&from-non-empty-col ( z^ )
|
?&from-non-empty-col ( z^ )
|
||||||
&zero #00 SWP STZ JMP2r
|
&zero #00 SWP STZ JMP2r
|
||||||
&from-foundation LDZ #0f #01 GTH ?&above-ace !&zero
|
&from-foundation LDZ #0f AND #01 GTH ?&above-ace !&zero
|
||||||
&from-non-empty-col #00 OVR STZ #01 SUB LDZk #bf AND SWP STZ JMP2r
|
&from-non-empty-col #00 OVR STZ #01 SUB LDZk #bf AND SWP STZ JMP2r
|
||||||
&above-ace LDZk #01 SUB SWP STZ JMP2r
|
&above-ace LDZk #7f AND #01 SUB SWP STZ JMP2r
|
||||||
|
|
||||||
@valid-card-foundation ( below^ above^ -> bool^ )
|
@valid-card-foundation ( below^ above^ -> bool^ )
|
||||||
DUP2 #0f0f AND2 #0001 EQU2 ?&aces ( below^ above^ )
|
DUP2 #0f0f AND2 #0001 EQU2 ?&aces ( below^ above^ )
|
||||||
|
@ -904,7 +910,20 @@
|
||||||
#01 .dragging STZ JMP2r ( )
|
#01 .dragging STZ JMP2r ( )
|
||||||
|
|
||||||
@maybe-select-foundation ( -> bool^ )
|
@maybe-select-foundation ( -> bool^ )
|
||||||
#00 JMP2r
|
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( )
|
||||||
|
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( )
|
||||||
|
.foundation #04 OVR ADD SWP ( lim^ zp^ )
|
||||||
|
LIT2r 0030 ( lim^ zp^ [y*] )
|
||||||
|
&loop
|
||||||
|
.Mouse/y DEI2 STH2kr LTH2 ?&no2
|
||||||
|
LIT2r 0018 ADD2r
|
||||||
|
.Mouse/y DEI2 STH2kr LTH2 ?&yes
|
||||||
|
LIT2r 0008 ADD2r
|
||||||
|
INC GTHk ?&loop
|
||||||
|
&no2 POP2r POP2
|
||||||
|
&no1 #00 JMP2r
|
||||||
|
&yes #0008 STH2r #0018 SUB2 ( lim^ zp^ x* y* )
|
||||||
|
ROT2 NIP DUP start-drag draw #01 JMP2r
|
||||||
|
|
||||||
@maybe-select-waste ( -> bool^ )
|
@maybe-select-waste ( -> bool^ )
|
||||||
.Mouse/y DEI2 #0008 LTH2 ?&no1 ( )
|
.Mouse/y DEI2 #0008 LTH2 ?&no1 ( )
|
||||||
|
|
Loading…
Reference in New Issue