Make car drivable; refactor jorth module bootstrapping sequence
This commit is contained in:
parent
a5ec79c88a
commit
f0a35a31b9
2
boot.jor
2
boot.jor
|
@ -57,7 +57,7 @@ key " const '"'
|
|||
: definition ( cpdeferred ) cell + @ ;
|
||||
|
||||
defer onload
|
||||
: postload onload ' noop ' onload redefine ;
|
||||
: postload ' onload definition ' noop ' onload redefine execute ;
|
||||
|
||||
: loadimage ( -- [0 | onload] )
|
||||
fget fget fget fget fget ( onload tasks latest size start )
|
||||
|
|
2
defs.jor
2
defs.jor
|
@ -65,6 +65,8 @@
|
|||
1 + ( cp i+1 )
|
||||
repeat drop drop then drop ;
|
||||
|
||||
: words latest links each dup wordname type bl more ;
|
||||
|
||||
( tasks )
|
||||
: mailbox 2 cells + ;
|
||||
: task-ip task-user-size cells + ;
|
||||
|
|
BIN
entity.jim
BIN
entity.jim
Binary file not shown.
|
@ -7,6 +7,8 @@
|
|||
: entity.dir 2 cells + ;
|
||||
: entity>sprite cell + @ execute ;
|
||||
: entity>do ( entity event ) swap @ execute ;
|
||||
: entity>pos dup entity.x @ swap entity.y @ ;
|
||||
: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ;
|
||||
|
||||
var entity-defstate
|
||||
: entitydo-ev ( [cp ifhere] ev -- )
|
||||
|
|
BIN
footer.jim
BIN
footer.jim
Binary file not shown.
35
game.jor
35
game.jor
|
@ -1,23 +1,3 @@
|
|||
: blah ' seremit task-emit ! ;
|
||||
blah
|
||||
|
||||
: 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
|
||||
|
||||
defer tick
|
||||
defer draw
|
||||
|
||||
:noname
|
||||
s" input.jor" loadfile
|
||||
s" entity.jor" loadfile
|
||||
s" timer.jor" loadfile
|
||||
s" footer.jor" loadfile
|
||||
s" map.jor" loadfile
|
||||
; execute
|
||||
|
||||
( J O B )
|
||||
var MODE-MOVE
|
||||
var MODE-WAIT
|
||||
|
@ -57,8 +37,9 @@ defer player
|
|||
else player.state MOVING f@ if {pete-walk}
|
||||
else {pete-stand} then then ;
|
||||
|
||||
: player.driving? player.state DRIVING f@ ;
|
||||
: player.canmove? ( x y -- )
|
||||
player.state DRIVING f@ if DRIVABLE else WALKABLE then mapflag? ;
|
||||
player.driving? if DRIVABLE else WALKABLE then mapflag? ;
|
||||
|
||||
12 9 N ' {player} defentity player
|
||||
|
||||
|
@ -82,6 +63,12 @@ defer player
|
|||
<rot <= >rot ( b b x w )
|
||||
>= or or ;
|
||||
|
||||
: leaving? ( x y dir -- b )
|
||||
dup N = if drop swap drop 0 < else
|
||||
dup W = if drop drop 0 < else
|
||||
S = if swap drop mapsize swap drop >= else
|
||||
drop mapsize drop >= then then then ;
|
||||
|
||||
: no-touch drop drop 0 ;
|
||||
defer player-touch ( x y -- b )
|
||||
' no-touch ' player-touch redefine
|
||||
|
@ -141,9 +128,7 @@ player :tick
|
|||
draw-screen
|
||||
draw-footer ;
|
||||
|
||||
:noname
|
||||
MODE-MOVE @ ' tick redefine
|
||||
' full-draw ' draw redefine
|
||||
|
||||
:noname
|
||||
s" pete.jor" loadfile
|
||||
; ' onload redefine
|
||||
; ' onload redefine
|
22
gameboot.jor
Executable file
22
gameboot.jor
Executable file
|
@ -0,0 +1,22 @@
|
|||
: blah ' seremit task-emit ! ;
|
||||
blah
|
||||
|
||||
: 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
|
||||
|
||||
defer tick
|
||||
defer draw
|
||||
|
||||
:noname
|
||||
s" input.jor" loadfile
|
||||
s" entity.jor" loadfile
|
||||
s" timer.jor" loadfile
|
||||
s" footer.jor" loadfile
|
||||
s" map.jor" loadfile
|
||||
s" game.jor" loadfile
|
||||
|
||||
s" pete.jor" loadfile
|
||||
; ' onload redefine
|
8
jorth.c
8
jorth.c
|
@ -844,6 +844,14 @@ void f_loadfile(char *filename) {
|
|||
f_cexecute();
|
||||
}
|
||||
|
||||
void f_loadjor(char *filename) {
|
||||
PUSHS(filename);
|
||||
PUSHS("loadjor");
|
||||
f_lookup();
|
||||
DROP(1);
|
||||
f_cexecute();
|
||||
}
|
||||
|
||||
// does not use the jorth interpreter defined in boot.jor
|
||||
void f_loadfile_cterp(char *filename) {
|
||||
cell *start = HERE;
|
||||
|
|
28
pete.jor
28
pete.jor
|
@ -1,24 +1,24 @@
|
|||
( P E T E )
|
||||
|
||||
8 8 E ' {car} defentity car
|
||||
13 8 N ' {car} defentity car
|
||||
|
||||
var cartimer
|
||||
car :tick 60 cartimer triggered if
|
||||
:| car entity.dir @ E = if W else E then car entity.dir !
|
||||
car try-move-entity |; JOB send
|
||||
then
|
||||
:touch pete say" What an old rustbucket.
|
||||
Hasn't driven in years."
|
||||
car :touch
|
||||
1 player.state DRIVING f!
|
||||
car entity>pos player entity.pos!
|
||||
;entity
|
||||
|
||||
:noname
|
||||
:|
|
||||
player yield
|
||||
car yield
|
||||
0 |;
|
||||
' entities redefine
|
||||
:| player yield
|
||||
player.driving? not if car yield then
|
||||
0 |; ' entities redefine
|
||||
|
||||
cartimer now!
|
||||
( TODO: DSL for touch events? )
|
||||
:| 2dup S leaving? player.driving? not and if
|
||||
pete say" It's too far to walk to town." 1 else
|
||||
2dup 12 7 2= if
|
||||
player.driving? not if pete say" TODO: Go home" then 1
|
||||
else 0 then then >rot drop drop
|
||||
|; ' player-touch redefine
|
||||
s" pete.map" load-map
|
||||
; ' onload redefine
|
||||
|
||||
|
|
|
@ -213,7 +213,7 @@ void game_f_init() {
|
|||
CDEF("mousepos", f_mousepos);
|
||||
CDEF("mousebuttons", f_mousebuttons);
|
||||
CDEF("unfuck", tile_init);
|
||||
f_loadfile("game.jor");
|
||||
f_loadjor("gameboot.jor");
|
||||
}
|
||||
|
||||
void f_poll() {
|
||||
|
|
Loading…
Reference in a new issue