Jorth lookup optimization; add Jeanne's house

This commit is contained in:
Jeremy Penner 2019-03-17 12:16:36 -04:00
parent a010ec5911
commit d52d5b96f5
25 changed files with 74 additions and 18 deletions

BIN
boot.img

Binary file not shown.

BIN
boot.jim

Binary file not shown.

BIN
defs.jim

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -23,11 +23,9 @@ var footer-y
var text-color
WHITE text-color !
: statusy 7 swap <rot text-color @ text ;
: status0 10 statusy ;
: status1 20 statusy ;
: status2 30 statusy ;
: textxy ( s x y ) <rot text-color @ text ;
: portraity 1 swap textxy ;
: statusy 7 swap textxy ;
var textx
var texty
@ -57,7 +55,7 @@ var texttimer
: clear
text-color @
WHITE text-color !
s" " dup dup status0 status1 status2
s" " dup dup 10 statusy 20 statusy 30 statusy
text-color !
6 textx !
10 texty ! ;
@ -76,4 +74,7 @@ var texttimer
0 GREEN character pete
1 MAGENTA character mary
2 BROWN character chuck
3 YELLOW character jeanne
: noone WHITE text-color ! s" " dup dup dup
8 portraity 16 portraity 24 portraity 32 portraity ;

BIN
game.exe

Binary file not shown.

BIN
game.img

Binary file not shown.

BIN
game.jim

Binary file not shown.

BIN
game.prj

Binary file not shown.

View file

@ -23,6 +23,7 @@ s" game.jor" loadfile
intern pete.jor
intern petehous.jor
intern road.jor
intern jeanne.jor
:noname loadfile ; checkpoint _loadlevel
' _loadlevel ' loadlevel redefine

BIN
input.jim

Binary file not shown.

BIN
jeanne.jim Executable file

Binary file not shown.

45
jeanne.jor Executable file
View file

@ -0,0 +1,45 @@
( J E A N N E )
16 18 W ' {horse} defentity e_chuck
14 22 N ' {car} defentity car
e_chuck :touch
pete say" Hey there, Chuck."
chuck say" * w h i n n y *\(Hey there, Pete.)"
;entity
car :touch
player move-entity 1 player.state DRIVING f!
;entity
:noname
reset-level
0 player.state DRIVING f!
:| player yield
e_chuck yield
player.driving? not if car yield then
0 |; ' entities redefine
:|
touch-begin S leaving? dup
if player.driving? not
if pete say" I'm not walking."
else player move-entity 24 7 road.jor queue-level
then
then
touch-next 6 21 2= dup
if player.driving? not
if
noone say" * knock knock *"
clear 30 sleep
pete say" Nobody home, I guess."
jeanne say" Go away before I call the\cops, Pete!"
pete say" Oh.\I guess she's still mad."
else
pete say" Jeanne hates me enough already\without driving through her\front door!"
then
then
touch-last |; ' player-touch redefine
s" jeanne.map" load-map
; ' onload redefine

BIN
jeanne.map Executable file

Binary file not shown.

15
jorth.c
View file

@ -553,8 +553,15 @@ void f_codepointer() {
void f_lookup() { // name -- (codepointer flags) | (name 0)
cell *entry = LATEST;
char *name = TOP().s;
int len = strlen(name);
DROP(1);
while (entry) {
f_dup();
PUSHP(entry);
f_wordflags();
if (len == (TOP().u & ~F_IMMEDIATE)) {
PUSHS(name);
PUSHP(entry);
f_wordname();
f_streq();
@ -562,13 +569,15 @@ void f_lookup() { // name -- (codepointer flags) | (name 0)
TOP().p = entry;
f_codepointer();
f_swap();
TOP().p = entry;
f_wordflags();
return;
}
DROP(2);
} else {
DROP(1);
}
entry = entry->p;
}
PUSHS(name);
PUSHU(0);
}

BIN
jorth.img

Binary file not shown.

BIN
map.jim

Binary file not shown.

BIN
pete.jim

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
repl.jim

Binary file not shown.

BIN
road.jim

Binary file not shown.

View file

@ -14,7 +14,7 @@ touch-next 5 9 2= dup
touch-next 13 6 2= dup
if pete say" Old hiking trail." then
touch-next 24 6 2= dup
if mary say" Welcome to my place, Pete!" then
if player move-entity 13 22 jeanne.jor queue-level then
touch-next 39 33 2= dup
if pete say" School's out for the day,\looks like." then
touch-next 32 36 2= dup

BIN
road.map

Binary file not shown.