diff --git a/cards.tal b/cards.tal index cff3768..a0e34bd 100644 --- a/cards.tal +++ b/cards.tal @@ -6,6 +6,10 @@ ( the high byte holds the flags. ) ( the low byte holds the card id. ) ( ) +( NOTE: this layout predates the one used by kodiak.tal ) +( so, that file has functions to convert from its ) +( card representation to this one for looking up tiles. ) +( ) ( FLAGS ) ( bit 1: flipping, #80 face down, #00 face up ) ( bits 2-6: unused ) @@ -28,245 +32,6 @@ ( 28: two of clubs ) ( 33: king of clubs ) -( 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 ) - -( @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 ) ) - -( 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 ) - #08 #18 stack-cards - draw-background - !draw-cards ) - -( f: addr* -> ) -( @for-all-cards ( f* -> ) - STH2 ;cards/end ;cards ( limit* start* [f*] ) - &loop DUP2 STH2kr JSR2 ( limit* pos* [f*] ) - #0004 ADD2 GTH2k ?&loop ( limit* pos+4* [f*] ) - POP2 POP2 POP2r JMP2r ( ) ) - -( @all-cards-face-down ( -> ) - ;turn-card-face-down !for-all-cards ) - -( @stack-cards ( x^ y^ -> ) - ,stack-card/y STR ,stack-card/x STR #00 ,stack-card/c STR - ;stack-card !for-all-cards ) - -( @stack-card ( addr* -> ) - INC2 INC2 STH2 ( [addr+2*] ) - LIT [ &x $1 ] STH2kr STA INC2r ( [addr+3] ; addr+2<-x ) - LIT [ &y $1 ] STH2r STA ( ; addr+3<-y ) - LIT [ &c $1 ] ?&skip - ,&y LDR #01 SUB ,&y STR - &skip ,&c LDR INC #03 AND ,&c STR JMP2r ) - -( @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 ( ) ) - -( @shuffle ( -> ) - ;cards/last ;cards ( last* start* ) - &loop ( last* pos* ) - SUB2k #02 SFT2 INC2 ( last* pos* n=[last-pos]/4+1* ) - random SWP2 ( last* pos* r* n* ) - DIV2k MUL2 SUB2 ( last* pos* i=r%n* ) - #20 SFT2 OVR2 ADD2 ( last* pos* alt=pos+4i* ) - LDA2k ,&c STR2 ( last* pos* alt* ; c<-alt ) - STH2 LDA2k STH2r STA2 STH2 ( last* [pos*] ; alt<-pos ) - LIT2 [ &c $2 ] STH2kr STA2 ( last* [pos*] ) - STH2r #0004 ADD2 ( last* pos+4* ) - GTH2k ?&loop ( last* pos+4* ) - POP2 POP2 JMP2r ( ) ) - -( @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 ) - -( @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 - draw-background - !draw-cards ) - -( @mod ( n* d* -> n%d* ) - DIV2k MUL2 SUB2 JMP2r ) - -( @init-cards ( -> ) - #0034 #0000 ( limit* 0* ) - &loop ( limit* c* ) - ;cards OVR2 ( limit* c* cards* c* ) - #0004 MUL2 ADD2 ( limit* c* addr=cards+4c* ) - INC2 STAk ( limit* c* addr+1* ; addr+1<-c ) - INC2 STH2 ( limit* c* [addr+2*] ) - random #00f0 mod NIP ( limit* c* x^ [addr+2*] ) - STH2kr STA INC2r ( limit* c* [addr+3*] ; addr+2<-x ) - random #00a8 mod NIP ( limit* c* y^ [addr+3*] ) - STH2r STA ( limit* c* ; addr+3<-y ) - INC2 GTH2k ?&loop ( limit* c+1* ) - POP2 POP2 JMP2r ) - -( @raise-card ( addr* -> ) - 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 ( ) ) - -( 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 ) - -( ( 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-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 ( ) - 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*] ) - #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 ( ) - 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 ( ) ) - @set-fg ( -> ) #40 ,set-sprite/layer STR JMP2r @set-bg ( -> ) #00 ,set-sprite/layer STR JMP2r @@ -291,8 +56,6 @@ @draw-spot-down ( -> ) #16 .Screen/auto DEO ( ; draw 2 tiles, increment x and addr ) -( ;masks #0080 ADD2 .Screen/addr DEO2 ) -( #02 set-sprite-3x ) ;masks #0100 ADD2 .Screen/addr DEO2 #8d set-sprite-3x JMP2r @@ -300,8 +63,6 @@ ( assumes x/y already set ) @draw-mask-down ( -> ) #16 .Screen/auto DEO ( ; draw 2 tiles, increment x and addr ) -( ;masks #0080 ADD2 .Screen/addr DEO2 ) -( #04 set-sprite-3x ) ;masks #0100 ADD2 .Screen/addr DEO2 #86 set-sprite-3x ( TODO fixme ) JMP2r @@ -313,14 +74,8 @@ #81 set-sprite-3x JMP2r -( @card-is-black ( idx* -> bool^ ) - #000c DIV2 -@q-is-black ( q* -> bool^ ) - NIP #01 SUB #fe AND JMP2r ( [q-1]&fe ) ) - @card-is-red ( idx* -> bool^ ) #000c DIV2 -( @q-is-red ( q* -> bool^ ) ) NIP #03 MUL #02 AND JMP2r ( [q*3]&2 ) @find-middle-addr ( idx* -> addr* ) @@ -340,30 +95,20 @@ #00ff AND2 ( idx* ; remove rotation/flip info for now ) DUP2 ( idx* idx* ) #000d DIV2k STH2k MUL2 SUB2 ( idx* r* [q*] ) -( #0080 MUL2 ;masks #0180 ADD2 ( idx* 128r* card+384* [q*] ) ) -( ADD2 STH2r #0010 MUL2 ADD2 ( idx* a=card+384+128r+16q* ) ) #0100 MUL2 ;masks #0300 ADD2 ( idx* 128r* card+384* [q*] ) ADD2 STH2r #0020 MUL2 ADD2 ( idx* a=card+384+128r+16q* ) STH2k .Screen/addr DEO2 ( idx* [a*] ) -( #04 set-sprite ( idx* [a*] ; draw top of card ) ) #86 set-sprite ( idx* [a*] ; draw top of card ) find-middle-addr ( mid* [a*] ) -( ;tiles SUB2 #01 SFT2 ;masks ADD2 ) ;tiles SUB2 ;masks ADD2 .Screen/addr DEO2 ( [a*] ) -( #04 set-sprite ( [a*] ; draw middle of card ) ) #86 set-sprite ( [a*] ; draw middle of card ) -( STH2r DUP2 #0008 ADD2 ( a* a+8* ) ) STH2r DUP2 #0010 ADD2 ( a* a+8* ) - - ( TODO: does flipping also flip move direction now? ) SWP2 #0008 .Screen/x DEI2 ADD2 .Screen/x DEO2 .Screen/addr DEO2 ( ) #01 .Screen/auto DEO ( ; draw 1 tile, increment x ) -( #34 set-sprite ( ; draw bottom left of card ) ) #b6 set-sprite ( ; draw bottom left of card ) .Screen/addr DEO2 ( ) -( #34 set-sprite ( ; draw bottom right of card ) ) #b6 set-sprite ( ; draw bottom right of card ) JMP2r @@ -381,8 +126,6 @@ .Screen/addr DEO2 ( [a*] ) #81 set-sprite ( [a*] ; draw middle of card ) STH2r DUP2 #0010 ADD2 ( a* a+16* ) - - ( TODO: does flipping also flip move direction now? ) SWP2 #0008 .Screen/x DEI2 ADD2 .Screen/x DEO2 .Screen/addr DEO2 ( ) #01 .Screen/auto DEO ( ; draw 1 tile, increment x ) @@ -397,8 +140,6 @@ #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 STA2 ( y* 1* ) ORA2 ;rng-x STA2 JMP2r ( ) @@ -417,11 +158,6 @@ ( - byte 2: card suit/value ) ( - byte 3: x position ) ( - byte 4: y position ) -( ) -( confusingly the "top" card is actually at the end ) -( this ends up being convenient for coding but is a ) -( bit confusing to think about ) -( @cards $0cc &last $4 &end ) @cursor 80c0 e0f0 f8e0 1000 ( @cursox 7f3f 1f0f 071f efff ) @@ -434,8 +170,5 @@ ( each tile is 16 bytes: a 2-bit 8x8 image ) @tiles ~card-sprites.tal -( each mask tile is 8 bytes: a 1-bit 8x8 image ) -( @masks ~mask-sprites.tal ) - ( each mask tile is 16 bytes: a 2-bit 8x8 image ) @masks ~mask2.tal