basic deck is kinda working
This commit is contained in:
parent
268d5a725c
commit
89118246db
202
deck.tal
202
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 )
|
||||
|
|
Loading…
Reference in New Issue