pete286/game.jor

163 lines
3.5 KiB
Plaintext
Executable file

: blah
' seremit task-emit !
' log-emit task-echo ! ;
' seremit task-emit !
: start-repl activate blah
s" .:: J O R T H ( jean forth) ::." type cr
begin receive loadstring s" ok" type cr again ;
task const REPL
REPL start-repl
1 const ^ESC
28 const ^ENTER
29 const ^CTRL
56 const ^ALT
57 const ^SPACE
72 const ^UP
75 const ^LEFT
77 const ^RIGHT
80 const ^DOWN
: wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ;
: udelta ( u u -- u )
2dup u> if
swap -1 swap - + 1 +
else
swap -
then ;
: sleep ( count -- )
ticks swap begin over ticks udelta over u< while suspend repeat drop drop ;
defer tick
defer draw
: defentity var 2 cells allot ;
: entity.x ;
: entity.y cell + ;
: entity.dir 2 cells + ;
0 const W
1 const E
2 const N
3 const S
: defsprite ( s n e w ) b, b, b, b, here 4 - const ;
: sprindex ( sprite dir ) + b@ ;
3 1 0 2 defsprite s_car
defentity player
100 player entity.x !
100 player entity.y !
( timer + lerping )
: clamp0 ( range val -- i )
2dup <= if drop else
dup 0 <= if drop drop 0 else
swap drop then then ;
: >ratio ( range value -- f )
over swap clamp0 >fix swap >fix fix/ ;
: <ratio ( range ratio -- v )
swap >fix fix* <fix ;
: >range ( start end -- start range ) over - ;
: <range ( start range -- start end ) over + ;
: lerpr ( start end ratio ) r> >range r< <ratio + ;
: lerpn ( start1 end1 start2 end2 val )
r> >range r< rot - >ratio lerpr ;
: lerp ( start end duration timer -- i )
@ ticks udelta ( start end duration delta )
>ratio lerpr ;
: triggered ( duration timer -- b )
dup r> @ ticks udelta ( duration delta )
2dup <= if drop r< +! 1 else drop drop 0 then ;
: now! ( timer -- ) ticks swap ! ;
( F O O T E R )
var footer-y
0 footer-y !
: draw-footer footer-y @ split-screen ;
: text1 6 4 rot text ;
: text2 6 12 rot text ;
: clear s" " dup text1 text2 ;
var footer-timer
: move-footer-to ( ytarget -- )
footer-y @ swap ( from to -- )
footer-timer now!
begin
2dup 10 footer-timer lerp ( from to now -- )
dup footer-y !
over != ( from to -- )
while
suspend
repeat drop drop ;
: show-footer 24 move-footer-to ;
: hide-footer 0 move-footer-to ;
: say1 ( s -- ) clear text1 show-footer ^ENTER wait-key ;
: say2 ( s1 s2 -- ) clear text2 text1 show-footer ^ENTER wait-key ;
( T I C K )
: tick-player
0 ^LEFT key-down if 3 - W player entity.dir ! then
^RIGHT key-down if 3 + E player entity.dir ! then
player entity.x +!
0 ^UP key-down if 3 - N player entity.dir ! then
^DOWN key-down if 3 + S player entity.dir ! then
player entity.y +! ;
var MODE-MOVE
var MODE-WAIT
( J O B )
: listen-for-jobs activate blah
begin receive
MODE-WAIT @ ' tick redefine
execute
hide-footer
MODE-MOVE @ ' tick redefine
again ;
task const JOB
JOB listen-for-jobs
: hello-world s" Hello, world!" say1 s" How are you" s" today?" say2 ;
: mode-move
tick-player
^SPACE key-pressed if
' hello-world JOB send
then ;
' mode-move MODE-MOVE !
' noop MODE-WAIT !
: draw-player
player entity.x @
player entity.y @
s_car player entity.dir @ sprindex
draw-sprite ;
: full-draw
player entity.x @ 152 -
player entity.y @ 92 -
scroll
draw-player
50 50 0 draw-sprite
600 600 2 draw-sprite
draw-screen
draw-footer ;
MODE-MOVE @ ' tick redefine
' full-draw ' draw redefine