From d4ab9ccd471f2e183e152e81d453125b1150b7ce Mon Sep 17 00:00:00 2001 From: d_m Date: Fri, 12 Jul 2024 22:42:41 -0400 Subject: [PATCH] renamed to kodiak, commented out unused code --- cards.tal | 123 ++++++++++++------------ kodiak.tal | 268 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 329 insertions(+), 62 deletions(-) create mode 100644 kodiak.tal diff --git a/cards.tal b/cards.tal index 64d6320..ecf5916 100644 --- a/cards.tal +++ b/cards.tal @@ -47,49 +47,49 @@ ( BUG: try moving the "whole deck" and get into a weird state ) -@move-card ( card* dx^ dy^ -> ) +( @move-card ( card* dx^ dy^ -> ) SWP SWP2 STH2 INC2r INC2r ( dy^ dx^ [card+2*] ) STH2kr LDA ADD STH2kr STA INC2r ( dy^ [card+3*] ; card.x+=dx ) - STH2kr LDA ADD STH2r STA JMP2r ( ; card.y+=dy ) + STH2kr LDA ADD STH2r STA JMP2r ( ; card.y+=dy ) ) ( put all cards face down, and stack them ) ( in a single deck in the middle of the screen ) -@reset ( -> ) +( @reset ( -> ) all-cards-face-down shuffle ( FIXME ) #08 #18 stack-cards draw-background - !draw-cards + !draw-cards ) ( f: addr* -> ) -@for-all-cards ( f* -> ) +( @for-all-cards ( f* -> ) STH2 ;cards/end ;cards ( limit* start* [f*] ) &loop DUP2 STH2kr JSR2 ( limit* pos* [f*] ) #0004 ADD2 GTH2k ?&loop ( limit* pos+4* [f*] ) - POP2 POP2 POP2r JMP2r ( ) + POP2 POP2 POP2r JMP2r ( ) ) -@all-cards-face-down ( -> ) - ;turn-card-face-down !for-all-cards +( @all-cards-face-down ( -> ) + ;turn-card-face-down !for-all-cards ) -@stack-cards ( x^ y^ -> ) +( @stack-cards ( x^ y^ -> ) ,stack-card/y STR ,stack-card/x STR #00 ,stack-card/c STR - ;stack-card !for-all-cards + ;stack-card !for-all-cards ) -@stack-card ( addr* -> ) +( @stack-card ( addr* -> ) INC2 INC2 STH2 ( [addr+2*] ) LIT [ &x $1 ] STH2kr STA INC2r ( [addr+3] ; addr+2<-x ) LIT [ &y $1 ] STH2r STA ( ; addr+3<-y ) LIT [ &c $1 ] ?&skip ,&y LDR #01 SUB ,&y STR - &skip ,&c LDR INC #03 AND ,&c STR JMP2r + &skip ,&c LDR INC #03 AND ,&c STR JMP2r ) -@flip-all-cards ( -> ) +( @flip-all-cards ( -> ) ;cards/end ;cards ( limit* start* ) &loop DUP2 flip-card ( limit* pos* ) #0004 ADD2 GTH2k ?&loop ( limit* pos+4* ) - POP2 POP2 !draw-cards ( ) + POP2 POP2 !draw-cards ( ) ) -@shuffle ( -> ) +( @shuffle ( -> ) ;cards/last ;cards ( last* start* ) &loop ( last* pos* ) SUB2k #02 SFT2 INC2 ( last* pos* n=[last-pos]/4+1* ) @@ -101,31 +101,31 @@ LIT2 [ &c $2 ] STH2kr STA2 ( last* [pos*] ) STH2r #0004 ADD2 ( last* pos+4* ) GTH2k ?&loop ( last* pos+4* ) - POP2 POP2 JMP2r ( ) + POP2 POP2 JMP2r ( ) ) -@try-to-flip ( -> ) +( @try-to-flip ( -> ) find-mouse-over-card ORAk ?&found POP2 JMP2r - &found flip-card !draw-cards + &found flip-card !draw-cards ) -@flip-card ( addr* -> ) - LDA2k #8000 EOR2 SWP2 STA2 JMP2r +( @flip-card ( addr* -> ) + LDA2k #8000 EOR2 SWP2 STA2 JMP2r ) -@turn-card-face-down ( addr* -> ) - LDA2k #8000 ORA2 SWP2 STA2 JMP2r +( @turn-card-face-down ( addr* -> ) + LDA2k #8000 ORA2 SWP2 STA2 JMP2r ) -@turn-card-face-up ( addr* -> ) - LDA2k #7fff AND2 SWP2 STA2 JMP2r +( @turn-card-face-up ( addr* -> ) + LDA2k #7fff AND2 SWP2 STA2 JMP2r ) -@randomize ( -> ) +( @randomize ( -> ) init-cards draw-background - !draw-cards + !draw-cards ) -@mod ( n* d* -> n%d* ) - DIV2k MUL2 SUB2 JMP2r +( @mod ( n* d* -> n%d* ) + DIV2k MUL2 SUB2 JMP2r ) -@init-cards ( -> ) +( @init-cards ( -> ) #0034 #0000 ( limit* 0* ) &loop ( limit* c* ) ;cards OVR2 ( limit* c* cards* c* ) @@ -137,9 +137,9 @@ random #00a8 mod NIP ( limit* c* y^ [addr+3*] ) STH2r STA ( limit* c* ; addr+3<-y ) INC2 GTH2k ?&loop ( limit* c+1* ) - POP2 POP2 JMP2r + POP2 POP2 JMP2r ) -@raise-card ( addr* -> ) +( @raise-card ( addr* -> ) DUP2 ;cards/last EQU2 ?&skip ( addr* ) LDA2k ,&card STR2 INC2 INC2 ( addr+2* ) LDA2k ,&xy STR2 #0002 SUB2 ( addr-2* ) @@ -154,10 +154,10 @@ STH2kr STA2 INC2r INC2r ( [last+2*] ; last<-c ) LIT2 [ &xy $2 ] ( xy* [last+2*] ) STH2r STA2 JMP2r ( ; last+2<-xy ) - &skip POP2 JMP2r ( ) + &skip POP2 JMP2r ( ) ) ( raises card at addr and everything it lifts ) -@raise-cards ( addr* -> count^ ) +( @raise-cards ( addr* -> count^ ) #0004 ,&d STR2 ( ; d<-4 ) ;raise-cards/buf ;raise-cards/pos STA2 ( addr* ; pos<-buf[0] ) DUP2 raise-cards/enqueue STH2 ( addr* [pos*] ; buf[0]<-addr ) @@ -190,27 +190,27 @@ INC2 INC2 INC2kr INC2r ( c+2* [pos* pos+2*] ) LDA2 STH2kr STA2 INC2r INC2r ( [pos* pos+4*] ; buf[pos+2]<-c+2 ) STH2r ,&pos STR2 STH2r JMP2r ( pos* ; pos<-pos+4 ) - [ &pos $2 &buf $cc ] + [ &pos $2 &buf $cc ] ) -@abs-within ( x^ y^ d^ -> abs[x-y] <= d^ ) +( @abs-within ( x^ y^ d^ -> abs[x-y] <= d^ ) STH SUB STHkr ADD ( x-y+d^ [d^] ) - STHr DUP ADD INC LTH JMP2r ( x-y+d<2d+1^ ) + STHr DUP ADD INC LTH JMP2r ( x-y+d<2d+1^ ) ) -@card-overlaps ( a* b* -> ok^ ) +( @card-overlaps ( a* b* -> ok^ ) INC2 INC2 LDA2 STH2 ( a* [bx^ by^] ) INC2 INC2 LDA2 ( ax^ ay^ [bx^ by^] ) STHr #17 abs-within SWP ( ay-by<16^ ax^ [bx^] ) STHr #0f abs-within AND ( ay-by<16&ax-bx<24^ ) - JMP2r + JMP2r ) ( returns true if the card below lifts the card above ) -@card-lifts ( below* above* -> bool^ ) - GTH2k ?&no !card-overlaps &no POP2 POP2 #00 JMP2r +( @card-lifts ( below* above* -> bool^ ) + GTH2k ?&no !card-overlaps &no POP2 POP2 #00 JMP2r ) -@find-mouse-over-card ( -> addr* ) - .Mouse/x DEI2 .Mouse/y DEI2 !find-card +( @find-mouse-over-card ( -> addr* ) + .Mouse/x DEI2 .Mouse/y DEI2 !find-card ) -( returns top card at coords, or 0000 if no card. ) +( ( returns top card at coords, or 0000 if no card. ) @find-card ( x* y* -> addr* ) LIT2r =cards LIT2r =cards/last ( x* y* [limit* first*] ) &loop ( x* y* [limit* pos*] ) @@ -221,32 +221,32 @@ !&loop ( x* y* [limit* pos-4*] ) ¬found POP2r LIT2r 0000 ( x* y* [limit* 0*] ) &done ( x* y* [limit* addr*] ) - POP2 POP2 STH2r POP2r JMP2r ( addr* ) + POP2 POP2 STH2r POP2r JMP2r ( addr* ) ) ( returns true if the given card x,y coordinates ) ( intersect the rectangle of the given card. ) ( cards are 16 pixels wide and 24 pixels tall. ) ( so the result is: ) ( cx <= x < cx+16 && cy <= y < cy+24 ) -@intersects ( x* y* card* -> bool^ ) +( @intersects ( x* y* card* -> bool^ ) ROT2 STH2 LITr 00 ( y* card* [x* 0^] ) #0002 ADD2 LDAk STH SUB2r ( y* card+2* [x-cx*] ) LIT2r 0010 LTH2r STHr ?&x-ok ( y* card+2* ) POP2 POP2 #00 JMP2r ( 0^ ) &x-ok ( y* card+2* ) LITr 00 INC2 LDA STH STH2r ( y* cy* ) - SUB2 #0018 LTH2 JMP2r ( ok^ ) + SUB2 #0018 LTH2 JMP2r ( ok^ ) ) -@draw-cards - ;draw-card !draw-all-cards +( @draw-cards + ;draw-card !draw-all-cards ) -@held-end-offset ( -> offset* ) - ;cards/end #00 .card-is-held LDZ #0004 MUL2 SUB2 JMP2r +( @held-end-offset ( -> offset* ) + ;cards/end #00 .card-is-held LDZ #0004 MUL2 SUB2 JMP2r ) ( TODO: if the top card is being "held" then we ) ( should not draw that here, because it will be ) ( drawn in the foreground using a mask. ) -@draw-all-cards ( draw* -> ) +( @draw-all-cards ( draw* -> ) ,&draw STR2 ( ) held-end-offset STH2 ( [limit*] ) LIT2r =cards ( [limit* pos*] ) @@ -265,7 +265,7 @@ #00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] ) draw-mask ( [limit* pos+4] ) GTH2kr STHr ?&mloop ( [limit* pos+4] ) - POP2r POP2r JMP2r ( ) + POP2r POP2r JMP2r ( ) ) @draw-background ( -> ) #f2 .Screen/auto DEO @@ -280,13 +280,13 @@ DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEO JMP2r -@draw-mask ( idx* x* y* -> ) +( @draw-mask ( idx* x* y* -> ) .Screen/y DEO2 .Screen/x DEO2 - OVR #80 LTH ?draw-mask-up POP2 !draw-mask-down + OVR #80 LTH ?draw-mask-up POP2 !draw-mask-down ) -@draw-card ( idx* x* y* -> ) +( @draw-card ( idx* x* y* -> ) .Screen/y DEO2 .Screen/x DEO2 - OVR #80 LTH ?draw-face-up POP2 !draw-face-down + OVR #80 LTH ?draw-face-up POP2 !draw-face-down ) ( assumes x/y already set ) @draw-mask-down ( -> ) @@ -302,14 +302,14 @@ #81 .Screen/sprite DEOk DEOk DEO JMP2r -@card-is-black ( idx* -> bool^ ) +( @card-is-black ( idx* -> bool^ ) #000c DIV2 @q-is-black ( q* -> bool^ ) - NIP #01 SUB #fe AND JMP2r ( [q-1]&fe ) + NIP #01 SUB #fe AND JMP2r ( [q-1]&fe ) ) @card-is-red ( idx* -> bool^ ) #000c DIV2 -@q-is-red ( q* -> bool^ ) +( @q-is-red ( q* -> bool^ ) ) NIP #03 MUL #02 AND JMP2r ( [q*3]&2 ) @find-middle-addr ( idx* -> addr* ) @@ -379,8 +379,7 @@ #00 .DateTime/sec DEI ADD2 ( s* ) DUP2 .DateTime/doy DEI2 MUL2 ( s* sdoy* ) ( fall-through ) - -@init-rng ( x* y* -> ) +( @init-rng ( x* y* -> ) ) #0001 ROT2 OVR2 ( y* 1* x* 1* ) ORA2 ;rng/x STA2 ( y* 1* ) ORA2 ;rng/x STA2 JMP2r ( ) @@ -403,7 +402,7 @@ ( confusingly the "top" card is actually at the end ) ( this ends up being convenient for coding but is a ) ( bit confusing to think about ) -@cards $0cc &last $4 &end +( @cards $0cc &last $4 &end ) @cursor 80c0 e0f0 f8e0 1000 @cursox 7f3f 1f0f 071f efff diff --git a/kodiak.tal b/kodiak.tal new file mode 100644 index 0000000..0a9cb20 --- /dev/null +++ b/kodiak.tal @@ -0,0 +1,268 @@ +( deck.tal ) + +|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 hearts ) +( - #3d king of spades ) +( - #6c queen of hearts, face down ) +( - #93 three of diamonds, held ) + +|0000 + + @stock $34 ( draw pile - 52 bytes ) + @waste $18 ( face up pile - 24 bytes ) + @foundation $4 ( one per suit - 4 bytes, 4x1 ) + @tableau $85 ( the main board - 133 bytes, 7x19 ) + + @prev-button $1 + @prev-mouse-state $1 + @prev-mouse-x $2 + @prev-mouse-y $2 + @card-is-held $1 + +|0100 + #2d8b .System/r DEO2 + #2d18 .System/g DEO2 + #2d14 .System/b DEO2 + + #0100 .Screen/w DEO2 + #00c0 .Screen/h DEO2 + + init-rng-from-datetime + init-stock init-waste init-foundation + shuffle-stock deal-tableau + draw-background + draw-stock draw-waste draw-foundation draw-tableau + + ;on-mouse .Mouse/vect DEO2 +( ;on-key .Controller/vect DEO2 ) + BRK + +@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 + +@init-waste ( -> ) + #00 LITr -waste LITr 18 OVRr ADDr SWPr + &loop DUP STHkr STZ INCr GTHkr STHr ?&loop + POP POP2r JMP2r + +@init-foundation + #00 .foundation + STZk INC STZk INC STZk INC STZk POP2 + 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 ( -> ) + #33 LIT2r -tableau 00 + &loop STH2kr deal-column + LIT2r 1301 ADD2r + STHkr #07 LTH ?&loop + 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 ) + #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 ) + #01 SUB JMP2r ( s-1^ ) + +@swap-c ( src^ dst^ -> ) + LDZk STH ( src^ dst^ [d^] ) + OVR LDZ ( src^ dst^ s^ [d^] ) + SWP STZ ( src^ [d^] ; dst<-s ) + STHr SWP ( d^ src^ ) + STZ JMP2r ( ; src<-d ) + +@draw-stock ( -> ) + #0008 ,&y STR2 ( ; y0<-8 ) + .stock #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 POP2 POPr 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<- ) + draw-c ( lim^ zp^ ; draw c ) + ,&x LDR2 #0008 ADD2 ,&x STR2 ( lim^ zp^ ; x<-x+8 ) + INC GTHk ?&loop ( lim^ zp+1^ ) + &done POP2 JMP2r ( ) + +@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 JMP2r + +@draw-column ( idx^ -> ) + #00 OVR #0018 MUL2 #0030 ADD2 ,&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^ ) + &loop ( lim^ pos^ ) + LDZk DUP ?&ok !&done ( lim^ pos^ c^ ) + &ok LIT2 [ &x $2 ] .Screen/x DEO2 ( lim^ pos^ ; s/x<-x ) + LIT2 [ &y $2 ] .Screen/y DEO2 ( lim^ pos^ ; s/y<-y ) + 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-mask-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 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 + +@mouse-dx ( -> dx* ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 JMP2r +@mouse-dy ( -> dy* ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 JMP2r + +@mouse-dx8 ( -> dx^ ) .Mouse/x DEI2 .prev-mouse-x LDZ2 SUB2 NIP JMP2r +@mouse-dy8 ( -> dy^ ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 NIP JMP2r + +@on-move ( -> ) + .Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw + .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw + JMP2r + &redraw #00 .Screen/auto DEO + clear-prev-mouse draw-curr-mouse JMP2r + +@clear-prev-mouse ( -> ) + .prev-mouse-x LDZ2 .Screen/x DEO2 + .prev-mouse-y LDZ2 .Screen/y DEO2 + ;blank .Screen/addr 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 + ;cursor .Screen/addr DEO2 + #43 .Screen/sprite DEO JMP2r + +@on-click-down ( -> ) + .Mouse/state DEI ( state^ ) + .prev-mouse-state LDZ #ff EOR AND ( down^ ) + #01 AND ( TODO: support more than one button ) + ?&click JMP2r ( TODO: check particular button ) + &click +( find-mouse-over-card + ORAk ?&found POP2 JMP2r + &found + raise-cards .card-is-held STZ + !draw-cards ) JMP2r + +@on-click-up ( -> ) + .Mouse/state DEI #ff EOR ( not-state^ ) + .prev-mouse-state LDZ AND ( up^ ) + #01 AND ( TODO: support more than one button ) + ?&unclick JMP2r ( TODO: check particular button ) + &unclick + ( #00 .card-is-held STZ + draw-background draw-cards ) + JMP2r + +( @on-key ( -> brk ) + on-press on-release + .Controller/button DEI .prev-button STZ + BRK ) + +( @on-release ( -> ) + .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/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