grabbing stacks works

This commit is contained in:
~d6 2024-07-15 22:54:16 -04:00
parent 86fb2dab75
commit aff923b155
1 changed files with 43 additions and 25 deletions

View File

@ -29,7 +29,8 @@
@waste $18 ( face up pile - 24 bytes )
@foundation $4 ( one per suit - 4 bytes, 4x1 )
@tableau $85 ( the main board - 133 bytes, 7x19 )
@held $0d ( stack of up to 13 held cards )
@held [ &first $1 ( stack of up to 13 held cards )
&last $1 ] ( stack of up to 13 held cards )
@dragging [ $1 ( are we dragging? )
&x $2 ( x-coord for start of drag )
&y $2 ] ( y-coord for start of drag )
@ -155,8 +156,12 @@
@draw-tableau
#0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
@column-x ( idx^ -> x* )
#00 SWP #0018 MUL2 #0030 ADD2 JMP2r
@draw-column ( idx^ -> )
#00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx )
( #00 OVR #0018 MUL2 #0030 ADD2 ,&x STR2 ( idx^ ; x<-32+24*idx ) )
DUP column-x ,&x STR2 ( idx^ ; x<-32+24*idx )
#0024 ,&y STR2 ( idx^ ; y<-32 )
#13 MUL .tableau ADD ( pos=t+idx*19^ )
DUP #13 ADD SWP ( lim=pos+19^ pos^ )
@ -256,10 +261,16 @@
draw-stock #01 JMP2r ( 1^ )
&no2 POPr &no1 #00 JMP2r ( 0^ )
@start-drag ( x* y* -> )
( TODO: take t^ input, update t, update held )
.dragging/y STZ2 .dragging/x STZ2
#01 .dragging STZ JMP2r
@start-drag ( x* y* first^ last^ -> )
DUP2 .held STZ2 ( x* y* first^ last^ ; held<-first,last )
SWP ( x* y* last^ first^ [h0^] )
&loop LTHk ?&done ( x* y* last^ z^ [h^] )
DUP LDZk #80 EOR SWP STZ ( x* y* last^ z^ [h^] ; z<-q )
INC !&loop ( x* y* last^ z+1^ [h+1^] )
&done POP2 ( x* y* )
.dragging/y STZ2 ( x* ; d/y<-y )
.dragging/x STZ2 ( ; d/x<-x )
#01 .dragging STZ JMP2r ( )
@maybe-select-waste ( -> bool^ )
.Mouse/y DEI2 #0008 LTH2 ?&no1
@ -269,9 +280,9 @@
DUP2 ,&dx STR2 ( w* [t^ w*] ; dx<-w )
.Mouse/x DEI2 GTH2 ?&no2 ( [t^ w*] )
#002c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x2c+8*index* [t^ w*] )
.Mouse/x DEI2 LTH2 ?&no2 ( [t^ w*] )
LIT2 [ &dx $2 ] #0008 start-drag ( [^t] )
STHr LDZk #80 EOR SWP STZ draw-waste #01 JMP2r ( 1^ )
.Mouse/x DEI2 LTH2 ?&no2 ( [t^] )
LIT2 [ &dx $2 ] #0008 STHr DUP ( dx* dy=8* t^ t^ )
start-drag draw-waste #01 JMP2r ( 1^ )
&no2 POP2r POPr &no1 #00 JMP2r ( 0^ )
@maybe-select-tableau ( -> bool^ )
@ -280,28 +291,35 @@
.Mouse/x DEI2 #00cf GTH2 ?&no1 ( )
#0040 LIT2r 0700 ( 64* [7^ 0^] )
&loop ( x* [lim^ i^] )
DUP2 #0010 SUB2 ,&dx STR2 ( x* [lim^ i^] ; dx<-x )
.Mouse/x DEI2 OVR2 LTH2 ?&col ( x* [lim^ i^] )
#0008 ADD2 ( y1=y+8* [lim^ i^] )
.Mouse/x DEI2 OVR2 LTH2 ?&no2 ( y1* [lim^ i^] )
#0010 ADD2 ( y2=y1+16* [lim^ i^] )
INCr GTHkr STHr ?&loop ( y2 [lim i+1^] )
&no2 POP2 POP2r &no1 #00 JMP2r ( 0^ )
&col ( i^ )
POP2 NIPr STHr ( i^ )
DUPk top-column STHk SWP bot-column ( i^ top^ bot^ [top^] )
SUB #00 SWP ( i^ count* [top^] )
#0008 MUL2 #0024 ADD2 ( i^ min=0x24+8*i* [top^] )
DUP2 ,&dy STR2 ( i^ min* [top^] ; dy<-min )
DUP2 #0018 ADD2 ( i^ min* max=min+0x18* [top^] )
.Mouse/y DEI2 LTH2 #00 EQU STH ( i^ min* [top^ max>=y^] )
.Mouse/y DEI2 GTH2 #00 EQU STHr ( i^ min<=y^ max>=y^ [top^] )
AND ?&ok ( i^ [top^] )
POP POPr #00 JMP2r ( 0^ )
&ok LIT2 [ &dx $2 ] LIT2 [ &dy $2 ] ( i^ dx* dy* )
start-drag ( i^ )
STHr LDZk #80 EOR SWP STZ ( i^ ; top<-top^0x80 )
draw-column #01 JMP2r ( 1^ )
&col ( x* [lim^ i^] )
POP2 NIPr STHr !maybe-select-column ( bool^ )
@maybe-select-column ( i^ -> bool^ )
.Mouse/y DEI2 #0024 LTH2 ?&no ( i^ )
DUP top-column OVR bot-column LIT2r 0001 ( i^ top^ bot^ [1*] )
&loop ( i^ top^ row^ [n*] )
GTHk ?&next !&done ( i^ top^ row^ [n*] )
&next ( i^ top^ row^ [n*] )
.Mouse/y DEI2 ( i^ top^ row^ y* [n*] )
STH2kr #0008 MUL2 #0024 ADD2 ( i^ top^ row^ y* lim=36+8n* [n*] )
LTH2 ?&match INC INC2r !&loop ( i^ top^ row+1^ [n+1*] )
&done ( i^ top^ row^ [n*] )
.Mouse/y DEI2 ( i^ top^ row^ y* [n*] )
STH2kr #0008 MUL2 #0034 ADD2 ( i^ top^ row^ y* lim=52+8n* [n*] )
LTH2 ?&match ( i^ top^ row^ [n*] )
POP2r POP2 &no POP #00 JMP2r ( 0^ )
&match ( i^ top^ row^ [n*] )
STH2 SWP2r column-x ( x* [top^ row^ n*] )
STH2r #0008 MUL2 #001c ADD2 ( x* y=28+8n* [top^ row^] )
STH2r SWP ( x* y* row^ top^ )
start-drag draw-tableau #01 JMP2r ( 1^ )
( @on-click-up ( -> )
.Mouse/state DEI #ff EOR ( not-state^ )