diff --git a/boot.jor b/boot.jor index eb75bbd..003c392 100755 --- a/boot.jor +++ b/boot.jor @@ -8,6 +8,7 @@ key ) const ')' key const sp 128 const F_IMMEDIATE +0x100 const F_USERWORD : cr '\n' emit ; : bl sp emit ; diff --git a/defs.jor b/defs.jor index d753419..82b5533 100755 --- a/defs.jor +++ b/defs.jor @@ -19,9 +19,11 @@ : f! ( b v flag -- ) >rot >r r@ @ >rot ( val flag b r: v ) if | else ~ & then if wordname type drop 0 break then - more dup if . else drop then ; + more dup if . else drop then ; userword : tasks.s tasks links each dup .wordin s" : " type dup task-sp @ over task-stack ( task stackLim stack ) begin 2dup > while dup @ . cell + repeat - cr drop drop more ; + cr drop drop more ; userword : doactivate ( task ip -- ) over task-ip ! diff --git a/entity.jor b/entity.jor index 34aef9c..5ae492c 100755 --- a/entity.jor +++ b/entity.jor @@ -1,14 +1,14 @@ 0 const EVTICK 1 const EVTOUCH -: world>tile 4 >> swap 4 >> swap ; -: tile>world 4 << swap 4 << swap ; +: world>tile 4 >> swap 4 >> swap ; userword +: tile>world 4 << swap 4 << swap ; userword : +pos ( x1 y1 x2 y2 -- x y ) - rot + swap ; + rot + swap ; userword : -pos ( x1 y1 x2 y2 -- x y ) - negate swap negate swap +pos ; + negate swap negate swap +pos ; userword : defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ; : entity.x 4 cells + ; @@ -16,8 +16,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 ) pos dup entity.x @ swap entity.y @ ; userword +: entity.pos! ( x y entity ) b@ sprindex ; @@ -98,8 +99,10 @@ array frames 38 defsingle {fridge} 43 defsingle {boat} 8 defstatic {boat-pete} +9 defstatic {duck} +46 defsingle {aliem} : sprite-bob ( x y sprindex -- x y sprindex ) - ticks 40 % 20 < if - dup 39 >= over 43 <= and if swap 1 + swap then + dup 39 >= over 46 <= and if + >rot 2dup + ticks + 40 % 20 < if 1 + then dup @ text-color ! cell + @ draw-portrait ; -0 GREEN character pete -1 MAGENTA character mary -2 BROWN character chuck -3 YELLOW character jeanne -4 LGRAY character phone +0 GREEN character pete userword +1 MAGENTA character mary userword +2 BROWN character chuck userword +3 YELLOW character jeanne userword +4 LGRAY character phone userword : noone WHITE text-color ! s" " dup dup dup - 8 portraity 16 portraity 24 portraity 32 portraity ; + 8 portraity 16 portraity 24 portraity 32 portraity ; userword diff --git a/game.exe b/game.exe index d103dbc..7cbb0df 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index d4a9cad..96df770 100755 --- a/game.jor +++ b/game.jor @@ -26,20 +26,20 @@ defer entities more drop drop ; ( P L A Y E R ) -var player.state +var player.state userword var player.prevdir -1 const MOVING -2 const DRIVING -4 const BOATING -8 const NOCLIP -16 const ISMARY -32 const ISJEANNE +1 const MOVING userword +2 const DRIVING userword +4 const BOATING userword +8 const NOCLIP userword +16 const ISMARY userword +32 const ISJEANNE userword -: noclip player.state NOCLIP fnot! ; +: noclip player.state NOCLIP fnot! ; userword -: player.driving? player.state DRIVING f@ ; -: player.boating? player.state BOATING f@ ; +: player.driving? player.state DRIVING f@ ; userword +: player.boating? player.state BOATING f@ ; userword : :playerwalk create , , does> player.state MOVING f@ not if cell + then @ execute ; @@ -117,7 +117,7 @@ defer player-touch ( x y -- b ) var q-level var q-player.x var q-player.y -: queue-level q-level ! q-player.y ! q-player.x ! ; +: queue-level q-level ! q-player.y ! q-player.x ! ; userword player :tick 0 ^LEFT key-down if drop 1 W player entity.dir ! then @@ -130,7 +130,7 @@ player :tick ( S T U F F ) : reset-level :| done |; ' entities redefine - :| drop drop 0 |; ' player-touch redefine ; + :| drop drop 0 |; ' player-touch redefine ; userword : mode-move entities each EVTICK entity>do more diff --git a/game.prj b/game.prj index 3bebd24..f863057 100755 Binary files a/game.prj and b/game.prj differ diff --git a/gameboot.jor b/gameboot.jor index b0e863c..33f4fde 100755 --- a/gameboot.jor +++ b/gameboot.jor @@ -31,6 +31,7 @@ intern petehous.jor intern road.jor intern jeanne.jor intern trail1.jor +intern space.jor intern mpete.jor intern mroad.jor intern mjeanne.jor diff --git a/jiles.jor b/jiles.jor index de24232..517ce69 100755 --- a/jiles.jor +++ b/jiles.jor @@ -84,7 +84,7 @@ var copysrc ^TAB key-pressed if jiles-old-draw @ ' draw redefine jiles-old-tick @ ' tick redefine - mousehide unfuck invalidate-map reloadtiles + mousehide unfuck invalidate-map reloadtiles load-footer then tick-debounce ; diff --git a/jopl.jor b/jopl.jor index ab40d3d..9b8ff8f 100755 --- a/jopl.jor +++ b/jopl.jor @@ -57,7 +57,7 @@ var op : freqon ( oct freq -- ) dup 0xff & ar-freq adlib! 8 >> 0x03 & swap 2 << | 0x20 | ar-note adlib! ; -: noteoff ( -- ) 0 ar-note adlib! ; +: noteoff ( -- ) 0 ar-note adlib! ; userword array semitones 3520 3520 />ratio , @@ -91,44 +91,44 @@ array semitones ' ar-sr read-sbi-op-reg ' ar-wave read-sbi-op-reg fgetc ar-alg adlib! - close ; + close ; userword : rndbyte 256 rnd dup . ; : rndop rndbyte rndbyte rndbyte rndbyte rndbyte s" loadop " type loadop ; : rndinst s" op1 " type op1 rndop s" op2 " type op2 rndop - rndbyte s" ar-alg adlib! " type cr ar-alg adlib! ; + rndbyte s" ar-alg adlib! " type cr ar-alg adlib! ; userword -: panic 9 -1 for i voice ! noteoff next ; +: panic 9 -1 for i voice ! noteoff next ; userword var songticks var notestate var octave -: oct+ octave @ 12 * + ; -: rest songticks @ begin suspend dup songticks @ != until drop ; -: beat begin dup songticks @ swap % 0 != while rest repeat drop ; -: %O octave ! ; -: %V voice ! ; +: oct+ octave @ 12 * + ; userword +: rest songticks @ begin suspend dup songticks @ != until drop ; userword +: beat begin dup songticks @ swap % 0 != while rest repeat drop ; userword +: %O octave ! ; userword +: %V voice ! ; userword : mknote create b, does> ub@ oct+ notestate @ if b, else noteon rest then ; -: %loop 0xfe b, , ; +: %loop 0xfe b, , ; userword : mod % ; -: % notestate @ if 0xf0 b, else rest then ; -: %% 0 for % next ; -: %- notestate @ if 0xfd b, else noteoff then ; -: %do 0xff b, , ; +: % notestate @ if 0xf0 b, else rest then ; userword +: %% 0 for % next ; userword +: %- notestate @ if 0xfd b, else noteoff then ; userword +: %do 0xff b, , ; userword -11 mknote G# -10 mknote G -9 mknote F# -8 mknote F -7 mknote E -6 mknote D# -5 mknote D -4 mknote C# -3 mknote C -2 mknote B -1 mknote A# -0 mknote A +11 mknote G# userword +10 mknote G userword +9 mknote F# userword +8 mknote F userword +7 mknote E userword +6 mknote D# userword +5 mknote D userword +4 mknote C# userword +3 mknote C userword +2 mknote B userword +1 mknote A# userword +0 mknote A userword array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , @@ -144,9 +144,9 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , : track-tick ( i -- ) track dup @ dotrack swap ! ; -: :track create here 1 notestate ! does> voice @ track ! ; -: ;track %loop 0 notestate ! ; -: shush 0 voice @ track ! %- ; +: :track create here 1 notestate ! does> voice @ track ! ; userword +: ;track %loop 0 notestate ! ; userword +: shush 0 voice @ track ! %- ; userword : prev-name ( wordname -- wordname ) 2 cells - @ 2 cells + ; @@ -167,7 +167,7 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , : emit-track ( 'track -- ) -1 octave ! dup ` swap 2 cells + 'name :track type bl swap type bl - begin dup ub@ emit-cmd while 1 + repeat drop ; + begin dup ub@ emit-cmd while 1 + repeat drop ; userword ( T E X T ) @@ -234,7 +234,7 @@ var textleft : trackstatus cr voice @ showtrack ; -var tempo 1 tempo ! +var tempo userword 1 tempo ! : player 1 songticks +! songticks @ tempo @ mod 0 = if @@ -257,7 +257,7 @@ var t2 16 b, 3 b, 17 b, 4 b, 18 b, 19 b, 6 b, 20 b, 7 b, 21 b, 8 b, 22 b, 23 b, 10 b, 24 b, 11 b, 25 b, |inline ] 0 29 for dup i + ub@ key-pressed if drop i 3 + rdrop rdrop ret then next - drop 51 key-pressed if 15 else 0 then ; + drop 51 key-pressed if 15 else 0 then ; userword : onkeynote ( cp -- ) keynote dup if oct+ swap execute else drop drop then ; @@ -293,7 +293,7 @@ var stopkeys 41 key-pressed if 0xfd setnote then 52 key-down if 0xf0 setnote then |; dokeys - 0x1f textattr ! ; + 0x1f textattr ! ; userword : jamkeys stoponesc voicekeys @@ -301,7 +301,7 @@ var stopkeys 41 key-pressed if noteoff then 88 key-pressed if rndinst then ; -: jam ' jamkeys dokeys ; +: jam ' jamkeys dokeys ; userword var menuscroll var menuy @@ -360,9 +360,9 @@ defer onselect key-menu if s" *.sbi" draw-filemenu then 28 key-pressed if 1 stopkeys ! then |; dokeys - |; 66 1 13 menu-at ; + |; 66 1 13 menu-at ; userword -: dune ( -- ) s" dune" chdir inst s" .." chdir ; +: dune ( -- ) s" dune" chdir inst s" .." chdir ; userword :noname 9 -1 for i voice ! default next diff --git a/jorth.c b/jorth.c index c47c5e2..087be45 100755 --- a/jorth.c +++ b/jorth.c @@ -572,11 +572,12 @@ void f_wordname() { TOP().p = TOP().p + 2; } void f_wordflags() { - TOP().u = TOP().p[1].u; + TOP().p = TOP().p + 1; } + void f_codepointer() { unsigned int flags = TOP().p[1].u; - TOP().p = CELL_OFFSET(TOP().p + 2, (flags & ~F_IMMEDIATE) + 1); + TOP().p = CELL_OFFSET(TOP().p + 2, (flags & F_NAMELEN_MASK) + 1); } void f_lookup() { // name -- (codepointer flags) | (name 0) @@ -587,8 +588,8 @@ void f_lookup() { // name -- (codepointer flags) | (name 0) while (entry) { PUSHP(entry); - f_wordflags(); - if (len == (TOP().u & ~F_IMMEDIATE)) { + f_wordflags(); f_get(); + if (len == (TOP().u & F_NAMELEN_MASK)) { PUSHS(name); PUSHP(entry); f_wordname(); diff --git a/jorth.h b/jorth.h index 79819a4..9cee4f8 100755 --- a/jorth.h +++ b/jorth.h @@ -36,6 +36,7 @@ extern cell W; extern cell *rstack; extern cell *stack; +#define F_NAMELEN_MASK 0x7f #define F_IMMEDIATE 0x80 #define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b)) diff --git a/map.jor b/map.jor index 59d4fa9..5e0b470 100755 --- a/map.jor +++ b/map.jor @@ -31,6 +31,7 @@ array tileflags ( fence ) 0 b, ( storefront ) 0 b, ( space ) 0 b, +( space2 ) BOATABLE b, here tileflags - 1 - const MAXTILE @@ -61,7 +62,7 @@ here tileflags - 1 - const MAXTILE swap mapsize >r ( newh neww oldw r: oldh ) 2dup < if 1 world player entity.pos! then +touch-next 41 37 2= dup + if move-player 5 11 tile>world player entity.pos! then +touch-next 44 23 2= dup + if pete say" It's...." say" home." then +touch-last |; ' player-touch redefine + +s" space.map" load-map +4 glitchlevel ! +; ' onload redefine diff --git a/space.map b/space.map new file mode 100755 index 0000000..bede0ab Binary files /dev/null and b/space.map differ diff --git a/sprite.gfx b/sprite.gfx index a088d0e..b1a0fdb 100755 Binary files a/sprite.gfx and b/sprite.gfx differ diff --git a/state.jor b/state.jor index a45e57a..8097366 100755 --- a/state.jor +++ b/state.jor @@ -1,10 +1,10 @@ -0 const JEANNE-ANGRY -1 const CHUCK-GONE -2 const CHUCK-FOLLOW -3 const CHUCK-HOME -4 const CHUCK-STOLEN -5 const CHUCK-EXPLAINED -6 const NIGHT +0 const JEANNE-ANGRY userword +1 const CHUCK-GONE userword +2 const CHUCK-FOLLOW userword +3 const CHUCK-HOME userword +4 const CHUCK-STOLEN userword +5 const CHUCK-EXPLAINED userword +6 const NIGHT userword 7 const FLAG-COUNT @@ -12,12 +12,12 @@ array flags FLAG-COUNT 8 / 1 + allot : flagstof ( f -- v f ) dup 8 / flags + swap 8 % 1 swap << ; : flagsf! ( b f -- ) flagstof f! ; -: flag@ ( f -- b ) flagstof f@ ; -: setflag 1 swap flagsf! ; -: clearflag 0 swap flagsf! ; +: flag@ ( f -- b ) flagstof f@ ; userword +: setflag 1 swap flagsf! ; userword +: clearflag 0 swap flagsf! ; userword -: day s" tiles.gfx" loadtiles invalidate-map NIGHT clearflag ; -: night s" ntiles.gfx" loadtiles invalidate-map NIGHT setflag ; +: day s" tiles.gfx" loadtiles invalidate-map NIGHT clearflag ; userword +: night s" ntiles.gfx" loadtiles invalidate-map NIGHT setflag ; userword : {car-drive} NIGHT flag@ if {car-lit} else {car} then ; diff --git a/testbed.c b/testbed.c index 892c05f..de56553 100755 --- a/testbed.c +++ b/testbed.c @@ -155,6 +155,13 @@ void f_loadtiles() { #define TILES_GFX +void f_load_footer() { + FILE *f = fopen("FOOTER.TIF", "rb"); + TifImageMeta_t meta = tifLoadMeta(f); + tifLoadEGA(f, meta, 0, 48, 336); + fclose(f); +} + void game_init() { FILE *f; TifImageMeta_t meta; @@ -173,10 +180,7 @@ void game_init() { tile_init(); fillMap(); - f = fopen("FOOTER.TIF", "rb"); - meta = tifLoadMeta(f); - tifLoadEGA(f, meta, 0, 48, 336); - fclose(f); + f_load_footer(); f = fopen("sprite.gfx", "rb"); freadfar(f, sprites, NUM_SPRITES * SPRITE_STRIDE * 2); @@ -580,6 +584,7 @@ void game_f_init(char *exe, char *bootjor) { CDEF("loadtiles", f_loadtiles); CDEF("glitch", f_glitch); CDEF("unfuck", tile_init); + CDEF("load-footer", f_load_footer); CDEF("fuck", f_resetvideo); CDEF("mouseshow", f_mouseshow); diff --git a/tiles.gfx b/tiles.gfx index bf7be90..751e669 100755 Binary files a/tiles.gfx and b/tiles.gfx differ