( kodiak.tal ) ( TODO ) ( * restart/quit game button ) ( * automatically moving safe cards to foundation? ) ( * music? ) ( * save game file? stats? ) ( * animations? flash stock when clicked? ) ( * moving/drawing near boundaries is weird ) ( * sometimes movement feels stutter-y ) |00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ] |10 @Console [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ] |20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ] |80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ] |90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ] |a0 @File1 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |c0 @DateTime [ &y $2 &m $1 &d $1 &hr $1 &min $1 &sec $1 &dow $1 &doy $2 &isdst $1 ] ( 1 byte per card ) ( #01 ace ... #0d king ) ( #00 club #10 diamond #20 spade #30 heart ) ( #00 face up, #40 face down ) ( #00 normal #80 held ) ( examples: ) ( - #00 no card ) ( - #01 ace of clubs ) ( - #1a ten of diamonds ) ( - #24 four of spades ) ( - #3d king of hearts ) ( - #6c queen of hearts, face down ) ( - #93 three of diamonds, held ) ( zero page - currently using 232 of 256 bytes ) |0000 @stock $34 ( draw pile - 52 bytes, 24 bytes at start ) @waste $18 ( face up pile - 24 bytes ) @foundation $4 ( one per suit - 4 bytes, 4x1 ) @tableau $85 ( the main board - 133 bytes, 7x19 ) @held $2 ( first and last card in held stack ) @dragging [ $1 ( are we dragging? ) &x $2 ( x-coord for start of drag ) &y $2 ] ( y-coord for start of drag ) @prev [ &button $1 ( previous button press ) &mouse-state $1 ( previous mouse state ) &mouse-x $2 ( previous x-coordinate ) &mouse-y $2 ] ( previous y-coordinate ) |0100 ( colors: gold, white, red, black ) #bd82 .System/r DEO2 #8d12 .System/g DEO2 #4d12 .System/b DEO2 ( 256x192 ) #0100 .Screen/w DEO2 #00c0 .Screen/h DEO2 reset BRK @reset init-rng-from-datetime init-stock .waste #18 initialize .foundation #04 initialize .tableau #85 initialize .held #02 initialize .dragging #05 initialize .prev #06 initialize shuffle-stock deal-tableau draw ;on-mouse .Mouse/vect DEO2 ;on-key .Controller/vect DEO2 JMP2r @dump-byte ( byte^ -- ) DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP &hex #30 ADD DUP #39 GTH #27 MUL ADD .Console/w DEO JMP2r @dump-mem ( start^ size^ -> ) OVR ADD SWP ( lim^ start^ ) LDZk dump-byte INC ( lim^ start+1^ ) &loop GTHk ?&ok POP2 #0a .Console/w DEO JMP2r ( lim^ pos^ ) &ok #20 .Console/w DEO LDZk dump-byte INC !&loop ( lim^ pos+1^ ) @dump-state ( -> ) ,&count LDR2 INC2 ,&count STR2 LIT "d .Console/w DEO LIT "u .Console/w DEO LIT "m .Console/w DEO LIT "p .Console/w DEO #20 .Console/w DEO LIT2 [ &count $2 ] SWP dump-byte dump-byte #0a .Console/w DEO .stock #18 dump-mem .stock #18 ADD #1c dump-mem #0a .Console/w DEO .waste #18 dump-mem #0a .Console/w DEO .foundation #04 dump-mem #0a .Console/w DEO .tableau DUP #13 dump-mem #13 ADD DUP #13 dump-mem #13 ADD DUP #13 dump-mem #13 ADD DUP #13 dump-mem #13 ADD DUP #13 dump-mem #13 ADD DUP #13 dump-mem #13 ADD #13 dump-mem #0a .Console/w DEO .held #02 dump-mem .dragging #05 dump-mem .prev #06 dump-mem LIT "- .Console/w DEOk DEOk DEOk DEOk DEO #0a .Console/w DEO JMP2r @draw ( -> ) draw-background draw-stock draw-waste draw-foundation draw-tableau !draw-curr-mouse @initialize ( start^ count^ -> ) OVR ADD SWP STH2 #00 ( 0^ [lim=start+count^ start^] ) &loop DUP STHkr STZ INCr GTHkr STHr ?&loop ( 0^ [lim^ pos^] ) POP POP2r JMP2r ( ) @init-stock ( -> ) LITr -stock #8000 #4e41 &outer DUP2 &inner DUP STHkr STZ INC INCr GTHk ?&inner POP2 #1010 ADD2 GTH2k ?&outer POP2 POP2 POPr JMP2r @shuffle-stock ( -> ) .stock #33 OVR ADD SWP ( last^ start^ ) &loop ( last^ pos^ ) SUBk INC #00 SWP ( last^ pos^ n=last-pos+1* ) random SWP2 ( last^ pos^ r* n* ) DIV2k MUL2 SUB2 NIP ( last^ pos^ i=r%n^ ) OVR ADD LDZk ,&c STR ( last^ pos^ alt=pos+i^ ; c<-alt ) STH LDZk STHr STZ STH ( last^ [pos^] ; alt<-pos ) LIT [ &c $1 ] STHkr STZ ( last^ [pos^] ; pos<-c ) STHr INC GTHk ?&loop ( last^ pos+1^ ) POP2 JMP2r ( ) @deal-tableau ( -> ) top-stock LIT2r -tableau 00 ( top^ [tab^ 0^] ) &loop STH2kr deal-column ( top2^ [tab^ c^] ) LIT2r 1301 ADD2r ( top2^ [tab+19^ c+1^] ) STHkr #07 LTH ?&loop ( top2^ [tab+19^ c+1^] ) POP2r POP JMP2r ( ) @deal-column ( src^ dst^ count^ -> src2^ ) #00 SWP SUB STH SWP ( dst^ src^ [-count^] ) &loop STHkr ?&ok !&done ( d^ s^ [-c^] ) &ok DUP2 LDZ SWP STZ ( d^ s^ [-c^] ; d<-s|64 ) #00 OVR STZ ( d^ s^ [-c^] ; s<-0 ) #01 SUB SWP INC SWP ( d+1^ s-1^ [-c^] ) INCr !&loop ( d+1^ s-1^ [-c+1^] ) &done POPr SWP ( s^ d^ ) OVR LDZ #bf AND SWP STZ ( s^ ; d<-s ) #00 OVR STZ ( s^ ; s<-0 ) #01 SUB JMP2r ( s-1^ ) @draw-stock ( -> ) .stock LDZk #00 EQU ?&empty ( stock^ ) #0008 ,&y STR2 ( ; y0<-8 ) #34 OVR ADD SWP LITr 01 ( stock+52 stock^ [n^] ) &loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ [n^] ) &ok ( lim^ zp^ c^ [n^] ) #0008 .Screen/x DEO2 ( lim^ zp^ c^ [n^] ; x<-8 ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ c^ [n^] ; y<- ) draw-c STHkr ?&skip ( lim^ zp^ [n^] ; draw c ) ,&y LDR2 #0001 SUB2 ,&y STR2 ( lim^ zp^ [n^] ; y<-y-1 ) &skip INC INCr LITr 07 ANDr GTHk ?&loop ( lim^ zp+1^ [(n+1)%8] ) &done POP POP2 POPr JMP2r ( ) &empty POP #0008 DUP2 ( 8* 8* ) .Screen/x DEO2 .Screen/y DEO2 ( ; x<-8, y<-8 ) #00 maybe-draw-c JMP2r ( ) @draw-waste ( -> ) #001c ,&x STR2 ( ; x0<-28 ) .waste #18 OVR ADD SWP ( waste+24^ waste^ ) &loop LDZk DUP ?&ok !&done ( lim^ zp^ c^ ) &ok ( lim^ zp^ c^ ) #0008 .Screen/y DEO2 ( lim^ zp^ c^ ; y<-8 ) LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ zp^ c^ ; x<- ) DUP #80 AND ?&done ( lim^ zp^ c^ ) draw-c ( lim^ zp^ ; draw c ) ,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 ) 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^ ) &loop ( lim^ zp^ ) #0008 .Screen/x DEO2 ( lim^ zp^ ; x<-8 ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ zp^ ; y<- ) LDZk maybe-draw-c ( lim^ zp^ ; draw ) ,&y LDR2 #0020 ADD2 ,&y STR2 ( lim^ zp^ ; y<-y+32 ) INC GTHk ?&loop ( lim^ zp+1^ ) POP2 JMP2r ( ) @draw-tableau #0700 &loop DUP draw-column INC GTHk ?&loop POP2 JMP2r @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 ) 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 ) LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ pos^ c^ ; s/y<-y ) DUP #80 AND ?&done ( lim^ pos^ c^ ) draw-c INC ( lim^ pos+1^ ) ,&y LDR2 #0008 ADD2 ,&y STR2 ( lim^ pos+1^ ) GTHk ?&loop ( lim^ pos+1^ ) &done POP POP2 JMP2r ( ) @maybe-draw-c DUP ?{ POP !draw-spot-down } !draw-c ( assumes x/y already set ) @draw-c ( card^ -> ) DUP #40 LTH ?&norm DUP #80 LTH ?&down DUP #c0 LTH ?&held POP !draw-mask-down &norm adjust-c !draw-face-up &down POP !draw-face-down &held #3f AND adjust-c !draw-mask-up ( we map from our sparse, logical card format ) ( to the dense, tile position card location ) ( clubs: #01 -> #27 ... #0d -> #33 ) ( diamonds: #11 -> #1a ... #1d -> #26 ) ( spades: #21 -> #00 ... #2d -> #0c ) ( hearts: #31 -> #0d ... #3d -> #19 ) @adjust-c ( card^ -> idx* ) #00 SWP DUP #21 LTH ?< DUP #31 LTH #03 MUL ADD #24 SUB JMP2r < DUP #11 LTH #1d MUL ADD #09 ADD JMP2r @on-mouse ( -> brk ) on-move on-click-down on-click-up .Mouse/state DEI .prev/mouse-state STZ BRK @on-move ( -> ) .Mouse/x DEI2 .prev/mouse-x LDZ2 NEQ2 ?draw-mouse .Mouse/y DEI2 .prev/mouse-y LDZ2 NEQ2 ?draw-mouse JMP2r @draw-mouse ( -> ) #00 .Screen/auto DEO clear-prev-hold clear-prev-mouse draw-curr-hold !draw-curr-mouse @clear-prev-hold ( -> ) .dragging LDZ ?{ JMP2r } ( ) #12 .Screen/auto DEO ( ; draw 2 tiles, increment x ) ;blank .Screen/addr DEO2 ( ; erase ) .dragging/x LDZ2 .prev/mouse-x LDZ2 ADD2 STH2 ( [x*] ) .dragging/y LDZ2 .prev/mouse-y LDZ2 ADD2 STH2 ( [x* y*] ) .held LDZ2 #02 ADD SWP ( last+2^ first^ [x* y*] ) &loop LTHk ?&done ( last+2^ pos^ [x* y*] ) STH2kr .Screen/y DEO2 ( last+2^ pos^ [x* y*] ; s/y<-y ) OVR2r STH2r .Screen/x DEO2 ( last+2^ pos^ [x* y*] ; s/x<-x ) #41 .Screen/sprite DEO ( last+2^ pos^ [x* y*] ; erase ) INC LIT2r 0008 ADD2r !&loop ( last+2^ pos+1^ [x* y+8*] ) &done POP2 POP2r POP2r JMP2r ( ) @curr-drag-x ( -> x* ) .Mouse/x DEI2 .dragging/x LDZ2 ADD2 JMP2r @curr-drag-y ( -> x* ) .Mouse/y DEI2 .dragging/y LDZ2 ADD2 JMP2r @draw-curr-hold ( -> ) .dragging LDZ ?{ JMP2r } set-fg curr-drag-x STH2 ( [x*] ) curr-drag-y STH2 ( [x* y*] ) .held LDZ2 SWP ( last^ first^ [x* y*] ) &loop LTHk ?&done ( last^ pos^ [x* y*] ) STH2kr .Screen/y DEO2 ( last^ pos^ [x* y*] ; s/y<-y ) OVR2r STH2r .Screen/x DEO2 ( last^ pos^ [x* y*] ; s/x<-x ) LDZk draw-c ( last^ pos^ [x* y*] ; draw ) INC LIT2r 0008 ADD2r !&loop ( last^ pos+1^ [x* y+8*] ) &done POP2 POP2r POP2r !set-bg ( ) @clear-prev-mouse ( -> ) #00 .Screen/auto DEO ;blank .Screen/addr DEO2 .prev/mouse-x LDZ2 .Screen/x DEO2 .prev/mouse-y LDZ2 .Screen/y DEO2 #41 .Screen/sprite DEO JMP2r @draw-curr-mouse ( -> ) .Mouse/x DEI2 DUP2 .prev/mouse-x STZ2 .Screen/x DEO2 .Mouse/y DEI2 DUP2 .prev/mouse-y STZ2 .Screen/y DEO2 .dragging LDZ ?&skip ;cursor .Screen/addr DEO2 #43 .Screen/sprite DEO &skip JMP2r @on-click-down ( -> ) .Mouse/state DEI ( state^ ) .prev/mouse-state LDZ #ff EOR AND ( down^ ) #01 AND ?&ok JMP2r &ok maybe-select-stock ?&skip maybe-select-waste ?&found maybe-select-tableau ?&found ( 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 @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 @valid-card-foundation ( below^ above^ -> bool^ ) 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-tableau ( below^ above^ -> bool^ ) DUP2 #0f0f AND2 #000d EQU2 ?&king ( below^ above^ ) #1010 OVR2 AND2 NEQ STH ( below^ above^ [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 ) 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^ ) LDZk .held LDZ LDZ ( z^ below^ above^ ) valid-card-foundation ?&match ( z^ ) POP #00 JMP2r ( 0^ ) &match ( z^ ) .held LDZ LDZ #7f AND SWP STZ ( ; z<-held ) .held LDZ remove-card ( ; remove held from prev position ) #0000 .held STZ2 ( ; remove holding status ) #01 JMP2r ( 1^ ) @try-release-tableau ( -> bool^ ) #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 ( -> ) clear-prev-hold ( ) 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 ( ) &done .dragging #05 initialize ( ) #0000 .held STZ2 !draw ( ) .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 ( start^ size^ -> zp^ ) 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 @top-stock ( -> zp^ ) .stock #34 !find-top @top-waste ( -> zp^ ) .waste #18 !find-top @bot-column ( i^ -> zp^ ) #13 MUL .tableau ADD JMP2r @top-column ( i^ -> zp^ ) bot-column #13 !find-top @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 ) #01 SUB INCr GTHk #00 EQU ?&loop ( root^ src-1^ [dst+1^] ) POP2 #00 STHr STZ JMP2r ( ; ensure stock ends with 00 ) @deal-from-stock .stock LDZk ?&deal POP !reshuffle-stock ( root^ ) &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] ) LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src-1^ [dst+1^] ; dst+1<-src-1, src-1<-0 ) EQUk ?&done #01 SUB INCr ( root^ src-2^ [dst+2] ) LDZk #40 EOR STHkr STZ #00 OVR STZ ( root^ src-2^ [dst+2^] ; dst+2<-src-2, src-2<-0 ) &done POP2 POPr JMP2r ( ) @maybe-select-stock ( -> bool^ ) .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 ) SWP ( x* y* last^ first^ ) &loop LTHk ?&done ( x* y* last^ z^ ) DUP LDZk #80 EOR SWP STZ ( x* y* last^ z^ ; z<-q ) INC !&loop ( x* y* last^ z+1^ ) &done POP2 ( x* y* ) .Mouse/y DEI2 SUB2 .dragging/y STZ2 .Mouse/x DEI2 SUB2 .dragging/x STZ2 #01 .dragging STZ JMP2r ( ) @maybe-select-waste ( -> bool^ ) .Mouse/y DEI2 #0008 LTH2 ?&no1 ( ) .Mouse/y DEI2 #0020 GTH2 ?&no1 ( ) top-waste STHk #00 EQU ?&no2 ( [t^] ) #001c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( w=0x1c+8*index* [t^ w*] ) DUP2 ,&dx STR2 ( w* [t^ w*] ; dx<-w ) .Mouse/x DEI2 GTH2 ?&no2 ( [t^ w*] ) #002c #00 STHkr .waste SUB #0008 MUL2 ADD2 ( 0x2c+8*index* [t^ w*] ) .Mouse/x DEI2 LTH2 ?&no2 ( [t^] ) LIT2 [ &dx $2 ] #0008 STHr DUP ( dx* dy=8* t^ t^ ) 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 ( ) .Mouse/x DEI2 #00cf GTH2 ?&no1 ( ) #0040 LIT2r 0700 ( 64* [7^ 0^] ) &loop ( x* [lim^ i^] ) .Mouse/x DEI2 OVR2 LTH2 ?&col ( x* [lim^ i^] ) #0008 ADD2 ( y1=y+8* [lim^ i^] ) .Mouse/x DEI2 OVR2 LTH2 ?&no2 ( y1* [lim^ i^] ) #0010 ADD2 ( y2=y1+16* [lim^ i^] ) INCr GTHkr STHr ?&loop ( y2 [lim i+1^] ) &no2 POP2 POP2r &no1 #00 JMP2r ( 0^ ) &col ( x* [lim^ i^] ) POP2 NIPr STHr !maybe-select-column ( bool^ ) @maybe-select-column ( i^ -> bool^ ) .Mouse/y DEI2 #0024 LTH2 ?&no ( i^ ) DUP top-column OVR bot-column ( i^ top^ bot^ ) LIT2r 0001 ( i^ top^ bot^ [1*] ) &loop ( i^ top^ row^ [n*] ) GTHk ?&next !&done ( i^ top^ row^ [n*] ) &next ( i^ top^ row^ [n*] ) .Mouse/y DEI2 ( i^ top^ row^ y* [n*] ) STH2kr #0008 MUL2 #0024 ADD2 ( i^ top^ row^ y* lim=36+8n* [n*] ) LTH2 ?&match INC INC2r !&loop ( i^ top^ row+1^ [n+1*] ) &done ( i^ top^ row^ [n*] ) .Mouse/y DEI2 ( i^ top^ row^ y* [n*] ) STH2kr #0008 MUL2 #0034 ADD2 ( i^ top^ row^ y* lim=52+8n* [n*] ) LTH2 ?&match ( i^ top^ row^ [n*] ) POP2r POP2 &no POP #00 JMP2r ( 0^ ) &match ( i^ top^ row^ [n*] ) LDZk #00 EQU ?&cancel ( i^ top^ row^ [n*] ) LDZk #40 AND ?&cancel ( i^ top^ row^ [n*] ) STH2 SWP2r column-x ( x* [top^ row^ n*] ) STH2r #0008 MUL2 #001c ADD2 ( x* y=28+8n* [top^ row^] ) STH2r SWP ( x* y* row^ top^ ) start-drag draw #01 JMP2r ( 1^ ) &cancel ( i^ top^ row^ [n*] ) POP2 POP POP2r #00 JMP2r ( 0^ ) @on-click-up ( -> ) .Mouse/state DEI #ff EOR ( not-state^ ) .prev/mouse-state LDZ AND ( up^ ) #01 AND ?&ok JMP2r &ok .dragging LDZ ?release JMP2r @on-key ( -> brk ) on-press on-release .Controller/button DEI .prev/button STZ BRK @on-release ( -> ) JMP2r ( .Controller/button DEI #ff EOR ( not-button^ ) .prev/button LDZ AND ( release^ ) DUP #00 EQU ?&skip DUP #08 AND ?&start &skip POP JMP2r &start POP !draw-cards ) @on-press ( -> ) .Controller/key DEI #0d EQU ?dump-state .Controller/key DEI #1b EQU ?reset JMP2r ( .Controller/button DEI ( button^ ) .prev/button LDZ #ff EOR AND ( press^ ) DUP #00 EQU ?&skip DUP #01 AND ?&ctrl DUP #02 AND ?&alt DUP #04 AND ?&select DUP #08 AND ?&start &skip POP JMP2r &ctrl POP !try-to-flip &alt POP !flip-all-cards &select POP !randomize &start POP !reset ) ~cards.tal