flappy.tal

( flappy thing )
( released under unlicense.org )

( coding convention: roughly follows the standard forth and uxn conventions
  but uses the Captal Letters to express short values )

( we use special representations to express y-axis values )
( player: 4-bit fixed point numbers )
( wall: sprite row numbers [divided by 8] )

( macros )

%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }

%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }

%NOT { #00 EQU }
%DEC { #01 SUB } %DEC2 { #0001 SUB2 }

%2* { #10 SFT } %4* { #20 SFT } %8* { #30 SFT }
%2/ { #01 SFT } %4/ { #02 SFT } %8/ { #03 SFT }

%2** { #10 SFT2 } %4** { #20 SFT2 } %8** { #30 SFT2 }
%2// { #01 SFT2 } %4// { #02 SFT2 } %8// { #03 SFT2 }

%RTN { JMP2r }

( devices )

|00 @system     [ &Vector $2 &pad    $6 &R      $2 &G     $2 &B      $2 ]
|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 ]

( constants )

%Gravity  { #0004 }
%Thrust   { #0040 }
%Player-x { #0100 }
%Start-y  { #0800 }
%Scroll   { #0004 }

( variables )

|0000

@player [ &Y $2 &V $2 ]
@wall   [ &X $2 &y $1 &h $1 ]

|0080 @score $2

( program )

|0100 ( -> )

    ( theme )
    #07ff .system/R DEO2
    #0e4f .system/G DEO2
    #0c4f .system/B DEO2

    ( random seed )
    #03 ;rand/a STA

    ( vector )
    ;step-game .screen/Vector DEO2

    ( game reset )
    ;reset-game JSR2

BRK

@reset-game ( -> )

    ;clear-screen JSR2

    ( player reset )
    #40 ;draw-player JSR2
    Start-y .player/Y STZ2
    Thrust .player/V STZ2

    ( 1st wall )
    ;init-wall JSR2
    #01 ;save-wall JSR2

    ( 2nd wall )
    ;init-wall JSR2
    .wall/X LDZ2 #00c0 ++ .wall/X STZ2
    #02 ;save-wall JSR2

    ( 3rd wall )
    ;init-wall JSR2
    .wall/X LDZ2 #0180 ++ .wall/X STZ2
    #03 ;save-wall JSR2

    ( reset score )
    #0000 .score STZ2

RTN

@step-game ( -> )

    ( player update )
    [ #40 ;draw-player JSR2 ] [ ;update-player JSR2 ]

    ( 1st wall update )
    [ #01 ;load-wall JSR2 ] [ ;update-wall JSR2 ] [ #01 ;save-wall JSR2 ]
    [ ;check-collision JSR2 ,&kill JCN ] [ ;draw-wall JSR2 ]

    ( 2nd wall update )
    [ #02 ;load-wall JSR2 ] [ ;update-wall JSR2 ] [ #02 ;save-wall JSR2 ]
    [ ;check-collision JSR2 ,&kill JCN ] [ ;draw-wall JSR2 ]

    ( 3rd wall update )
    [ #03 ;load-wall JSR2 ] [ ;update-wall JSR2 ] [ #03 ;save-wall JSR2 ]
    [ ;check-collision JSR2 ,&kill JCN ] [ ;draw-wall JSR2 ]

    ( player draw )
    #4a ;draw-player JSR2

    ( score )
    .score LDZ2 INC2 .score STZ2 
    ;score LDZ2 #01 ;draw-score JSR2

BRK

&kill
    ( replace screen vector )
    ;step-kill .screen/Vector DEO2
    .score LDZ2 #02 ;draw-score JSR2

BRK

@step-kill ( -> )

    ( increment count until 32 )
    ,&count LDR INC
    DUP #20 > ,&term JCN
    DUP ,&count STR

    ( blinking player with count&2 )
    #01 AND #41 ADD ;draw-player JSR2

BRK

&term ( count -- )

    ( reset all )
    POP
    #00 ,&count STR
    ;reset-game JSR2
    ;step-game .screen/Vector DEO2

BRK

    &count $1

( wall )

@init-wall ( -- )

    ( X = Width )
    .screen/Width DEI2 .wall/X STZ2

    ( y = [rand & 0x1f] + 1 )
    ;rand JSR2 #1f AND #01 + .wall/y STZ

    ( h = 8 )
    #08 .wall/h STZ

RTN

@update-wall ( -- )

    ( jump to init-wall if X < -32 )
    .wall/X LDZ2 #0020 ++ #8000 >> ;init-wall JCN2

    ( X -= Scroll )
    .wall/X LDZ2 Scroll -- .wall/X STZ2

RTN

@draw-wall ( -- )

    ( pipe from 0 to [y - 1] )
    [ .wall/X LDZ2 ] [ #00 ] [ .wall/y LDZ DEC ] ;draw-pipe JSR2

    ( ring at [y - 1] )
    [ .wall/X LDZ2 ] [ .wall/y LDZ DEC ] ;draw-ring JSR2

    ( ring at [y + h] )
    [ .wall/X LDZ2 ] [ .wall/y LDZ .wall/h LDZ + ] ;draw-ring JSR2

    ( pipe from [y + h] to [height / 8 - y - h] )
    ( X ) .wall/X LDZ2
    ( y ) .wall/y LDZ .wall/h LDZ + INC
    ( h ) .screen/Height DEI2 8// NIP .wall/y LDZ - .wall/h LDZ -
    ;draw-pipe JSR2

RTN

@draw-ring ( X y -- )
    ( sprite position = X, y * 8 )
    [ #00 SWP 8** .screen/Y DEO2 ] [ .screen/X DEO2 ]

    ( sprite pattern and auto increment )
    [ ;&sprite .screen/Addr DEO2 ] [ #05 .screen/auto DEO ]

    ( draw sprites )
    #01 .screen/sprite DEOk DEOk DEOk DEOk DEO

RTN

    &sprite
    ffef efef efef ff00
    ffb9 bab9 bab9 ff00
    ff40 9040 a840 ff00
    ff01 0101 0101 ff00
    0000 0000 0000 0000

@draw-pipe ( X y h -- )

    ( rs = h, &X = X, ws = Y * 8 )
    [ STH ] [ ROT ROT ,&X STR2 ] [ #00 SWP 8** ]

    ( sprite auto increment )
    #05 .screen/auto DEO

    &yloop
        ( set position )
        [ ,&X LDR2 .screen/X DEO2 ] [ DUP2 .screen/Y DEO2 ]

        ( draw sprites with auto increment )
        ;&sprite .screen/Addr DEO2
        #01 .screen/sprite DEOk DEOk DEOk DEOk DEO

        #0008 ++                    ( next row )
        STHr DEC STHk ,&yloop JCN   ( loop until --h == 0 )

    POP2 POPr

RTN

    &X $2

    &sprite
    3737 3737 3737 3737
    dcdd dcdd dcdd dcdd
    a054 a048 a054 a048
    0404 0404 0404 0404
    0000 0000 0000 0000

( wall multiplexer )

@save-wall ( idx -- )
    4* .wall/X +                    ( address of wall[idx] )
    DUP .wall/X LDZ2 ROT STZ2       ( copy first word )
    INC INC .wall/y LDZ2 ROT STZ2   ( copy second word )
RTN

@load-wall ( idx -- )
    4* .wall/X +                    ( address of wall[idx] )
    LDZ2k .wall/X STZ2              ( copy first word )
    INC INC LDZ2 .wall/y STZ2       ( copy second word )
RTN

( player )

@update-player ( -- )

    ( reset V on up-key press )
    ;get-up-key JSR2 NOT ,&no-up JCN
        Thrust .player/V STZ2
    &no-up

    ( V += Gravity )
    .player/V LDZ2 Gravity ++ .player/V STZ2

    ( Y += V - 0080 )
    .player/Y LDZ2 .player/V LDZ2 ++ #0080 -- .player/Y STZ2

RTN

@check-collision ( -- hit )

    ( x-check )

    ( check: wall/X - player/X + 24 < 32 )
    .wall/X LDZ2 Player-x -- #0018 ++ #0020 <<

    ( return 0 on false )
    ,&x-ok JCN
        #00 RTN
    &x-ok

    ( y-check )

    ( temp = player/Y / 8 / 16 + 1 )
    .player/Y LDZ2 #07 SFT2 NIP INC

    ( check: temp+1 > wall/y )
    DUP INC .wall/y LDZ >

    ( return 1 on false )
    ,&y-gth JCN
        POP #01 RTN
    &y-gth

    ( check: temp > wall/y + wall/h )
    .wall/y LDZ .wall/h LDZ + >

    ( use result as return value )
RTN

@draw-player ( color -- )

    STH ( use return stack to store color )

    ( sprite settings: pattern address and auto increment )
    [ ;&sprite #00 .player/V LDZ2 #0080 >> #50 SFT2 ADD2 .screen/Addr DEO2 ] [ #05 .screen/auto DEO ]

    ( y-axis position )
    .player/Y LDZ2 #04 SFT2

    ( first row )
    [ Player-x .screen/X DEO2 ] [ DUP2 .screen/Y DEO2 ]
    STHrk .screen/sprite DEOk DEO

    ( second row )
    [ Player-x .screen/X DEO2 ] [ #0008 ++ .screen/Y DEO2 ]
    STHr .screen/sprite DEOk DEO

RTN
    &sprite
    0000 0000 0001 0307
    0010 3874 fec0 c0c0
    0f1c 3870 0000 0000
    a070 7070 7030 1000
    ( down )
    1018 1c1e 0e05 0307
    0010 3874 fec0 c0e0
    0f1c 3870 0000 0000
    e000 0000 0000 0000

( misc )

@clear-screen ( -- )

    ( sprite pattern and auto increment )
    [ ;&sprite .screen/Addr DEO2 ] [ #01 .screen/auto DEO ]

    ( col = screen/Width / 8 )
    .screen/Width DEI2 8// NIP ,&col STR

    ( ws: row count )
    .screen/Height DEI2 8// NIP

    &y-loop
        DEC ( next row )

        ( sprite position = 0, row * 8 )
        [ #0000 .screen/X DEO2 ] [ DUP #00 SWP 8** .screen/Y DEO2 ]

        ( ws: DEO params, rs: column count )
        [ #00 .screen/sprite ] [ ,&col LDR STH ]

        ( row fill )
        &x-loop DEOk STHr DEC STHk ,&x-loop JCN

        POP2 POPr           ( stack restore )
        DUP ,&y-loop JCN    ( loop until row == 0 )
    POP

RTN

    &col $1
    &sprite 0000 0000 0000 0000

@get-up-key ( -- up )

    .controller/button DEI #04 SFT #01 AND

RTN

@rand ( -- number )

    ( 8-bit PRNG https://github.com/edrosten/8bit_rng )

    ( t = x ^ (x << 4) )
    ,&x LDR DUP #40 SFT EOR
    ( x = y )
    ,&y LDR ,&x STR
    ( y = z )
    ,&z LDR ,&y STR
    ( z = a )
    ,&a LDR DUP ,&z STR
    ( a = z ^ t ^ (z >> 1) ^ (t << 1) )
    DUP #10 SFT EOR SWP DUP #01 SFT EOR EOR
    DUP ,&a STR

RTN

    &x $1 &y $1 &z $1 &a $1

@draw-score ( short* color -- )

    #0010 .screen/X DEO2
    #0010 .screen/Y DEO2

    STH SWP 
    DUP #04 SFT #00 SWP 8** ;font-hex ++ .screen/Addr DEO2
        ( draw ) STHkr .screen/sprite DEO
    #0f AND #00 SWP 8** ;font-hex ++ .screen/Addr DEO2
    #0018 .screen/X DEO2
        ( draw ) STHkr .screen/sprite DEO
    DUP #04 SFT #00 SWP 8** ;font-hex ++ .screen/Addr DEO2
    #0020 .screen/X DEO2
        ( draw ) STHkr .screen/sprite DEO
    #0f AND #00 SWP 8** ;font-hex ++ .screen/Addr DEO2
    #0028 .screen/X DEO2
        ( draw ) STHr .screen/sprite DEO

RTN

@font-hex
    007c 8282 8282 827c 0030 1010 1010 1010
    007c 8202 7c80 80fe 007c 8202 1c02 827c
    000c 1424 4484 fe04 00fe 8080 7c02 827c
    007c 8280 fc82 827c 007c 8202 1e02 0202
    007c 8282 7c82 827c 007c 8282 7e02 827c
    007c 8202 7e82 827e 00fc 8282 fc82 82fc
    007c 8280 8080 827c 00fc 8282 8282 82fc
    007c 8280 f080 827c 007c 8280 f080 8080