almost ready to move cards

This commit is contained in:
~d6 2024-07-16 21:56:25 -04:00
parent a431d8ce63
commit bbef62b908
1 changed files with 24 additions and 5 deletions

View File

@ -277,14 +277,33 @@
( not found ) .dragging #05 initialize ( not found ) .dragging #05 initialize
&found clear-prev-mouse !draw-curr-hold &found clear-prev-mouse !draw-curr-hold
@try-release-foundation ( -> bool^ )
.held LDZ2 NEQ ?&nope
( TODO: check if held card intersects with a foundation place )
( TODO: check if intersected spot is compatible )
( TODO: place card and return #01 if ok )
&nope #00 JMP2r
@try-release-tableau ( -> bool^ )
( TODO: check if held stack intersects with top card of column )
( TODO: check if bottom of stack is compatible with top of column )
( TODO: place stack and return #01 if ok )
&nope #00 JMP2r
@release ( -> ) @release ( -> )
clear-prev-hold clear-prev-hold ( )
draw-curr-mouse try-release-foundation ?&ok ( )
try-release-tableau ?&ok ( )
.held LDZ2 SWP ( last^ first^ ) .held LDZ2 SWP ( last^ first^ )
&loop DUP LDZk #80 EOR SWP STZ ( last^ first ; first<-c^0x80 ) &loop DUP LDZk #80 EOR SWP STZ ( last^ pos^ ; pos<-c^0x80 )
INC LTHk #00 EQU ?&loop ( last^ first+1^ ) INC LTHk #00 EQU ?&loop POP2 ( )
POP2 .dragging #05 initialize ( ) &done .dragging #05 initialize ( )
#0000 .held STZ2 !draw ( ) #0000 .held STZ2 !draw ( )
&ok ( )
.held LDZ2 SWP LITr 00 ( last^ first^ [zero^] )
&loop2 STHkr OVR STZ ( last^ pos^ [zero^] ; pos<-zero )
INC LTHk #00 EQU ?&loop2 ( last^ pos+1^ [zero^] )
POP2 POPr !&done ( )
@find-top ( lim^ start^ -> zp^ ) @find-top ( lim^ start^ -> zp^ )
&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