From 78f4e37598ad8ffec679bc67a31ada8da893af0f Mon Sep 17 00:00:00 2001 From: d_m Date: Sat, 27 Jul 2024 21:05:14 -0400 Subject: [PATCH] basically works, sort of --- kodiak.tal | 77 ++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 54 insertions(+), 23 deletions(-) diff --git a/kodiak.tal b/kodiak.tal index 8f80fa8..df82e71 100644 --- a/kodiak.tal +++ b/kodiak.tal @@ -230,11 +230,14 @@ @column-x ( idx^ -> x* ) #00 SWP #0018 MUL2 #0030 ADD2 JMP2r +@column-y ( col^ -> y* ) + bot-column DUP #13 find-top SWP SUB + #00 SWP #0008 MUL2 #0024 ADD2 JMP2r + @draw-column ( idx^ -> ) DUP column-x ,&x STR2 ( idx^ ; x<-32+24*idx ) #0024 ,&y STR2 ( idx^ ; y<-32 ) - #13 MUL .tableau ADD ( pos=t+idx*19^ ) - DUP #13 ADD SWP ( lim=pos+19^ pos^ ) + bot-column DUP #13 ADD SWP ( lim=pos+19^ pos^ ) &loop ( lim^ pos^ ) LDZk DUP ?&ok !&done ( lim^ pos^ c^ ) &ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ c^ ; s/x<-x ) @@ -334,17 +337,17 @@ ;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^ ) #01 AND ?&ok JMP2r &ok .dragging LDZ ?release - maybe-select-stock ?&found + maybe-select-stock ?&skip maybe-select-waste ?&found maybe-select-tableau ?&found - ( not found ) .dragging #05 initialize + ( not found ) .dragging #05 !initialize &found clear-prev-mouse !draw-curr-hold + &skip JMP2r @distance ( a* b* -> max[a,b]-min[a,b]* ) GTH2k JMP SWP2 SUB2 JMP2r @@ -368,15 +371,18 @@ &above-ace LDZk #01 SUB SWP STZ JMP2r @valid-card-foundation ( below^ above^ -> bool^ ) - DUP2 #000f AND2 #0001 EQU2 ?&aces ( below^ above^ ) + DUP2 #0f0f AND2 #0001 EQU2 ?&aces ( below^ above^ ) #3030 OVR2 AND2 EQU STH ( below^ above^ [suit-match^] ) #0f0f AND2 SWP INC EQU ( face-match^ [suit-match^] ) STHr AND JMP2r ( match^ ) &aces POP2 #01 JMP2r ( 1^ ) -@valid-card-alt-color ( below^ above^ -> bool^ ) +@valid-card-tableau ( below^ above^ -> bool^ ) + DUP2 #0f0f AND2 #000d EQU2 ?&king ( below^ above^ ) #1010 OVR2 AND2 NEQ STH ( below^ above^ [suit-match^] ) - SWP INC EQU STHr AND JMP2r ( face-match&suit-match^ ) + #0f0f AND2 INC EQU ( face-match^ [suit-match^] ) + STHr AND JMP2r ( match^ ) + &king POP2 #01 JMP2r ( 1^ ) @try-release-foundation ( -> bool^ ) .held LDZ2 NEQ ?&nope ( ; stack can only have one card ) @@ -403,11 +409,37 @@ #01 JMP2r ( 1^ ) @try-release-tableau ( -> bool^ ) - ( TODO: for each column... ) - ( TODO: check if bottom of stack intersects with top card of column ) - ( TODO: check if bottom of stack is compatible with top of column ) - ( TODO: place stack, clear prev, and return #01 if ok ) - &nope #00 JMP2r + #0700 &loop + DUP try-release-column ?&success + INC GTHk ?&loop POP2 #00 JMP2r + &success #01 JMP2r + +( TODO: check if bottom of stack intersects with top card of column ) +( TODO: check if bottom of stack is compatible with top of column ) +( TODO: place stack, clear prev, and return #01 if ok ) +@try-release-column ( col^ -> bool^ ) + STHk column-x + STHkr column-y ( x0* y* [col^] ) + held-xy card-overlap ?&found ( [col^] ) + POPr #00 JMP2r ( 0^ ) + &found ( [col^] ) + STHkr top-column LDZ ( under^ [col^] ) + .held LDZ LDZ ( under^ over^ [col^] ) + valid-card-tableau ?&ok ( ok^ [col^] ) + POPr #00 JMP2r ( 0^ ; TODO ) + &ok STHr top-column ( top^ ) + inc-unless-empty STH ( [dst^] ; inc unless column is empty ) + .held LDZ2 INC SWP ( lim^ src^ [dst^] ) + &loop LDZk #7f AND STHkr STZ ( lim^ src^ [dst^] ; dst<-src ) + DUP remove-card ( lim^ src^ [dst^] ; remove card ) + INC INCr GTHk ?&loop ( lim^ src+1^ [dst+1^] ) + #0000 .held STZ2 draw + POP2 POPr #01 JMP2r ( 1^ ) + +@inc-unless-empty ( zp^ -> zp1^ ) + LDZk #00 EQU JMP INC JMP2r + +@release-held-cards-column ( col -> ) @release ( -> ) clear-prev-hold ( ) @@ -425,7 +457,8 @@ POP2 POPr !&done ( ) @find-top ( start^ size^ -> zp^ ) - OVR ADD SWP ( lim^ start^ ) + OVR LDZ ?&non-empty POP JMP2r + &non-empty OVR ADD SWP ( lim^ start^ ) &loop LDZk ?&ok !&done &ok INC GTHk ?&loop &done NIP #01 SUB JMP2r @@ -437,9 +470,6 @@ @top-column ( i^ -> zp^ ) bot-column #13 !find-top -@max ( x^ y^ -> max[x,y]^ ) - LTHk JMP SWP NIP JMP2r - @reshuffle-stock .waste DUP #18 find-top LITr -stock ( root^ src^ [dst^] ) &loop LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src^ [dst^] ; dst<-src, src<-0 ) @@ -448,7 +478,8 @@ @deal-from-stock .stock LDZk ?&deal POP !reshuffle-stock ( root^ ) - &deal DUP #34 find-top top-waste INC STH ( root^ src^ [dst^] ) + &deal DUP #34 find-top top-waste ( root^ src^ w^ ) + inc-unless-empty STH ( root^ src^ [dst^] ) LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src^ [dst^] ; dst<-src, src<-0 ) EQUk ?&done #01 SUB INCr ( root^ src-1^ [dst+1] ) @@ -460,11 +491,11 @@ &done POP2 POPr JMP2r ( ) @maybe-select-stock ( -> bool^ ) - .Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 ) - .Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 ) - .Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 ) - deal-from-stock draw #01 JMP2r ( 1^ ) - &no2 POPr &no1 #00 JMP2r ( 0^ ) + .Mouse/x DEI2 #0008 LTH2 ?&no ( ; x<8 ) + .Mouse/x DEI2 #0017 GTH2 ?&no ( ; x>=23 ) + .Mouse/y DEI2 #0020 GTH2 ?&no ( ; y>=32 ) + deal-from-stock draw #01 JMP2r ( 1^ ) + &no #00 JMP2r ( 0^ ) @start-drag ( x* y* first^ last^ -> ) DUP2 .held STZ2 ( x* y* first^ last^ ; held<-first,last )