allow moves from foundation back to tableau

This commit is contained in:
~d6 2024-08-07 00:13:57 -04:00
parent 1adb09817c
commit 56d8141bbd
1 changed files with 23 additions and 4 deletions

View File

@ -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 ( )