platformer.vfx

\ ------------------------------------------------------------------------------
\ Platformer System
\
\ This is a work-in-progress.
\ 
\ Note that the logic reads player input.
\ The intent is for input to be disabled or simulated from the outside
\ if the platformer actor is to be non-player-controlled. 
\ ------------------------------------------------------------------------------

trait: %platformer
    prop climbing <save
    prop on-ground 
    prop falling

    prop gravity :fixed
    prop terminal-vx :fixed
    prop terminal-vy :fixed
    prop jump-power :fixed
    prop rise-power :fixed
    prop walk-speed :fixed
    prop air-control :fixed

    :: ->turn ( dir - ) fac ! ; : turn ( dir - )  me ->turn ;
    :: ->walk ;             : walk      me ->walk ;
    :: ->jump ;             : jump      me ->jump ;
    :: ->squat ;            : squat     me ->squat ;
    redef :: ->idle ;       : idle      me ->idle ;
    :: ->fall ;             : fall      me ->fall ;        
    :: ->climb ;            : climb     me ->climb ;
    :: ->land ;             : land      me ->land ;

    :: ->hit ;              : hit       me ->hit ;

trait;

public
0 value ground?

private

: !flip  0 fac @ left = if h| then a.flp ! ;
: bottom ( - y. ) y @ y1 @ >p + h1 @ >p + ;
: dampen ( fx. fy. - ) vx 2@ 2p* vx 2! ;
: clamp-vx ( vx. - ) vx @ swap dup negate swap clamp vx ! ;
redef : accel ( vx. vy. - ) vx 2+! ;
: in-air?  on-ground @ not ;
: apply-gravity  climbing @ ?exit  vy @ gravity @ + terminal-vy @ min vy ! ;

: ?control  finished @ -exit r> drop ;

: ?jump  ?control  <jump> pressed? if jump bail then ;
: ?left  <left> held? if left turn walk then ;
: ?right  <right> held? if right turn walk then ;
: ?walk  ?control  in-air? ?exit  ?left ?right ;
: ?idle  <left> held? <right> held? or not if idle then ;
: ?dirkey  fac @ left = if <left> else <right> then ;
: ?stop  ?dirkey letgo? if ." STOP **** " cr idle then ;
: ?stick  ?dirkey held? not if .666 dup dampen then ;
: stand  bottom vy @ + gap >p umod 1. + negate y +!  0 vy ! ;
: ?climb  
    ?control  
    <down> held? if 0 1 +tile@ climbable? if 2. y +! climb exit then then 
    <down> held? <up> held? or if 0 0 +tile@ climbable? if climb then then ;    
: ?stepoff  climbing @ ?exit  vy @ 0> if fall then ;
: to-a-stop  .825 1. dampen vx @ abs .15 < if 0 vx ! then ;

: control-in-air
    .98 1. dampen 
    walk-speed @ clamp-vx
    ?control  
    <left> held? if  air-control @ negate vx +!  then
    <right> held? if  air-control @ vx +!  then
    vx @ 0< if left turn then
    vx @ 0> if right turn then 
;

: control-jump
    vy @ 0<  <jump> held? and if 
        ?control  
        rise-power @ negate vy +!  control-in-air
    else
        fall
    then
;

: walk-accel
    fac @ left = if
        vx @ -.08 + walk-speed @ negate max vx !  
    else
        vx @ .08 + walk-speed @ min vx !
    then
;

: ?door 
    \ TODO: Generalize
    f2dup ftile@ 8 =
    c" key" have and if
        *beep11*
        0 f2dup ftile! 1 c" key" discard exit 
    then
    f2dup ftile@ 10 =
    c" ring" have and if
        *beep11*
        0 f2dup ftile! 1 c" ring" discard exit 
    then 
;

c: crumbler %actor ;

\ Crumbling blocks
: ?crumble
    floor? -exit
    f2dup ftile@ 178 = -exit
    fover f>s fdup f>s at
    crumbler one drop ;

\ Background collisions
: ?bghit
    0 to ground?
    x1 2@ w1 2@ playfield tmcol> 
        ( f:x f:y )
        climbing @ not if
            ?crumble
            floor? if
                f2dup gap s>f f- ftile@ climbable?
                f2dup ftile@ climbable? and if
                    drop false
                    0 to floor?
                    exit
                then
            then
            in-air? not if
                lwall? if
                    <right> held? not if idle then
                    <left> held? if ?door then
                then
                rwall? if
                    <left> held? not if idle then
                    <right> held? if ?door then
                then
            then
        else
            floor? if
                x 2@ y1 @ >p + h1 @ >p +
                    vx 2@ 2+ xy>cr playfield spot @ climbable?
                        if drop 0 else 0 a.spd ! then
            then
        then
        ground? floor? or to ground?

;

: ?acthit  
    0 to ground?
    actcol> 
        ground? floor? or to ground?
;

: solid-collisions
    ?bghit ground? 
    ?acthit ground?
    or to ground?
    climbing @ ?exit
    ground? if 
        on-ground @ not if land then
    else 
        on-ground @ if ?stepoff then 
    then
;

public

: platformer-physics  
    apply-gravity
    solid-collisions
    !flip ;

: /platformer ( - ) max-hp @ hp ! ?walk ?idle physics> platformer-physics ;
: playable  persist can-travel on right turn ;
: solidity-hitbox! ( x y w h - ) w1 2! x1 2! ;

\ Experimental simple behavior composing utility
c: %actor beha-a beha-b ; 
continuation: +act> 
    beha-b !  beha @ beha-a ! 
    act> beha-a @ execute beha-b @ execute ;

private
\ Climbing
: ?-  vx @ 0< if negate then ;

: ?unclimb
    0 0 +tile@ climbable? ?exit
    climbing off
    vy @ 0> if fall 
    else gap -2 / >p y +! idle then ;

: ?dismount
    x 2@ y1 @ >p +` h1 @ >p + 1. +` xy>cr playfield spot @ climbable? ?exit 
    climbing off
    fac @ turn walk ;

: _climb
    falling off  climbing on  0 vx !
    x @ dup gap >p mod - gap >p 2 / + x !
    act>
        <up> held? <down> held? or if 1. 3 / else 0 then a.spd !
        <up> held? if -.5 else
            <down> held? if .5 else
                0 then then vy !
        <left> held? if left fac ! ?dismount then 
        <right> held? if right fac ! ?dismount then
        ?unclimb
        \ <jump> pressed? if
        \     <left> held? if -1. vx ! -1 0 ?hop exit then
        \     <right> held? if 1. vx ! 1 0 ?hop exit then
        \ then ;
;

\ Default logic
trait: %platformer
:: ->jump  ." jump " cr on-ground off jump-power @ negate vy ! act> control-jump ?climb ;
:: ->walk  ." walk " cr act> walk-accel ?jump ?climb ?stop ;
:: ->idle  ." idle " cr act> to-a-stop ?walk ?jump ?climb ;
:: ->fall  ." fall " cr on-ground off falling on act> control-in-air ?climb ;
:: ->land  ." land " cr on-ground on falling off ?walk ?idle ?stick ;
:: ->climb ." climb " cr _climb ;
trait;