placing cards in foundation sort of working
This commit is contained in:
parent
e879f67e75
commit
43d4f671e7
50
kodiak.tal
50
kodiak.tal
|
@ -146,6 +146,7 @@
|
|||
INC GTHk ?&loop ( lim^ zp+1^ )
|
||||
&done POP POP2 JMP2r ( )
|
||||
|
||||
( TODO: handle held cards in foundation by drawing one lower, or blank if ace held )
|
||||
@draw-foundation ( -> )
|
||||
#0030 ,&y STR2 ( ; y0<-48 )
|
||||
.foundation #04 OVR ADD SWP ( lim^ zp^ )
|
||||
|
@ -267,6 +268,7 @@
|
|||
;cursor .Screen/addr DEO2
|
||||
#43 .Screen/sprite DEO &skip JMP2r
|
||||
|
||||
( TODO: handle dealing more cards from stock )
|
||||
@on-click-down ( -> )
|
||||
.Mouse/state DEI ( state^ )
|
||||
.prev/mouse-state LDZ #ff EOR AND ( down^ )
|
||||
|
@ -278,12 +280,45 @@
|
|||
( not found ) .dragging #05 initialize
|
||||
&found clear-prev-mouse !draw-curr-hold
|
||||
|
||||
@distance ( a* b* -> max[a,b]-min[a,b]* )
|
||||
GTH2k JMP SWP2 SUB2 JMP2r
|
||||
|
||||
@card-overlap ( x1* y1* x2* y2* -> bool^ )
|
||||
STH2 ROT2 distance SWP2 STH2r distance ( dx* dy* )
|
||||
#0018 LTH2 STH #0010 LTH2 STHr AND JMP2r ( dy<24&dx<16^ )
|
||||
|
||||
@held-xy ( -> x* y* )
|
||||
curr-drag-x !curr-drag-y
|
||||
|
||||
( search waste and tableau for held cards )
|
||||
@remove-card ( z^ -> )
|
||||
DUP .foundation LTH ?&zero ( z^ ; waste, just zero )
|
||||
DUP .tableau LTH ?&from-foundation ( z^ )
|
||||
DUP .tableau SUB #13 DIVk MUL SUB ( z^ (z-tab)%19^ )
|
||||
?&from-non-empty-col ( z^ )
|
||||
&zero #00 SWP STZ JMP2r
|
||||
&from-foundation LDZ #0f #01 GTH ?&above-ace !&zero
|
||||
&from-non-empty-col #00 OVR STZ #01 SUB LDZk #bf AND SWP STZ JMP2r
|
||||
&above-ace LDZk #01 SUB SWP STZ JMP2r
|
||||
|
||||
@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
|
||||
.held LDZ2 NEQ ?&nope ( ; stack can only have one card )
|
||||
held-xy ( hx* hy* )
|
||||
#0030 ,&y STR2 ( hx* hy* ; y<-48 )
|
||||
LIT2r 0400 ( hx* hy* [4^ 0^] )
|
||||
&loop ( hx* hy* [lim^ i^] )
|
||||
OVR2 OVR2 ( hx* hy* hx* hy* [lim^ i^] )
|
||||
#0008 LIT2 [ &y $2 ] ( hx* hy* hx* hy* x* y* [lim^ i^] )
|
||||
card-overlap ?&found ( hx* hy* [lim^ i^] ) ( POP2 POP2 POP2 POP2 )
|
||||
,&y LDR2 #0020 ADD2 ,&y STR2 ( hx* hy* [lim^ i^] ; y<-y+32 )
|
||||
INCr GTHkr STHr ?&loop ( hx* hy* [lim^ i+1^] )
|
||||
POP2r POP2 POP2 &nope #00 JMP2r ( 0^ )
|
||||
&found ( hx* hy* [lim^ i^] )
|
||||
POP2 POP2 NIPr STHr ( i^ )
|
||||
.foundation ADD ( z^ )
|
||||
.held LDZ LDZ #7f AND SWP STZ ( ; z<-held )
|
||||
.held LDZ remove-card ( ; remove held )
|
||||
#01 JMP2r ( 1^ )
|
||||
|
||||
@try-release-tableau ( -> bool^ )
|
||||
( TODO: check if held stack intersects with top card of column )
|
||||
|
@ -293,8 +328,8 @@
|
|||
|
||||
@release ( -> )
|
||||
clear-prev-hold ( )
|
||||
try-release-foundation ?&ok ( )
|
||||
try-release-tableau ?&ok ( )
|
||||
try-release-foundation ?&done ( )
|
||||
try-release-tableau ?&done ( )
|
||||
.held LDZ2 SWP ( last^ first^ )
|
||||
&loop DUP LDZk #80 EOR SWP STZ ( last^ pos^ ; pos<-c^0x80 )
|
||||
INC LTHk #00 EQU ?&loop POP2 ( )
|
||||
|
@ -353,6 +388,7 @@
|
|||
start-drag draw #01 JMP2r ( 1^ )
|
||||
&no2 POP2r POPr &no1 #00 JMP2r ( 0^ )
|
||||
|
||||
( TODO: handle empty column )
|
||||
@maybe-select-tableau ( -> bool^ )
|
||||
.Mouse/y DEI2 #0024 LTH2 ?&no1 ( )
|
||||
.Mouse/x DEI2 #0030 LTH2 ?&no1 ( )
|
||||
|
|
Loading…
Reference in New Issue