d6
/
kodiak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 4 Wiki Activity

placing cards in foundation sort of working

This commit is contained in:
~d6 2024-07-17 23:59:16 -04:00
parent e879f67e75
commit 43d4f671e7
1 changed files with 44 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
kodiak.tal
View File

@ -146,6 +146,7 @@
INC GTHk ?&loop ( lim^ zp+1^ ) INC GTHk ?&loop ( lim^ zp+1^ )
&done POP POP2 JMP2r ( ) &done POP POP2 JMP2r ( )
( TODO: handle held cards in foundation by drawing one lower, or blank if ace held )
@draw-foundation ( -> ) @draw-foundation ( -> )
#0030 ,&y STR2 ( ; y0<-48 ) #0030 ,&y STR2 ( ; y0<-48 )
.foundation #04 OVR ADD SWP ( lim^ zp^ ) .foundation #04 OVR ADD SWP ( lim^ zp^ )
@ -267,6 +268,7 @@
;cursor .Screen/addr DEO2 ;cursor .Screen/addr DEO2
#43 .Screen/sprite DEO &skip JMP2r #43 .Screen/sprite DEO &skip JMP2r
( TODO: handle dealing more cards from stock )
@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^ )
@ -278,12 +280,45 @@
( not found ) .dragging #05 initialize ( not found ) .dragging #05 initialize
&found clear-prev-mouse !draw-curr-hold &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^ ) @try-release-foundation ( -> bool^ )
.held LDZ2 NEQ ?&nope .held LDZ2 NEQ ?&nope ( ; stack can only have one card )
( TODO: check if held card intersects with a foundation place ) held-xy ( hx* hy* )
( TODO: check if intersected spot is compatible ) #0030 ,&y STR2 ( hx* hy* ; y<-48 )
( TODO: place card and return #01 if ok ) LIT2r 0400 ( hx* hy* [4^ 0^] )
&nope #00 JMP2r &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^ ) @try-release-tableau ( -> bool^ )
( TODO: check if held stack intersects with top card of column ) ( TODO: check if held stack intersects with top card of column )
@ -293,8 +328,8 @@
@release ( -> ) @release ( -> )
clear-prev-hold ( ) clear-prev-hold ( )
try-release-foundation ?&ok ( ) try-release-foundation ?&done ( )
try-release-tableau ?&ok ( ) try-release-tableau ?&done ( )
.held LDZ2 SWP ( last^ first^ ) .held LDZ2 SWP ( last^ first^ )
&loop DUP LDZk #80 EOR SWP STZ ( last^ pos^ ; pos<-c^0x80 ) &loop DUP LDZk #80 EOR SWP STZ ( last^ pos^ ; pos<-c^0x80 )
INC LTHk #00 EQU ?&loop POP2 ( ) INC LTHk #00 EQU ?&loop POP2 ( )
@ -302,7 +337,7 @@
#0000 .held STZ2 !draw ( ) #0000 .held STZ2 !draw ( )
&ok ( ) &ok ( )
.held LDZ2 SWP LITr 00 ( last^ first^ [zero^] ) .held LDZ2 SWP LITr 00 ( last^ first^ [zero^] )
&loop2 STHkr OVR STZ ( last^ pos^ [zero^] ; pos<-zero ) &loop2 STHkr OVR STZ ( last^ pos^ [zero^] ; pos<-zero )
INC LTHk #00 EQU ?&loop2 ( last^ pos+1^ [zero^] ) INC LTHk #00 EQU ?&loop2 ( last^ pos+1^ [zero^] )
POP2 POPr !&done ( ) POP2 POPr !&done ( )
@ -353,6 +388,7 @@
start-drag draw #01 JMP2r ( 1^ ) start-drag draw #01 JMP2r ( 1^ )
&no2 POP2r POPr &no1 #00 JMP2r ( 0^ ) &no2 POP2r POPr &no1 #00 JMP2r ( 0^ )
( TODO: handle empty column )
@maybe-select-tableau ( -> bool^ ) @maybe-select-tableau ( -> bool^ )
.Mouse/y DEI2 #0024 LTH2 ?&no1 ( ) .Mouse/y DEI2 #0024 LTH2 ?&no1 ( )
.Mouse/x DEI2 #0030 LTH2 ?&no1 ( ) .Mouse/x DEI2 #0030 LTH2 ?&no1 ( )