diff --git a/deck.tal b/deck.tal index 57dfa90..f8c859f 100644 --- a/deck.tal +++ b/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: ) ( )