basic deck is kinda working

This commit is contained in:
~d6 2023-05-18 10:27:55 -04:00
parent 268d5a725c
commit 89118246db
1 changed files with 159 additions and 43 deletions

202
deck.tal
View File

@ -42,6 +42,7 @@
@prev-mouse-state $1 @prev-mouse-state $1
@prev-mouse-x $2 @prev-mouse-x $2
@prev-mouse-y $2 @prev-mouse-y $2
@card-is-held $1
|0100 |0100
#1234 #abcd init-rng #1234 #abcd init-rng
@ -63,35 +64,109 @@
BRK BRK
@on-mouse ( -> 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/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw
BRK JMP2r
&redraw &redraw
.card-is-held LDZ #00 EQU ?&not-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 )
&not-dragging
#00 .Screen/auto DEO #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-x LDZ2 .Screen/x DEO2
.prev-mouse-y LDZ2 .Screen/y DEO2 .prev-mouse-y LDZ2 .Screen/y DEO2
;blank .Screen/addr 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/x DEI2 DUP2 .prev-mouse-x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .prev-mouse-y STZ2 .Screen/y DEO2 .Mouse/y DEI2 DUP2 .prev-mouse-y STZ2 .Screen/y DEO2
;cursor .Screen/addr DEO2 ;cursor .Screen/addr DEO2
#43 .Screen/sprite DEO #43 .Screen/sprite DEO JMP2r
BRK
@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 ) @on-key ( -> brk )
.Controller/button DEI ( button^ ) on-press on-release
.prev-button LDZ #ff EOR AND ( press^ ) .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 #01 AND ?&ctrl
DUP #02 AND ?&alt DUP #02 AND ?&alt
DUP #04 AND ?&select DUP #04 AND ?&select
DUP #08 AND ?&start DUP #08 AND ?&start
POP BRK &skip POP JMP2r
&ctrl POP ;cards/last LDA2k #8000 EOR2 SWP2 STA2 draw-cards BRK &ctrl POP !try-to-flip ( ;cards/last LDA2k #8000 EOR2 SWP2 STA2 !draw-cards )
&alt POP reshuffle BRK &alt POP !flip-all-cards ( reshuffle )
&select POP ;cards raise-card draw-cards BRK &select POP !reshuffle ( ;cards raise-card !draw-cards )
&start POP BRK &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 ( -> ) @reshuffle ( -> )
init-cards init-cards
@ -116,35 +191,76 @@
POP2 POP2 JMP2r POP2 POP2 JMP2r
@raise-card ( addr* -> ) @raise-card ( addr* -> )
DUP2 ;cards/last EQU2 ?&skip DUP2 ;cards/last EQU2 ?&skip ( addr* )
LDA2k ,&card STR2 INC2 INC2 ( addr+2* ) LDA2k ,&card STR2 INC2 INC2 ( addr+2* )
LDAk ,&x STR INC2 ( addr+3* ) LDA2k ,&xy STR2 #0002 SUB2 ( addr-2* )
LDAk ,&y STR #0005 SUB2 ( addr-2* ) ;cards/end SWP2 ( end* pos* )
;cards/last SWP2 ( last* pos* ) &loop ( end* pos* )
&loop ( last* pos* ) STH2k #0004 ADD2 LDA2 ( end* n* [pos*] )
STH2k #0004 ADD2 LDA2 ( last* n* [pos*] ) STH2kr STA2 ( end* [pos*] ; pos<-n )
STH2kr STA2 ( last* [pos*] ; pos<-n ) STH2r INC2 INC2 ( end pos+2* )
STH2r INC2 INC2 ( last pos+2* ) GTH2k ?&loop ( end* pos+2* )
GTH2k ?&loop ( last* pos+2* ) POP2 POP2 LIT2r :cards/last ( [last*] )
POP2 STH2 ( [last*] ) LIT2 [ &card $2 ] ( c* [last*] )
LIT2 [ &card $2 ] ( c* [last*] ) STH2kr STA2 INC2r INC2r ( [last+2*] ; last<-c )
STH2kr STA2 INC2r INC2r ( [last+2*] ; last<-c ) LIT2 [ &xy $2 ] ( xy* [last+2*] )
LIT [ &x $1 ] ( x^ [last+2*] ) STH2r STA2 JMP2r ( ; last+2<-xy )
STH2kr STA INC2r ( [last+3*] ; last+2<-x ) &skip POP2 JMP2r ( )
LIT [ &y $1 ] STH2r STA ( ; last+3<-y )
JMP2r ( )
&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 ?&notfound ( x* y* [limit* pos-4*] )
!&loop ( x* y* [limit* pos-4*] )
&notfound 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 @draw-cards
LIT2r :cards/end LIT2r :cards ( [limit* start*] ) ;draw-card !draw-all-cards
&loop ( [limit* pos*] )
STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] ) ( TODO: if the top card is being "held" then we )
#00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] ) ( should not draw that here, because it will be )
#00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] ) ( drawn in the foreground using a mask. )
draw-card ( [limit* pos+4] ) @draw-all-cards ( draw* -> )
GTH2kr STHr ?&loop ( [limit* pos+4] ) ,&draw STR2 ( )
POP2r POP2r JMP2r .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 ( -> ) @draw-background ( -> )
#f2 .Screen/auto DEO #f2 .Screen/auto DEO
@ -171,7 +287,7 @@
@draw-mask-down ( -> ) @draw-mask-down ( -> )
#16 .Screen/auto DEO ( ; draw 2 tiles, increment x and addr ) #16 .Screen/auto DEO ( ; draw 2 tiles, increment x and addr )
;masks #0080 ADD2 .Screen/addr DEO2 ;masks #0080 ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEOk DEOk DEO #04 .Screen/sprite DEOk DEOk DEO
JMP2r JMP2r
( assumes x/y already set ) ( assumes x/y already set )
@ -211,17 +327,17 @@
#0080 MUL2 ;masks #0180 ADD2 ( idx* 128r* card+384* [q*] ) #0080 MUL2 ;masks #0180 ADD2 ( idx* 128r* card+384* [q*] )
ADD2 STH2r #0010 MUL2 ADD2 ( idx* a=card+384+128r+16q* ) ADD2 STH2r #0010 MUL2 ADD2 ( idx* a=card+384+128r+16q* )
STH2k .Screen/addr DEO2 ( idx* [a*] ) 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*] ) find-middle-addr ( mid* [a*] )
;tiles SUB2 #01 SFT2 ;masks ADD2 ;tiles SUB2 #01 SFT2 ;masks ADD2
.Screen/addr DEO2 ( [a*] ) .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* ) STH2r DUP2 #0008 ADD2 ( a* a+8* )
.Screen/addr DEO2 ( ) .Screen/addr DEO2 ( )
#01 .Screen/auto DEO ( ; draw 1 tile, increment x ) #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 ( ) .Screen/addr DEO2 ( )
#31 .Screen/sprite DEO ( ; draw bottom right of card ) #34 .Screen/sprite DEO ( ; draw bottom right of card )
JMP2r JMP2r
( assumes x/y already set ) ( assumes x/y already set )