Make car drivable; refactor jorth module bootstrapping sequence

This commit is contained in:
Jeremy Penner 2019-03-09 19:59:52 -05:00
parent a5ec79c88a
commit f0a35a31b9
19 changed files with 60 additions and 41 deletions

BIN
boot.jim

Binary file not shown.

View file

@ -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 )

BIN
defs.jim

Binary file not shown.

View file

@ -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 + ;

Binary file not shown.

View file

@ -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 -- )

Binary file not shown.

BIN
game.exe

Binary file not shown.

BIN
game.jim

Binary file not shown.

View file

@ -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

BIN
game.prj

Binary file not shown.

22
gameboot.jor Executable file
View 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

BIN
input.jim

Binary file not shown.

View file

@ -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;

BIN
map.jim

Binary file not shown.

BIN
pete.jim

Binary file not shown.

View file

@ -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

View file

@ -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() {

BIN
timer.jim

Binary file not shown.