( ff.tal )

%TILE-NW { #70 }
%TILE-NE { #6e }
%TILE-SE { #7d }
%TILE-SW { #6d }
%TILE-VERT { #5d }
%TILE-HORIZ { #40 }

( devices )

|00 @System     [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console    [ &vector $2 &read $1 &pad $5 &write $1 ]
|20 @Screen     [ &vector $2 &width $2 &height $2 &auto  $1 &pad    $1
                  &x      $2 &y     $2 &addr   $2 &pixel $1 &sprite $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|b0 @DateTime   [ &y $2 &m $1 &d $1 &H $1 &M $1
                  &S $1 &dotw $1 &doty $2 &isdst $1 ]

( variables )
|0000
    @draw-mode $1

( program )
|0100
    #81 .draw-mode STZ

    ;redraw .Screen/vector DEO2     ( set up screen )
    ;on-key .Controller/vector DEO2 ( set up keyboard )
    ;init-rng JSR2                  ( initialize rng )

    #0100 .Screen/width DEO2    ( 256 pixels wide; 32 tiles )
    #00e0 .Screen/height DEO2   ( 224 pixels high; 28 tiles )

    #08f3 .System/r DEO2
    #0cd5 .System/g DEO2
    #0b66 .System/b DEO2

    ;draw-scene JSR2
    ;draw-party-info JSR2
    ;draw-menu JSR2
    ;draw-monsters JSR2


(    #0008 #0008 ;goto JSR2 #1234 ;draw-dec2 JSR2 )
(    #0008 #0010 ;goto JSR2 )
(    #32 ;draw-dec-pad JSR2 LIT '/ ;draw-ascii JSR2 #35 ;draw-dec-pad JSR2 )
(    ;party ;draw-health JSR2 )
    BRK

@draw-name ( hero* -> )
    INC2 ;draw-string JSR2
    JMP2r

@draw-health ( hero* -> )
    #0009 ADD2 STH2k #0002 ADD2 LDA2 STH2r LDA2
(    ;draw-dec2-pad JSR2 LIT '/ ;draw-ascii JSR2 ;draw-dec2-pad JSR2 )
    ;draw-dec2 JSR2 LIT '/ ;draw-ascii JSR2 ;draw-dec2 JSR2
    JMP2r

@draw-party-info ( -> )
    #00a8 #0090 #09 #08 ;draw-box JSR2
    #81 .draw-mode STZ
    ;party LIT2r 0098
    &loop
        #00b0 STH2kr ;goto JSR2
        DUP2 ;draw-name JSR2
        LIT2r 0008 ADD2r
        #00d0 STH2kr ;goto JSR2
        DUP2 ;draw-health JSR2
        LIT2r 0008 ADD2r
        #000d ADD2
        DUP2 ;party-limit LTH2 ,&loop JCN
    POP2 POP2r
    JMP2r

@draw-scene ( -> )
    #0000 #0000 #1e #10 ;draw-box JSR2
    ;draw-party-sprites JSR2
    ;draw-monster-sprites JSR2
    ;draw-background-sprites JSR2
    JMP2r

@draw-background-sprites
    #0008
    &loop
        DUP2 #0008 ;goto JSR2
        #c0 #05 #04 ;draw-sprite-nn JSR2
        #0028 ADD2
        DUP2 #00d8 LTH2 ,&loop JCN
    POP2
    JMP2r

(   #00d8 #0028 ;goto JSR2 #00 ;draw-sprite-23 JSR2
    #00d8 #0040 ;goto JSR2 #10 ;draw-sprite-23 JSR2
    #00d8 #0058 ;goto JSR2 #20 ;draw-sprite-23 JSR2
    #00d8 #0070 ;goto JSR2 #30 ;draw-sprite-23 JSR2 )
@draw-party-sprites ( -> )
    #0000
    &loop
(        DUP2 #0018 MUL2 #0028 ADD2 #00d8 SWP2 ;goto JSR2 )
        DUP2 #0018 MUL2 #0028 ADD2 #00d0 SWP2 ;goto JSR2
        DUP2 #000d MUL2 ;party ADD2 LDA #40 SFT ;draw-sprite-23 JSR2
        INC2
        DUP2 #0004 LTH2 ,&loop JCN
    POP2 JMP2r

@draw-monster-sprites ( -> )
    #0018 #0028 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0018 #0048 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0018 #0068 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0038 #0028 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0038 #0048 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0038 #0068 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0058 #0028 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0058 #0048 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    #0058 #0068 ;goto JSR2 #60 ;draw-sprite-33 JSR2
    JMP2r

@draw-menu ( -> )
    #0058 #0090 #08 #08 ;draw-box JSR2
    #81 .draw-mode STZ
    #0060 #0098 ;goto JSR2 #1e ;draw-tile JSR2
    #0068 #0098 ;goto JSR2 ;fight ;draw-string JSR2
    #0068 #00a0 ;goto JSR2 ;run ;draw-string JSR2
    #0068 #00a8 ;goto JSR2 ;magic ;draw-string JSR2
    #0068 #00b0 ;goto JSR2 ;drink ;draw-string JSR2
    #0068 #00b8 ;goto JSR2 ;item ;draw-string JSR2
    JMP2r

@draw-monsters ( -> )
    #0000 #0090 #09 #08 ;draw-box JSR2
    #81 .draw-mode STZ
    #0018 #0098 ;goto JSR2 ;imp ;draw-string JSR2
    #0018 #00a0 ;goto JSR2 ;wolf ;draw-string JSR2
    JMP2r

@load-tile ( offset* base* -> )
    STH2
    #00 SWP #40 SFT2
    STH2r ( ;petscii ) ADD2 .Screen/addr DEO2
    JMP2r

@draw ( -> )
    #81 .Screen/sprite DEO JMP2r

@draw-tile ( index^ -> )
    ;petscii ,load-tile JSR ( ,draw JMP )
    .draw-mode LDZ .Screen/sprite DEO JMP2r

@draw-fg ( -> )
    #c3 .Screen/sprite DEO JMP2r

@draw-sprite-tile ( index^ -> )
    ;sprites ,load-tile JSR ,draw-fg JMP

@draw-sprite-23 ( index^ -> )
    #02 #03 ,draw-sprite-nn JMP

@draw-sprite-33 ( index^ -> )
    #03 #03 ,draw-sprite-nn JMP

@draw-sprite-nn ( index^ cols^ rows^ -> )
    #01 .Screen/auto DEO
    ,&rows STR ,&cols STR STH
    #00
    &row-loop
        #00
        &col-loop
            STHkr ;draw-sprite-tile JSR2 INCr
            INC DUP ,&cols LDR LTH ,&col-loop JCN
        POP INC
        .Screen/x DEI2 #00 ,&cols LDR #0008 MUL2 SUB2 .Screen/x DEO2
        .Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
        DUP ,&rows LDR LTH ,&row-loop JCN
    POP POPr
    JMP2r [ &cols $1 &rows $1 ]

@goto ( x* y* -> )
    .Screen/y DEO2 .Screen/x DEO2 JMP2r

@draw-string ( s* -> )
    STH2
    #01 .Screen/auto DEO
    &loop
        STH2kr LDA DUP ,&continue JCN
        POP POP2r JMP2r
    &continue
(        #20 SUB ;draw-tile JSR2 )
        ;draw-ascii JSR2
        INC2r ,&loop JMP

@vertical-line ( count^ -> )
    .draw-mode LDZ STH
    #02 .Screen/auto DEO
    TILE-VERT ;petscii ;load-tile JSR2
    #00 SWP SUB
    &loop STHkr .Screen/sprite DEO INC DUP ,&loop JCN
    POP POPr
    JMP2r

@horizontal-line ( count^ -> )
    .draw-mode LDZ STH
    #01 .Screen/auto DEO
    TILE-HORIZ ;petscii ;load-tile JSR2
    #00 SWP SUB
    &loop STHkr .Screen/sprite DEO INC DUP ,&loop JCN
    POP POPr
    JMP2r

( w and h refer to the "internal" size of the box )
@draw-box ( x* y* w^ h^ -> )
    ,&h STR ,&w STR ,&y STR2 ,&x STR2

    #83 .draw-mode STZ

    ( top line )
    #01 .Screen/auto DEO
    ,&x LDR2 .Screen/x DEO2
    ,&y LDR2 .Screen/y DEO2
    TILE-NW ;draw-tile JSR2
    ,&w LDR ;horizontal-line JSR2
    TILE-NE ;draw-tile JSR2

    ( stash some variables here )
    ,&continue JMP
    [ &x $2 &y $2 &w $1 &h $1 ]
    &continue

    ( bottom line )
    ,&x LDR2 .Screen/x DEO2
    ,&y LDR2 #00 ,&h LDR INC2 #30 SFT2 ADD2 .Screen/y DEO2
    TILE-SW ;draw-tile JSR2
    ,&w LDR ;horizontal-line JSR2
    TILE-SE ;draw-tile JSR2

    ( prepare to draw vertical lines )
    ,&h LDR DUP

    ( left line )
    ,&x LDR2 .Screen/x DEO2
    ,&y LDR2 #0008 ADD2 STH2k .Screen/y DEO2
    ;vertical-line JSR2

    ( right line )
    ,&x LDR2 #00 ,&w LDR INC2 #30 SFT2 ADD2 .Screen/x DEO2
    STH2r .Screen/y DEO2
    ;vertical-line JSR2

    ( reset )
    #00 .Screen/auto DEO
    JMP2r

( draw the screen )
@randomize ( x0* y0* x1* y1* )
    ,&y1 STR2 ,&x1 STR2 ,&y0 STR2 ,&x0 STR2
    #01 .Screen/auto DEO                  ( ; auto update x pos )
    ,&y0 LDR2                             ( row )
    &rows                                 ( row )
        DUP2 .Screen/y DEO2               ( row ; y=row )
        ,&x0 LDR2 DUP2 .Screen/x DEO2     ( row col ; x=0 )
    &cols                                 ( row col )
        ;draw-random-sprite JSR2          ( ; random sprite/style )
        #0008 ADD2                        ( row col+8 )
        DUP2 ,&x1 LDR2 ( #0078 ) LTH2 ,&cols JCN        ( row col+8 )
        POP2 #0008 ADD2                   ( row+8 )
        DUP2 ,&y1 LDR2 ( #0068 ) LTH2 ,&rows JCN        ( row+8 )
        POP2 #00 .Screen/auto DEO         (  )
        JMP2r                             (  )
        [ &x0 $2 &y0 $2 &x1 $2 &y1 $2 ]

( draw a random sprite with a random style )
@draw-random-sprite
    ;rng JSR2 NIP ;petscii ;load-tile JSR2
    #81 .Screen/sprite DEO
    JMP2r

( redraw the screen )
@redraw
(    LIT &count 00 ,&skip JCN
    #0008 #0008 #00f8 #0028 ;randomize JSR2
    &skip
    ,&count LDR INC #03 AND ,&count STR )
    BRK

( respond to key-presses and controllers )
@on-key
(    #0008 #0008 #0078 #0068 ;randomize JSR2 )
    #0008 #0008 #00f8 #0028 ;randomize JSR2
    BRK

( initialize the rng seed )
( TODO: consider using date/time? )
@init-rng
    #1234 ,rng/x STR2
    #5678 ,rng/y STR2
    JMP2r

( returns the next number in a length 4294967295 sequence. )
@rng ( -> n* )
    ,&x LDR2                    ( x )
    DUP2 #50 SFT2 EOR2          ( t=x^(x<<5) )
    DUP2 #03 SFT2 EOR2          ( u=t^(t>>3) )
    ,&y LDR2 DUP2 ,&x STR2      ( u y ; x<-y )
    DUP2 #01 SFT2 EOR2 EOR2     ( v=u^(y^(y>>1)) )
    ,&y STR2k POP               ( v ; y<-v )
    JMP2r [ &x $2 &y $2 ]       ( v )

( string constants )

@fight "fight 00
@run "run 00
@magic "magic 00
@drink "drink 00
@item "item 00

@imp "imp 00
@wolf "wolf 00

( pc stats: 13 bytes per hero )
( - 1 byte: class )
( - 8 bytes: name )
( - 2 bytes: cur hp )
( - 2 bytes: max hp )
@party
    03 "asta 00 00 00 00 0024 0025
    02 "brek 00 00 00 00 0011 0015
    01 "dain 00 00 00 00 001c 001f
    00 "garl 00 00 00 00 0010 0010
    @party-limit

@draw-ascii ( c^ -> )
    #20 SUB ;draw-tile JMP2

@draw-dec ( n^ -> )
    #01 .Screen/auto DEO
    LITr 00 ( n [0] )
    &read ( n [k] )
        #0a DIVk STHk MUL SUB STHr INCr ( n%10 n/10 [k+1] )
        DUP ,&read JCN
    POP ( top element was 0000 )
    &write ( n0 n1 ... nk [k+1] )
        #30 ADD ( #18 DEO ) ;draw-ascii JSR2 LITr 01 SUBr ( n0 ... n{k-1} [k] )
        STHkr ,&write JCN
    POPr JMP2r

@draw-dec-pad ( n^ -> )
    #01 .Screen/auto DEO
    LITr 00 ( n [0] )
    &read ( n [k] )
        #0a DIVk STHk MUL SUB STHr INCr ( n%10 n/10 [k+1] )
        STHkr #03 LTH ,&read JCN
    POP ( top element was 0000 )
    &write0 ( n0 n1 ... nk [k+1] )
        DUP ,draw-dec/write JCN
        POP #00 ;draw-tile JSR2 ( sp ) LITr 01 SUBr
        STHkr ,&write0 JCN
        POPr JMP2r

@draw-dec2 ( n* -> )
    #01 .Screen/auto DEO
    LITr 00 ( n [0] )
    &read ( n [k] )
        #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
        DUP2 ORA ,&read JCN
    POP2 ( top element was 0000 )
    &write ( n0 n1 ... nk [k+1] )
        NIP #30 ADD ( #18 DEO ) ;draw-ascii JSR2 LITr 01 SUBr ( n0 ... n{k-1} [k] )
        STHkr ,&write JCN
    POPr JMP2r

@draw-dec2-pad ( n* -> )
    #01 .Screen/auto DEO
    LITr 00 ( n [0] )
    &read ( n [k] )
        #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
        STHkr #05 LTH ,&read JCN
    POP2 ( top element was 0000 )
    &write0 ( n0 n1 ... nk [k+1] )
        DUP2 ORA ,draw-dec2/write JCN
        POP2 #00 ;draw-tile JSR2 ( sp ) LITr 01 SUBr
        STHkr ,&write0 JCN
        POPr JMP2r

@draw-dec2-vpad ( n* pad^ -> )
    #01 .Screen/auto DEO
    LITr 00 ( n [0] )
    &read ( n [k] )
        #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
        STHkr #05 LTH ,&read JCN
    POP2 ( top element was 0000 )
    &write0 ( n0 n1 ... nk [k+1] )
        DUP2 ORA ,draw-dec2/write JCN
        POP2 #00 ;draw-tile JSR2 ( sp ) LITr 01 SUBr
        STHkr ,&write0 JCN
        POPr JMP2r

( PETSCII tiles, 2-bit binary data )
( TODO: these could be 1-bit instead )
@petscii
    ~chr/petscii.tal

( sprite tiles, 2-bit binary data )
@sprites
    ~chr/tiles.tal