basic deck is kinda working
This commit is contained in:
parent
268d5a725c
commit
89118246db
180
deck.tal
180
deck.tal
|
|
@ -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 ?¬-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
|
#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 )
|
||||||
|
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^ )
|
.Controller/button DEI ( button^ )
|
||||||
.prev-button LDZ #ff EOR AND ( press^ )
|
.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 )
|
||||||
LIT [ &x $1 ] ( x^ [last+2*] )
|
LIT2 [ &xy $2 ] ( xy* [last+2*] )
|
||||||
STH2kr STA INC2r ( [last+3*] ; last+2<-x )
|
STH2r STA2 JMP2r ( ; last+2<-xy )
|
||||||
LIT [ &y $1 ] STH2r STA ( ; last+3<-y )
|
|
||||||
JMP2r ( )
|
|
||||||
&skip POP2 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 ?¬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
|
@draw-cards
|
||||||
LIT2r :cards/end LIT2r :cards ( [limit* start*] )
|
;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*] )
|
&loop ( [limit* pos*] )
|
||||||
STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] )
|
STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] )
|
||||||
#00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] )
|
#00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] )
|
||||||
#00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] )
|
#00 STH2kr LDA INC2r ( card* x* y* [limit* pos+4*] )
|
||||||
draw-card ( [limit* pos+4] )
|
LIT2 [ &draw $2 ] JSR2 ( [limit* pos+4] )
|
||||||
GTH2kr STHr ?&loop ( [limit* pos+4] )
|
GTH2kr STHr ?&loop ( [limit* pos+4] )
|
||||||
POP2r POP2r JMP2r
|
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 )
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue