selection mostly working

This commit is contained in:
~d6 2024-07-13 23:07:54 -04:00
parent 25b8d47e45
commit a73bdac979
1 changed files with 68 additions and 38 deletions

View File

@ -25,7 +25,7 @@
|0000 |0000
@stock $34 ( draw pile - 52 bytes ) @stock $34 ( draw pile - 52 bytes, 24 bytes at start )
@waste $18 ( face up pile - 24 bytes ) @waste $18 ( face up pile - 24 bytes )
@foundation $4 ( one per suit - 4 bytes, 4x1 ) @foundation $4 ( one per suit - 4 bytes, 4x1 )
@tableau $85 ( the main board - 133 bytes, 7x19 ) @tableau $85 ( the main board - 133 bytes, 7x19 )
@ -47,9 +47,18 @@
init-rng-from-datetime init-rng-from-datetime
init-stock init-waste init-foundation init-stock init-waste init-foundation
shuffle-stock deal-tableau shuffle-stock deal-tableau
draw-background
draw-stock draw-waste draw-foundation draw-tableau
( for now, we'll deal the first 3 cards to the waste for testing )
( TODO: implement deal-waste )
#17 LDZ #bf AND .waste #00 ADD STZ #0017 STZ
#16 LDZ #bf AND .waste #01 ADD STZ #0016 STZ
#15 LDZ #bf AND .waste #02 ADD STZ #0015 STZ
draw-background
draw-stock
draw-waste
draw-foundation
draw-tableau
;on-mouse .Mouse/vect DEO2 ;on-mouse .Mouse/vect DEO2
( ;on-key .Controller/vect DEO2 ) ( ;on-key .Controller/vect DEO2 )
BRK BRK
@ -98,6 +107,7 @@
INCr !&loop ( d+1^ s-1^ [-c+1^] ) INCr !&loop ( d+1^ s-1^ [-c+1^] )
&done POPr SWP ( s^ d^) &done POPr SWP ( s^ d^)
OVR LDZ #bf AND SWP STZ ( s^ ; d<-s ) OVR LDZ #bf AND SWP STZ ( s^ ; d<-s )
#00 OVR STZ ( s^ ; s<-0 )
#01 SUB JMP2r ( s-1^ ) #01 SUB JMP2r ( s-1^ )
@swap-c ( src^ dst^ -> ) @swap-c ( src^ dst^ -> )
@ -117,7 +127,7 @@
draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c ) draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c )
,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 ) ,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 )
&skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] ) &skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] )
&done POP2 POPr JMP2r ( ) &done POP POP2 POPr JMP2r ( )
@draw-waste ( -> ) @draw-waste ( -> )
#001c ,&x STR2 ( ; x0<-28 ) #001c ,&x STR2 ( ; x0<-28 )
@ -129,7 +139,7 @@
draw-c ( lim^ zp^ ; draw c ) draw-c ( lim^ zp^ ; draw c )
,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 ) ,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 )
INC GTHk ?&loop ( lim^ zp+1^ ) INC GTHk ?&loop ( lim^ zp+1^ )
&done POP2 JMP2r ( ) &done POP POP2 JMP2r ( )
@draw-foundation ( -> ) @draw-foundation ( -> )
#0030 ,&y STR2 ( ; y0<-48 ) #0030 ,&y STR2 ( ; y0<-48 )
@ -143,7 +153,7 @@
POP2 JMP2r ( ) POP2 JMP2r ( )
@draw-tableau @draw-tableau
#0700 &loop DUP draw-column INC GTHk ?&loop JMP2r #0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r
@draw-column ( idx^ -> ) @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 )
@ -170,7 +180,7 @@
POP !draw-mask-down POP !draw-mask-down
&norm adjust-c !draw-face-up &norm adjust-c !draw-face-up
&down POP !draw-face-down &down POP !draw-face-down
&held adjust-c !draw-mask-up &held #3f AND adjust-c !draw-mask-up
( we map from our sparse, logical card format ) ( we map from our sparse, logical card format )
( to the dense, tile position card location ) ( to the dense, tile position card location )
@ -191,19 +201,10 @@
.Mouse/state DEI .prev-mouse-state STZ .Mouse/state DEI .prev-mouse-state STZ
BRK BRK
@mouse-dx ( -> dx* ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 JMP2r
@mouse-dy ( -> dy* ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 JMP2r
@mouse-dx8 ( -> dx^ ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 NIP JMP2r
@mouse-dy8 ( -> dy^ ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 NIP JMP2r
@on-move ( -> ) @on-move ( -> )
.Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw .Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?draw-mouse
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?draw-mouse
JMP2r JMP2r
&redraw ( #00 .Screen/auto DEO )
!draw-mouse
( clear-prev-mouse draw-curr-mouse JMP2r )
@draw-mouse ( -> ) @draw-mouse ( -> )
#00 .Screen/auto DEO #00 .Screen/auto DEO
@ -224,31 +225,60 @@
@on-click-down ( -> ) @on-click-down ( -> )
.Mouse/state DEI ( state^ ) .Mouse/state DEI ( state^ )
.prev-mouse-state LDZ #ff EOR AND ( down^ ) .prev-mouse-state LDZ #ff EOR AND ( down^ )
#01 AND ?{ JMP2r } !maybe-select-card #01 AND ?&ok JMP2r &ok
@maybe-select-card ( -> )
.Mouse/x DEI2 .Mouse/y DEI2
maybe-select-stock ?&done maybe-select-stock ?&done
maybe-select-waste ?&done
maybe-select-tableau ?&done
&done JMP2r &done JMP2r
@top-stock ( -> zp^ ) @find-top ( lim^ start^ -> zp^ )
.stock #34 OVR ADD SWP
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r &loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
@maybe-select-stock ( x* y* -> bool^ ) @top-stock ( -> zp^ ) .stock #34 OVR ADD SWP !find-top
top-stock STH ( [z^] ) @top-waste ( -> zp^ ) .waste #18 OVR ADD SWP !find-top
OVR2 #0008 LTH2 ?&no1 ( x* y* [z^] ; x<8 )
SWP2 #0017 GTH2 ?&no2 ( y* [z^] ; x>=16 ) @top-column ( i^ -> zp^ )
#00 STHkr .stock SUB #03 SFT2 ( y* d* [z^] ) #13 MUL .tableau ADD #13 OVR ADD SWP !find-top
SWP2 STH2 ( d* [z^ y*] )
#0020 ( d* max=32-d* [z^ y*] ) @maybe-select-stock ( -> bool^ )
#0008 ROT2 SUB2 ( max* min=8-d* [z^ y*] ) .Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 )
STH2kr GTH2 ?&no3 ( max* [z^ y*] ) .Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 )
STH2r LTH2 ?&no4 ( [z^] ) .Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 )
STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 ) top-stock STHk #00 EQU ?&no2 ( [z^] ; unset card )
draw-stock #01 JMP2r ( 1^ ) #0008 ( 8* [z^] )
&no1 POP2 &no2 POP2 POPr #00 JMP2r ( 0^ ) #00 STHkr .stock SUB #03 SFT2 SUB2 ( min=8-[z-stock]/8* [z^] )
&no3 POP2 POP2r &no4 POPr #00 JMP2r ( 0^ ) .Mouse/y DEI2 GTH2 ?&no2 ( [z^] )
STHr LDZk #80 EOR SWP STZ ( ; z<-z^0x80 )
draw-stock #01 JMP2r ( 1^ )
&no2 POPr &no1 #00 JMP2r ( 0^ )
@maybe-select-waste ( -> bool^ )
.Mouse/y DEI2 #0008 LTH2 ?&no1
.Mouse/y DEI2 #0020 GTH2 ?&no1
top-waste STHk #00 EQU ?&no2
#001c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x1c+8*index* )
.Mouse/x DEI2 GTH2 ?&no2
#002c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x2c+8*index* )
.Mouse/x DEI2 LTH2 ?&no2
STHr LDZk #80 EOR SWP STZ draw-waste #01 JMP2r
&no2 POPr &no1 #00 JMP2r
@maybe-select-tableau ( -> bool^ )
.Mouse/y DEI2 #0024 LTH2 ?&no1
.Mouse/x DEI2 #0030 LTH2 ?&no1
.Mouse/x DEI2 #00cf GTH2 ?&no1
#0040 LIT2r 0700
&loop
.Mouse/x DEI2 OVR2 LTH2 ?&col #0008 ADD2
.Mouse/x DEI2 OVR2 LTH2 ?&no2
#0010 ADD2 INCr GTHkr STHr ?&loop
&no2 POP2 POP2r &no1 #00 JMP2r
&col
POP2 NIPr STHr
LIT "1 OVR ADD .Console/w DEO #0a .Console/w DEO
POP #00 JMP2r
@on-click-up ( -> ) @on-click-up ( -> )
.Mouse/state DEI #ff EOR ( not-state^ ) .Mouse/state DEI #ff EOR ( not-state^ )