almost ready to move cards
This commit is contained in:
parent
a431d8ce63
commit
bbef62b908
29
kodiak.tal
29
kodiak.tal
|
@ -277,14 +277,33 @@
|
|||
( not found ) .dragging #05 initialize
|
||||
&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 ( -> )
|
||||
clear-prev-hold
|
||||
draw-curr-mouse
|
||||
clear-prev-hold ( )
|
||||
try-release-foundation ?&ok ( )
|
||||
try-release-tableau ?&ok ( )
|
||||
.held LDZ2 SWP ( last^ first^ )
|
||||
&loop DUP LDZk #80 EOR SWP STZ ( last^ first ; first<-c^0x80 )
|
||||
INC LTHk #00 EQU ?&loop ( last^ first+1^ )
|
||||
POP2 .dragging #05 initialize ( )
|
||||
&loop DUP LDZk #80 EOR SWP STZ ( last^ pos^ ; pos<-c^0x80 )
|
||||
INC LTHk #00 EQU ?&loop POP2 ( )
|
||||
&done .dragging #05 initialize ( )
|
||||
#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^ )
|
||||
&loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r
|
||||
|
|
Loading…
Reference in New Issue