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

basically works, sort of

This commit is contained in:
~d6 2024-07-27 21:05:14 -04:00
parent 8d6fb7712f
commit 78f4e37598
1 changed files with 54 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
kodiak.tal
View File

@ -230,11 +230,14 @@
@column-x ( idx^ -> x* ) @column-x ( idx^ -> x* )
#00 SWP #0018 MUL2 #0030 ADD2 JMP2r #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^ -> ) @draw-column ( idx^ -> )
DUP column-x ,&x STR2 ( idx^ ; x<-32+24*idx ) DUP column-x ,&x STR2 ( idx^ ; x<-32+24*idx )
#0024 ,&y STR2 ( idx^ ; y<-32 ) #0024 ,&y STR2 ( idx^ ; y<-32 )
#13 MUL .tableau ADD ( pos=t+idx*19^ ) bot-column DUP #13 ADD SWP ( lim=pos+19^ pos^ )
DUP #13 ADD SWP ( lim=pos+19^ pos^ )
&loop ( lim^ pos^ ) &loop ( lim^ pos^ )
LDZk DUP ?&ok !&done ( lim^ pos^ c^ ) LDZk DUP ?&ok !&done ( lim^ pos^ c^ )
&ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ c^ ; s/x<-x ) &ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ c^ ; s/x<-x )
@ -334,17 +337,17 @@
;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^ )
#01 AND ?&ok JMP2r &ok #01 AND ?&ok JMP2r &ok
.dragging LDZ ?release .dragging LDZ ?release
maybe-select-stock ?&found maybe-select-stock ?&skip
maybe-select-waste ?&found maybe-select-waste ?&found
maybe-select-tableau ?&found maybe-select-tableau ?&found
( not found ) .dragging #05 initialize ( not found ) .dragging #05 !initialize
&found clear-prev-mouse !draw-curr-hold &found clear-prev-mouse !draw-curr-hold
&skip JMP2r
@distance ( a* b* -> max[a,b]-min[a,b]* ) @distance ( a* b* -> max[a,b]-min[a,b]* )
GTH2k JMP SWP2 SUB2 JMP2r GTH2k JMP SWP2 SUB2 JMP2r
@ -368,15 +371,18 @@
&above-ace LDZk #01 SUB SWP STZ JMP2r &above-ace LDZk #01 SUB SWP STZ JMP2r
@valid-card-foundation ( below^ above^ -> bool^ ) @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^] ) #3030 OVR2 AND2 EQU STH ( below^ above^ [suit-match^] )
#0f0f AND2 SWP INC EQU ( face-match^ [suit-match^] ) #0f0f AND2 SWP INC EQU ( face-match^ [suit-match^] )
STHr AND JMP2r ( match^ ) STHr AND JMP2r ( match^ )
&aces POP2 #01 JMP2r ( 1^ ) &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^] ) #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^ ) @try-release-foundation ( -> bool^ )
.held LDZ2 NEQ ?&nope ( ; stack can only have one card ) .held LDZ2 NEQ ?&nope ( ; stack can only have one card )
@ -403,11 +409,37 @@
#01 JMP2r ( 1^ ) #01 JMP2r ( 1^ )
@try-release-tableau ( -> bool^ ) @try-release-tableau ( -> bool^ )
( TODO: for each column... ) #0700 &loop
( TODO: check if bottom of stack intersects with top card of column ) DUP try-release-column ?&success
( TODO: check if bottom of stack is compatible with top of column ) INC GTHk ?&loop POP2 #00 JMP2r
( TODO: place stack, clear prev, and return #01 if ok ) &success #01 JMP2r
&nope #00 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 ( -> ) @release ( -> )
clear-prev-hold ( ) clear-prev-hold ( )
@ -425,7 +457,8 @@
POP2 POPr !&done ( ) POP2 POPr !&done ( )
@find-top ( start^ size^ -> zp^ ) @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 &loop LDZk ?&ok !&done &ok INC GTHk ?&loop
&done NIP #01 SUB JMP2r &done NIP #01 SUB JMP2r
@ -437,9 +470,6 @@
@top-column ( i^ -> zp^ ) @top-column ( i^ -> zp^ )
bot-column #13 !find-top bot-column #13 !find-top
@max ( x^ y^ -> max[x,y]^ )
LTHk JMP SWP NIP JMP2r
@reshuffle-stock @reshuffle-stock
.waste DUP #18 find-top LITr -stock ( root^ src^ [dst^] ) .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 ) &loop LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src^ [dst^] ; dst<-src, src<-0 )
@ -448,7 +478,8 @@
@deal-from-stock @deal-from-stock
.stock LDZk ?&deal POP !reshuffle-stock ( root^ ) .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 ) 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] ) EQUk ?&done #01 SUB INCr ( root^ src-1^ [dst+1] )
@ -460,11 +491,11 @@
&done POP2 POPr JMP2r ( ) &done POP2 POPr JMP2r ( )
@maybe-select-stock ( -> bool^ ) @maybe-select-stock ( -> bool^ )
.Mouse/x DEI2 #0008 LTH2 ?&no1 ( ; x<8 ) .Mouse/x DEI2 #0008 LTH2 ?&no ( ; x<8 )
.Mouse/x DEI2 #0017 GTH2 ?&no1 ( ; x>=23 ) .Mouse/x DEI2 #0017 GTH2 ?&no ( ; x>=23 )
.Mouse/y DEI2 #0020 GTH2 ?&no1 ( ; y>=32 ) .Mouse/y DEI2 #0020 GTH2 ?&no ( ; y>=32 )
deal-from-stock draw #01 JMP2r ( 1^ ) deal-from-stock draw #01 JMP2r ( 1^ )
&no2 POPr &no1 #00 JMP2r ( 0^ ) &no #00 JMP2r ( 0^ )
@start-drag ( x* y* first^ last^ -> ) @start-drag ( x* y* first^ last^ -> )
DUP2 .held STZ2 ( x* y* first^ last^ ; held<-first,last ) DUP2 .held STZ2 ( x* y* first^ last^ ; held<-first,last )