deck is working pretty well
This commit is contained in:
parent
07c4f91b45
commit
08160c9a4d
241
deck.tal
241
deck.tal
|
|
@ -35,6 +35,26 @@
|
|||
|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 ]
|
||||
|
||||
( BUG: stack is growing, maybe redraw-all ? )
|
||||
|
||||
( TODO: move piles )
|
||||
( TODO: shuffle deck only )
|
||||
( TODO: try out rounded corners )
|
||||
( - face down can use white as transparent )
|
||||
( - face up black cards use red as transparent )
|
||||
( - face up red cards use black as transparent )
|
||||
( TODO: optional snap-to-grid setting? )
|
||||
|
||||
( ROTATION )
|
||||
( N 00 to E 01: dx=+0 dy=+8 )
|
||||
( 01 to 02: dx=+0 dy=+0 )
|
||||
( 02 to 03: dx=-8 dy=+0 )
|
||||
( 03 to 00: dx=+8 dy=-8 )
|
||||
( will require unhardcoding bounding boxes )
|
||||
|
||||
( BUG: try moving the "whole deck" and get into a weird state )
|
||||
|
||||
|0000
|
||||
@rng [ &x $2 &y $2 ]
|
||||
|
|
@ -45,9 +65,7 @@
|
|||
@card-is-held $1
|
||||
|
||||
|0100
|
||||
( #1234 #abcd init-rng )
|
||||
#4444 #abc9 init-rng
|
||||
|
||||
init-rng-from-datetime
|
||||
init-cards
|
||||
reset
|
||||
|
||||
|
|
@ -73,20 +91,34 @@
|
|||
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
|
||||
@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
|
||||
|
||||
@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 )
|
||||
|
||||
@on-move ( -> )
|
||||
.Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw
|
||||
.Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw
|
||||
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
|
||||
|
||||
( TODO: working stack overflow? )
|
||||
.card-is-held LDZ #00 EQU ?¬-dragging
|
||||
mouse-dx8 mouse-dy8 STH2 ( [dxdy*] )
|
||||
;cards/end held-end-offset ( limit* start* [dxdy*] )
|
||||
&hloop
|
||||
DUP2 STH2kr move-card ( limit* pos* [dxdy*] )
|
||||
#0004 ADD2 GTH2k ?&hloop ( limit* pos+4* [dxdy*] )
|
||||
POP2 POP2 POP2r
|
||||
|
||||
draw-background draw-cards ( TODO: fix me and remove this )
|
||||
|
||||
¬-dragging
|
||||
#00 .Screen/auto DEO
|
||||
clear-prev-mouse
|
||||
( TODO: clear prev held card )
|
||||
|
|
@ -112,12 +144,11 @@
|
|||
#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
|
||||
raise-cards .card-is-held STZ
|
||||
!draw-cards
|
||||
|
||||
@on-click-up ( -> )
|
||||
.Mouse/state DEI #ff EOR ( not-state^ )
|
||||
|
|
@ -151,17 +182,16 @@
|
|||
DUP #04 AND ?&select
|
||||
DUP #08 AND ?&start
|
||||
&skip POP JMP2r
|
||||
&ctrl POP !try-to-flip ( ;cards/last LDA2k #8000 EOR2 SWP2 STA2 !draw-cards )
|
||||
&ctrl POP !try-to-flip
|
||||
&alt POP !flip-all-cards
|
||||
&select POP !randomize ( ;cards raise-card !draw-cards )
|
||||
&start POP !reset ( ;draw-mask !draw-all-cards )
|
||||
&select POP !randomize
|
||||
&start POP !reset
|
||||
|
||||
( put all cards face down, and stack them )
|
||||
( in a single deck in the middle of the screen )
|
||||
@reset ( -> )
|
||||
all-cards-face-down
|
||||
shuffle ( FIXME )
|
||||
( #78 #50 stack-cards )
|
||||
#08 #18 stack-cards
|
||||
draw-background
|
||||
!draw-cards
|
||||
|
|
@ -177,7 +207,7 @@
|
|||
;turn-card-face-down !for-all-cards
|
||||
|
||||
@stack-cards ( x^ y^ -> )
|
||||
,stack-card/y STR ,stack-card/x STR #00 ,stack-card/c
|
||||
,stack-card/y STR ,stack-card/x STR #00 ,stack-card/c STR
|
||||
;stack-card !for-all-cards
|
||||
|
||||
@stack-card ( addr* -> )
|
||||
|
|
@ -216,8 +246,11 @@
|
|||
@flip-card ( addr* -> )
|
||||
LDA2k #8000 EOR2 SWP2 STA2 JMP2r
|
||||
|
||||
@turn-card-face-down ( addr* -> ) #80 ROT ROT STA JMP2r
|
||||
@turn-card-face-up ( addr* -> ) #00 ROT ROT STA JMP2r
|
||||
@turn-card-face-down ( addr* -> )
|
||||
LDA2k #8000 ORA2 SWP2 STA2 JMP2r
|
||||
|
||||
@turn-card-face-up ( addr* -> )
|
||||
LDA2k #7fff AND2 SWP2 STA2 JMP2r
|
||||
|
||||
@randomize ( -> )
|
||||
init-cards
|
||||
|
|
@ -258,6 +291,57 @@
|
|||
STH2r STA2 JMP2r ( ; last+2<-xy )
|
||||
&skip POP2 JMP2r ( )
|
||||
|
||||
( raises card at addr and everything it lifts )
|
||||
@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 )
|
||||
;cards/end SWP2 #0004 ADD2 ( limit* addr+4* [pos*] )
|
||||
&loop ( limit* addr* [pos*] )
|
||||
STH2kr OVR2 card-lifts ?&lift ( limit* addr* [pos*] )
|
||||
STH2k LIT2r [ &d $2 ] SUB2r ( limit* addr* [pos* addr-d*] )
|
||||
LDA2k STH2kr STA2 ( limit* addr* [pos* addr-d*] ; copy 1-2 )
|
||||
INC2 INC2 INC2r INC2r ( limit* addr+2* [pos* addr-d+2*] )
|
||||
LDA2k STH2r STA2 INC2 INC2 ( limit* addr+4* [pos*] ; copy 3-4 )
|
||||
GTH2k ?&loop !&done ( limit* addr+4* [pos*] )
|
||||
&lift ( limit* addr* [pos*] )
|
||||
,&d LDR2 #0004 ADD2 ,&d STR2 ( limit* addr* [pos*] ; d<-d+4 )
|
||||
DUP2 ( limit* addr* addr* )
|
||||
raise-cards/enqueue POP2 ( limit* addr* [pos*] )
|
||||
#0004 ADD2 GTH2k ?&loop ( limit* addr+4* [pos*] )
|
||||
&done ( limit* limit* [pos*] )
|
||||
POP2 POP2r ( limit* )
|
||||
,&d LDR2 SUB2 STH2 ( [dst=limit-d*] )
|
||||
,&pos LDR2 ;raise-cards/buf ( end* buf* [dst*] )
|
||||
SUB2k #02 SFT2 STH2 SWP2r ( end* buf* [count* dst*] )
|
||||
© ( end* pos* [count* dst*] )
|
||||
LDA2k STH2kr STA2 ( end* pos* [count* dst*] ; pos<-dst )
|
||||
INC2 INC2 INC2r INC2r ( end* pos+2* [count* dst+2*] )
|
||||
GTH2k ?© ( end* pos+2* [count* dst+2*] )
|
||||
POP2 POP2 POP2r ( [count*] )
|
||||
NIPr STHr JMP2r ( count^ )
|
||||
&enqueue ( c* -> pos* )
|
||||
,&pos LDR2 STH2 LDA2k STH2kr STA2 ( c* [pos*] ; buf[pos]<-c )
|
||||
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 ]
|
||||
|
||||
@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^ )
|
||||
|
||||
@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
|
||||
|
||||
( returns true if the card below lifts the card above )
|
||||
@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
|
||||
|
||||
|
|
@ -291,15 +375,16 @@
|
|||
@draw-cards
|
||||
;draw-card !draw-all-cards
|
||||
|
||||
@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 STR2 ( )
|
||||
.card-is-held LDZ ?&held ( )
|
||||
LIT2r :cards/end !&next ( [limit*] )
|
||||
&held LIT2r :cards/last ( [limit*] )
|
||||
&next LIT2r :cards ( [limit* start*] )
|
||||
held-end-offset STH2 ( [limit*] )
|
||||
LIT2r :cards ( [limit* pos*] )
|
||||
&loop ( [limit* pos*] )
|
||||
STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] )
|
||||
#00 STH2kr LDA INC2r ( card* x* [limit* pos+3*] )
|
||||
|
|
@ -307,11 +392,15 @@
|
|||
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 ( )
|
||||
LIT2r :cards/end ( [limit*] )
|
||||
held-end-offset STH2 ( [limit* offset*] )
|
||||
&mloop ( [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-mask ( [limit* pos+4] )
|
||||
GTH2kr STHr ?&mloop ( [limit* pos+4] )
|
||||
POP2r POP2r JMP2r ( )
|
||||
|
||||
@draw-background ( -> )
|
||||
#f2 .Screen/auto DEO
|
||||
|
|
@ -412,6 +501,14 @@
|
|||
#b1 .Screen/sprite DEO ( ; draw bottom right of card )
|
||||
JMP2r
|
||||
|
||||
@init-rng-from-datetime ( -> )
|
||||
#00 .DateTime/dow #5180 MUL2
|
||||
#00 .DateTime/hr DEI #0e10 MUL2 ADD2
|
||||
#00 .DateTime/min DEI #003c MUL2 ADD2
|
||||
#00 .DateTime/sec DEI ADD2 ( s* )
|
||||
DUP2 .DateTime/doy DEI2 MUL2 ( s* sdoy* )
|
||||
( fall-through )
|
||||
|
||||
@init-rng ( x* y* -> )
|
||||
#0001 ROT2 OVR2 ( y* 1* x* 1* )
|
||||
ORA2 .rng/x STZ2 ( y* 1* )
|
||||
|
|
@ -424,92 +521,6 @@
|
|||
SWP2 DUP2 #03 SFT2 EOR2 ( u* v=t^[t>>3]* )
|
||||
EOR2 DUP2 .rng/y STZ2 JMP2r ( u^v* ; y<-u^v )
|
||||
|
||||
( @draw-scene
|
||||
#0000 #0008 #0008 draw-card
|
||||
#0001 #0010 #0010 draw-card
|
||||
#0002 #0018 #0018 draw-card
|
||||
#0003 #0020 #0020 draw-card
|
||||
#0004 #0028 #0028 draw-card
|
||||
#0005 #0030 #0030 draw-card
|
||||
#0006 #0038 #0038 draw-card
|
||||
#0007 #0040 #0040 draw-card
|
||||
#0008 #0048 #0048 draw-card
|
||||
#0009 #0050 #0050 draw-card
|
||||
#000a #0058 #0058 draw-card
|
||||
#000b #0060 #0060 draw-card
|
||||
#000c #0068 #0068 draw-card
|
||||
|
||||
#000d #0080 #0008 draw-card
|
||||
#000e #0080 #0010 draw-card
|
||||
#000f #0080 #0018 draw-card
|
||||
#0010 #0080 #0020 draw-card
|
||||
#0011 #0080 #0028 draw-card
|
||||
#0012 #0080 #0030 draw-card
|
||||
#0013 #0080 #0038 draw-card
|
||||
#0014 #0080 #0040 draw-card
|
||||
#0015 #0080 #0048 draw-card
|
||||
#0016 #0080 #0050 draw-card
|
||||
#0017 #0080 #0058 draw-card
|
||||
#0018 #0080 #0060 draw-card
|
||||
#0019 #0080 #0068 draw-card
|
||||
|
||||
#001a #0098 #0008 draw-card
|
||||
#001b #0098 #0010 draw-card
|
||||
#001c #0098 #0018 draw-card
|
||||
#001d #0098 #0020 draw-card
|
||||
#001e #0098 #0028 draw-card
|
||||
#001f #0098 #0030 draw-card
|
||||
#0020 #0098 #0038 draw-card
|
||||
#0021 #0098 #0040 draw-card
|
||||
#0022 #0098 #0048 draw-card
|
||||
#0023 #0098 #0050 draw-card
|
||||
#0024 #0098 #0058 draw-card
|
||||
#0025 #0098 #0060 draw-card
|
||||
#0026 #0098 #0068 draw-card
|
||||
|
||||
#0027 #0008 #0088 draw-card
|
||||
#0028 #0018 #0088 draw-card
|
||||
#0029 #0028 #0088 draw-card
|
||||
#002a #0038 #0088 draw-card
|
||||
#002b #0048 #0088 draw-card
|
||||
#002c #0058 #0088 draw-card
|
||||
#002d #0068 #0088 draw-card
|
||||
#002e #0078 #0088 draw-card
|
||||
#002f #0088 #0088 draw-card
|
||||
#0030 #0098 #0088 draw-card
|
||||
#0031 #00a8 #0088 draw-card
|
||||
#0032 #00b8 #0088 draw-card
|
||||
#0033 #00c8 #0088 draw-card
|
||||
|
||||
#8000 #00b0 #0008 draw-card
|
||||
#8000 #00b0 #0010 draw-card
|
||||
#8000 #00b0 #0018 draw-card
|
||||
#8000 #00b0 #0020 draw-card
|
||||
#8000 #00b0 #0028 draw-card
|
||||
#8000 #00b0 #0030 draw-card
|
||||
#8000 #00b0 #0038 draw-card
|
||||
#8000 #00b0 #0040 draw-card
|
||||
#8000 #00b0 #0048 draw-card
|
||||
#8000 #00b0 #0050 draw-card
|
||||
#8000 #00b0 #0058 draw-card
|
||||
#8000 #00b0 #0060 draw-card
|
||||
#8000 #00b0 #0068 draw-card
|
||||
|
||||
#8000 #00c8 #0008 draw-card
|
||||
#8000 #00c8 #0010 draw-card
|
||||
#8000 #00c8 #0018 draw-card
|
||||
#8000 #00c8 #0020 draw-card
|
||||
#8000 #00c8 #0028 draw-card
|
||||
#8000 #00c8 #0030 draw-card
|
||||
#8000 #00c8 #0038 draw-card
|
||||
#8000 #00c8 #0040 draw-card
|
||||
#8000 #00c8 #0048 draw-card
|
||||
#8000 #00c8 #0050 draw-card
|
||||
#8000 #00c8 #0058 draw-card
|
||||
#8000 #00c8 #0060 draw-card
|
||||
#8000 #00c8 #0068 draw-card
|
||||
JMP2r )
|
||||
|
||||
( 52 cards x 4 bytes per card = 208 bytes )
|
||||
( each card has: )
|
||||
( )
|
||||
|
|
|
|||
Loading…
Reference in New Issue