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 + @ ;
|
: definition ( cpdeferred ) cell + @ ;
|
||||||
|
|
||||||
defer onload
|
defer onload
|
||||||
: postload onload ' noop ' onload redefine ;
|
: postload ' onload definition ' noop ' onload redefine execute ;
|
||||||
|
|
||||||
: loadimage ( -- [0 | onload] )
|
: loadimage ( -- [0 | onload] )
|
||||||
fget fget fget fget fget ( onload tasks latest size start )
|
fget fget fget fget fget ( onload tasks latest size start )
|
||||||
|
|
2
defs.jor
2
defs.jor
|
@ -65,6 +65,8 @@
|
||||||
1 + ( cp i+1 )
|
1 + ( cp i+1 )
|
||||||
repeat drop drop then drop ;
|
repeat drop drop then drop ;
|
||||||
|
|
||||||
|
: words latest links each dup wordname type bl more ;
|
||||||
|
|
||||||
( tasks )
|
( tasks )
|
||||||
: mailbox 2 cells + ;
|
: mailbox 2 cells + ;
|
||||||
: task-ip task-user-size 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.dir 2 cells + ;
|
||||||
: entity>sprite cell + @ execute ;
|
: entity>sprite cell + @ execute ;
|
||||||
: entity>do ( entity event ) swap @ 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
|
var entity-defstate
|
||||||
: entitydo-ev ( [cp ifhere] ev -- )
|
: entitydo-ev ( [cp ifhere] ev -- )
|
||||||
|
|
BIN
footer.jim
BIN
footer.jim
Binary file not shown.
33
game.jor
33
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 )
|
( J O B )
|
||||||
var MODE-MOVE
|
var MODE-MOVE
|
||||||
var MODE-WAIT
|
var MODE-WAIT
|
||||||
|
@ -57,8 +37,9 @@ defer player
|
||||||
else player.state MOVING f@ if {pete-walk}
|
else player.state MOVING f@ if {pete-walk}
|
||||||
else {pete-stand} then then ;
|
else {pete-stand} then then ;
|
||||||
|
|
||||||
|
: player.driving? player.state DRIVING f@ ;
|
||||||
: player.canmove? ( x y -- )
|
: 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
|
12 9 N ' {player} defentity player
|
||||||
|
|
||||||
|
@ -82,6 +63,12 @@ defer player
|
||||||
<rot <= >rot ( b b x w )
|
<rot <= >rot ( b b x w )
|
||||||
>= or or ;
|
>= 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 ;
|
: no-touch drop drop 0 ;
|
||||||
defer player-touch ( x y -- b )
|
defer player-touch ( x y -- b )
|
||||||
' no-touch ' player-touch redefine
|
' no-touch ' player-touch redefine
|
||||||
|
@ -141,9 +128,7 @@ player :tick
|
||||||
draw-screen
|
draw-screen
|
||||||
draw-footer ;
|
draw-footer ;
|
||||||
|
|
||||||
|
:noname
|
||||||
MODE-MOVE @ ' tick redefine
|
MODE-MOVE @ ' tick redefine
|
||||||
' full-draw ' draw 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();
|
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
|
// does not use the jorth interpreter defined in boot.jor
|
||||||
void f_loadfile_cterp(char *filename) {
|
void f_loadfile_cterp(char *filename) {
|
||||||
cell *start = HERE;
|
cell *start = HERE;
|
||||||
|
|
28
pete.jor
28
pete.jor
|
@ -1,24 +1,24 @@
|
||||||
( P E T E )
|
( P E T E )
|
||||||
|
|
||||||
8 8 E ' {car} defentity car
|
13 8 N ' {car} defentity car
|
||||||
|
|
||||||
var cartimer
|
car :touch
|
||||||
car :tick 60 cartimer triggered if
|
1 player.state DRIVING f!
|
||||||
:| car entity.dir @ E = if W else E then car entity.dir !
|
car entity>pos player entity.pos!
|
||||||
car try-move-entity |; JOB send
|
|
||||||
then
|
|
||||||
:touch pete say" What an old rustbucket.
|
|
||||||
Hasn't driven in years."
|
|
||||||
;entity
|
;entity
|
||||||
|
|
||||||
:noname
|
:noname
|
||||||
:|
|
:| player yield
|
||||||
player yield
|
player.driving? not if car yield then
|
||||||
car yield
|
0 |; ' entities redefine
|
||||||
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
|
s" pete.map" load-map
|
||||||
; ' onload redefine
|
; ' onload redefine
|
||||||
|
|
||||||
|
|
|
@ -213,7 +213,7 @@ void game_f_init() {
|
||||||
CDEF("mousepos", f_mousepos);
|
CDEF("mousepos", f_mousepos);
|
||||||
CDEF("mousebuttons", f_mousebuttons);
|
CDEF("mousebuttons", f_mousebuttons);
|
||||||
CDEF("unfuck", tile_init);
|
CDEF("unfuck", tile_init);
|
||||||
f_loadfile("game.jor");
|
f_loadjor("gameboot.jor");
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_poll() {
|
void f_poll() {
|
||||||
|
|
Loading…
Reference in a new issue