diff --git a/deck.tal b/deck.tal index 78f33ad..32c57ab 100644 --- a/deck.tal +++ b/deck.tal @@ -42,6 +42,7 @@ @prev-mouse-state $1 @prev-mouse-x $2 @prev-mouse-y $2 + @card-is-held $1 |0100 #1234 #abcd init-rng @@ -63,35 +64,109 @@ BRK @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 ( -> dx* ) .Mouse/y DEI2 .prev-mouse-y LDZ2 SUB2 JMP2r + +@on-move ( -> ) .Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw - BRK + JMP2r &redraw + .card-is-held LDZ #00 EQU ?¬-dragging + LIT2r :cards/last INC2r INC2r + #00 STH2kr LDA mouse-dx ADD2 NIP STH2kr STA INC2r + #00 STH2kr LDA mouse-dy ADD2 NIP STH2kr STA POP2r + draw-background draw-cards ( TODO: fix me and remove this ) + ¬-dragging + #00 .Screen/auto DEO + clear-prev-mouse + ( TODO: clear prev held card ) + ( TODO: draw curr held card ) + 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 - #40 .Screen/sprite DEO + #40 .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 - BRK + #43 .Screen/sprite DEO JMP2r -@on-click ( TODO ) BRK +@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 +( .Mouse/x DEI2 .Mouse/y DEI2 find-card ) + find-mouse-over-card + ORAk ?&found POP2 JMP2r + &found + #01 .card-is-held STZ + raise-card !draw-cards + +@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 ) - .Controller/button DEI ( button^ ) - .prev-button LDZ #ff EOR AND ( press^ ) + 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 - POP BRK - &ctrl POP ;cards/last LDA2k #8000 EOR2 SWP2 STA2 draw-cards BRK - &alt POP reshuffle BRK - &select POP ;cards raise-card draw-cards BRK - &start POP BRK + &skip POP JMP2r + &ctrl POP !try-to-flip ( ;cards/last LDA2k #8000 EOR2 SWP2 STA2 !draw-cards ) + &alt POP !flip-all-cards ( reshuffle ) + &select POP !reshuffle ( ;cards raise-card !draw-cards ) + &start POP JMP2r ( ;draw-mask !draw-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 ( ) + +@try-to-flip ( -> ) + find-mouse-over-card + ORAk ?&found POP2 JMP2r + &found flip-card !draw-cards + +@flip-card ( addr* -> ) + LDA2k #8000 EOR2 SWP2 STA2 JMP2r @reshuffle ( -> ) init-cards @@ -116,35 +191,76 @@ POP2 POP2 JMP2r @raise-card ( addr* -> ) - DUP2 ;cards/last EQU2 ?&skip - LDA2k ,&card STR2 INC2 INC2 ( addr+2* ) - LDAk ,&x STR INC2 ( addr+3* ) - LDAk ,&y STR #0005 SUB2 ( addr-2* ) - ;cards/last SWP2 ( last* pos* ) - &loop ( last* pos* ) - STH2k #0004 ADD2 LDA2 ( last* n* [pos*] ) - STH2kr STA2 ( last* [pos*] ; pos<-n ) - STH2r INC2 INC2 ( last pos+2* ) - GTH2k ?&loop ( last* pos+2* ) - POP2 STH2 ( [last*] ) - LIT2 [ &card $2 ] ( c* [last*] ) - STH2kr STA2 INC2r INC2r ( [last+2*] ; last<-c ) - LIT [ &x $1 ] ( x^ [last+2*] ) - STH2kr STA INC2r ( [last+3*] ; last+2<-x ) - LIT [ &y $1 ] STH2r STA ( ; last+3<-y ) - JMP2r ( ) - &skip POP2 JMP2r ( ) + DUP2 ;cards/last EQU2 ?&skip ( addr* ) + LDA2k ,&card STR2 INC2 INC2 ( addr+2* ) + LDA2k ,&xy STR2 #0002 SUB2 ( addr-2* ) + ;cards/end SWP2 ( end* pos* ) + &loop ( end* pos* ) + STH2k #0004 ADD2 LDA2 ( end* n* [pos*] ) + STH2kr STA2 ( end* [pos*] ; pos<-n ) + STH2r INC2 INC2 ( end pos+2* ) + GTH2k ?&loop ( end* pos+2* ) + POP2 POP2 LIT2r :cards/last ( [last*] ) + LIT2 [ &card $2 ] ( c* [last*] ) + STH2kr STA2 INC2r INC2r ( [last+2*] ; last<-c ) + LIT2 [ &xy $2 ] ( xy* [last+2*] ) + STH2r STA2 JMP2r ( ; last+2<-xy ) + &skip POP2 JMP2r ( ) +@find-mouse-over-card ( -> addr* ) + .Mouse/x DEI2 .Mouse/y DEI2 !find-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*] ) + OVR2 OVR2 STH2kr ( x* y* x* y* pos* [limit* pos*] ) + intersects ?&done ( x* y* [limit* pos*] ) + LIT2r 0004 SUB2r ( x* y* [limit* pos-4*] ) + GTH2kr STHr ?¬found ( x* y* [limit* pos-4*] ) + !&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* ) + +( 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^ ) + 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^ ) @draw-cards - LIT2r :cards/end LIT2r :cards ( [limit* start*] ) - &loop ( [limit* pos*] ) - STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] ) - #00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] ) - #00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] ) - draw-card ( [limit* pos+4] ) - GTH2kr STHr ?&loop ( [limit* pos+4] ) - POP2r POP2r JMP2r + ;draw-card !draw-all-cards + +( 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 STR2 ( ) + .card-is-held LDZ ?&held ( ) + LIT2r :cards/end !&next ( [limit*] ) + &held LIT2r :cards/last ( [limit*] ) + &next LIT2r :cards ( [limit* start*] ) + &loop ( [limit* pos*] ) + STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] ) + #00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] ) + #00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] ) + LIT2 [ &draw $2 ] JSR2 ( [limit* pos+4] ) + GTH2kr STHr ?&loop ( [limit* pos+4] ) + POP2r POP2r ( ) + .card-is-held LDZ ?&mask JMP2r + &mask + LIT2r :cards/last + STH2kr LDA2 INC2r INC2r #00 STH2kr LDA INC2r #00 STH2r LDA draw-mask + JMP2r ( ) @draw-background ( -> ) #f2 .Screen/auto DEO @@ -171,7 +287,7 @@ @draw-mask-down ( -> ) #16 .Screen/auto DEO ( ; draw 2 tiles, increment x and addr ) ;masks #0080 ADD2 .Screen/addr DEO2 - #01 .Screen/sprite DEOk DEOk DEO + #04 .Screen/sprite DEOk DEOk DEO JMP2r ( assumes x/y already set ) @@ -211,17 +327,17 @@ #0080 MUL2 ;masks #0180 ADD2 ( idx* 128r* card+384* [q*] ) ADD2 STH2r #0010 MUL2 ADD2 ( idx* a=card+384+128r+16q* ) STH2k .Screen/addr DEO2 ( idx* [a*] ) - #01 .Screen/sprite DEO ( idx* [a*] ; draw top of card ) + #04 .Screen/sprite DEO ( idx* [a*] ; draw top of card ) find-middle-addr ( mid* [a*] ) ;tiles SUB2 #01 SFT2 ;masks ADD2 .Screen/addr DEO2 ( [a*] ) - #01 .Screen/sprite DEO ( [a*] ; draw middle of card ) + #04 .Screen/sprite DEO ( [a*] ; draw middle of card ) STH2r DUP2 #0008 ADD2 ( a* a+8* ) .Screen/addr DEO2 ( ) #01 .Screen/auto DEO ( ; draw 1 tile, increment x ) - #31 .Screen/sprite DEO ( ; draw bottom left of card ) + #34 .Screen/sprite DEO ( ; draw bottom left of card ) .Screen/addr DEO2 ( ) - #31 .Screen/sprite DEO ( ; draw bottom right of card ) + #34 .Screen/sprite DEO ( ; draw bottom right of card ) JMP2r ( assumes x/y already set )