( deck.tal )

( CARD LAYOUT )
( )
( cards are stored as 16-bit values. )
( the high byte holds the flags. )
( the low byte holds the card id. )
( )
( FLAGS )
(   bit 1:    flipping, #80 face down, #00 face up )
(   bits 2-6: unused )
(   bits 7-8: rotation, #00 north, #01 east, #02 south, #03 west )
( )
( IDENTIFIER )
(   00: ace of spades )
(   01: two of spades )
(   ... )
(   0b: king of spades )
(   0c: ace of hearts )
(   0d: two of hearts )
(   ... )
(   19: king of hearts )
(   1a: ace of diamonds )
(   1b: two of diamonds )
(   ... )
(   26: king of diamonds )
(   27: ace of clubs )
(   28: two of clubs )
(   33: king of clubs )

|00 @System     [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
|10 @Console    [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ]
|20 @Screen     [ &vect $2 &w $2 &h $2 &auto  $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
|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 ]

|0000
    @rng [ &x $2 &y $2 ]
    @prev-button $1
    @prev-mouse-state $1
    @prev-mouse-x $2
    @prev-mouse-y $2

|0100
    #1234 #abcd init-rng

    init-cards

    #2d8b .System/r DEO2
    #2d18 .System/g DEO2
    #2d14 .System/b DEO2

    #0100 .Screen/w DEO2
    #00c0 .Screen/h DEO2

    ;on-key .Controller/vect DEO2
    ;on-mouse .Mouse/vect DEO2

    draw-background
    draw-cards
    BRK

@on-mouse ( -> brk )
    .Mouse/x DEI2 .prev-mouse-x LDZ2 NEQ2 ?&redraw
    .Mouse/y DEI2 .prev-mouse-y LDZ2 NEQ2 ?&redraw
    BRK
    &redraw
    #00 .Screen/auto DEO
    .prev-mouse-x LDZ2 .Screen/x DEO2
    .prev-mouse-y LDZ2 .Screen/y DEO2
    ;blank .Screen/addr DEO2
    #40 .Screen/sprite DEO
    .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

@on-click ( TODO ) BRK

@on-key ( -> brk )
    .Controller/button DEI       ( button^ )
    .prev-button LDZ #ff EOR AND ( press^ )
    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

@reshuffle ( -> )
    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
    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               ( )


@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-background ( -> )
    #f2 .Screen/auto DEO
    ;tiles #0200 ADD2 .Screen/addr DEO2
    #0080 .Screen/x DEO2
    draw-background/twice
    #0000 .Screen/x DEO2
    &twice
    #0000 .Screen/y DEO2
    #81 .Screen/sprite
    DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk
    DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEOk
    DEOk DEOk DEOk DEOk DEOk DEOk DEOk DEO JMP2r

@draw-mask ( idx* x* y* -> )
    .Screen/y DEO2 .Screen/x DEO2
    OVR #80 LTH ?draw-mask-up POP2 !draw-mask-down

@draw-card ( idx* x* y* -> )
    .Screen/y DEO2 .Screen/x DEO2
    OVR #80 LTH ?draw-face-up POP2 !draw-face-down

( 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
    #01 .Screen/sprite DEOk DEOk DEO
    JMP2r

( assumes x/y already set )
@draw-face-down ( -> )
    #16 .Screen/auto DEO        ( ; draw 2 tiles, increment x and addr )
    ;tiles #0100 ADD2 .Screen/addr DEO2
    #81 .Screen/sprite DEOk DEOk DEO
    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* )
    #000d DIV2k STH2k MUL2 SUB2 ( r* [q*] )
    DUP2 #000a LTH2 ?&normal
    DUP2 #000a NEQ2 ?&not-j POP2 #0200 !&face
    &not-j #000b NEQ2 ?&not-q #0100 !&face
    &not-q #0000
    &face ;tiles ADD2 #00c0 ADD2
    STH2r card-is-red ?&is-red JMP2r
    &is-red #0020 ADD2 JMP2r
    &normal POP2 POP2r ;tiles #0020 ADD2 JMP2r

( assumes x/y already set )
@draw-mask-up ( idx* -> )
    #16 .Screen/auto DEO        ( ; draw 2 tiles, increment x and addr )
    #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* )
    STH2k .Screen/addr DEO2     ( idx* [a*] )
    #01 .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 )
    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 )
    .Screen/addr DEO2           ( )
    #31 .Screen/sprite DEO      ( ; draw bottom right of card )
    JMP2r

( assumes x/y already set )
@draw-face-up ( idx* -> )
    #16 .Screen/auto DEO        ( ; draw 2 tiles, increment x and addr )
    #00ff AND2                  ( idx* ; remove rotation/flip info for now )
    DUP2                        ( idx* idx* )
    #000d DIV2k STH2k MUL2 SUB2 ( idx* r* [q*] )
    #0100 MUL2 ;tiles #0300 ADD2 ( idx* 256r* card+768* [q*] )
    ADD2 STH2r #0020 MUL2 ADD2  ( idx* a=card+768+256r+32q* )
    STH2k .Screen/addr DEO2     ( idx* [a*] )
    #81 .Screen/sprite DEO      ( idx* [a*] ; draw top of card )
    find-middle-addr            ( mid* [a*] )
    .Screen/addr DEO2           ( [a*] )
    #81 .Screen/sprite DEO      ( [a*] ; draw middle of card )
    STH2r DUP2 #0010 ADD2       ( a* a+16* )
    .Screen/addr DEO2           ( )
    #01 .Screen/auto DEO        ( ; draw 1 tile, increment x )
    #b1 .Screen/sprite DEO      ( ; draw bottom left of card )
    .Screen/addr DEO2           ( )
    #b1 .Screen/sprite DEO      ( ; draw bottom right of card )
    JMP2r

@init-rng ( x* y* -> )
    #0001 ROT2 OVR2             ( y* 1* x* 1* )
    ORA2 .rng/x STZ2            ( y* 1* )
    ORA2 .rng/x STZ2 JMP2r      ( )

@random ( -> x* )
    .rng/x LDZ2 DUP2 #50 SFT2 EOR2 ( t=x^[x<<5]* )
    .rng/y LDZ2 DUP2 .rng/x STZ2   ( t* y* ; x<-y )
    DUP2 #01 SFT2 EOR2             ( t* u=y^[y>>1]* )
    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: )
( )
( - byte 1: flags )
( - 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
@blank  0000 0000 0000 0000

( each tile is 16 bytes: a 2-bit 8x8 image )
@tiles ~card.tal

( each mask tile is 8 bytes: a 1-bit 8x8 image )
@masks ~mask.tal