diff --git a/entity.jor b/entity.jor index 45eb9f7..f496c2f 100755 --- a/entity.jor +++ b/entity.jor @@ -1,5 +1,8 @@ 0 const EVTICK 1 const EVTOUCH +2 const EVACT +3 const EVDEACT +4 const EVTOG : world>tile 4 >> swap 4 >> swap ; userword : tile>world 4 << swap 4 << swap ; userword @@ -10,12 +13,21 @@ : -pos ( x1 y1 x2 y2 -- x y ) negate swap negate swap +pos ; userword -: defentity ( x y dir anim -- ) array ' drop , , , tile>world , , ; +: allotentity ( x y dir anim -- ) ' drop , , , tile>world , , ; +: defentity ( x y dir anim -- ) array allotentity ; +var _responder +: responder _responder @ ; +: entity.user 5 cells + ; : entity.x 4 cells + ; : entity.y 3 cells + ; : entity.dir 2 cells + ; : entity>sprite cell + @ execute ; -: entity>do ( entity event ) swap @ execute ; +: entity>do ( entity event ) + swap dup if + dup _responder ! + @ execute + else drop drop then ; + : entity>pos dup entity.x @ swap entity.y @ ; userword : entity.pos! ( x y entity ) ( dir a -- ) swap drop lookup-frame ; +-1 defsingle {{blank}} 0 defstatic {car} 5 defstatic {car-lit} 1 defstatic {pete-stand} @@ -108,6 +122,11 @@ array frames 46 defsingle {aliem} 13 14 2 5 defmulti {neut} +var _dorubber +: {blank} _dorubber @ if {duck} else {{blank}} then ; +: rubber _dorubber @ not _dorubber ! ; + + : sprite-bob ( x y sprindex -- x y sprindex ) dup 13 >= over 14 <= and if >rot 2dup + ticks + 40 % 20 < if 1 + then dup @ text-color ! cell + @ draw-portrait ; -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 +0 LGREEN character neut userword +3 LBLUE character jaye userword : noone WHITE text-color ! s" " dup dup dup 8 portraity 16 portraity 24 portraity 32 portraity ; userword diff --git a/game.exe b/game.exe index 6c96d80..c395399 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.jor b/game.jor index a40f623..abd2a65 100755 --- a/game.jor +++ b/game.jor @@ -21,10 +21,12 @@ var player.prevdir 1 const MOVING userword 2 const NOCLIP userword 4 const ISNEUT userword +8 const HASNEUT userword : noclip player.state NOCLIP fnot! ; userword : isneut? player.state ISNEUT f@ ; userword +: isjaye? isneut? not ; userword : {jaye} isneut? not player.state MOVING f@ and @@ -35,17 +37,15 @@ var player.prevdir isneut? if NEUTABLE else WALKABLE then mapflag? else drop drop 1 then ; -12 9 N ' {jaye} defentity pjaye +14 9 N ' {jaye} defentity pjaye 17 5 N ' {neut} defentity pneut : player isneut? if pneut else pjaye then ; : sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ; : move-player - :| 1 player.state MOVING f! - player move-entity - 0 player.state MOVING f! - |; sched + 1 player.state MOVING f! + isneut? not if ( only jaye can have a party ) player.prevdir @ party each dup player != if @@ -53,7 +53,10 @@ var player.prevdir dup >rot entity.dir ! sched-move-entity rot mapsize ( b x y w h ) @@ -103,7 +106,8 @@ var q-player.y : queue-level q-level ! q-player.y ! q-player.x ! ; userword : player-tick - ^SPACE key-pressed if player.state ISNEUT fnot! then + ^SPACE key-pressed player.state HASNEUT f@ and + if player.state ISNEUT fnot! then 0 ^LEFT key-down if drop 1 W player entity.dir ! then ^RIGHT key-down if drop 1 E player entity.dir ! then ^UP key-down if drop 1 N player entity.dir ! then @@ -143,15 +147,20 @@ var q-player.y var showmouse 1 showmouse ! var glitchlevel +var quaking : full-draw - player entity.x @ 152 - - player entity.y @ 92 - - scroll + quaking @ not if + player entity.x @ 152 - + player entity.y @ 92 - + scroll + else + 0 ticks 3 % 13 * 8 % scroll + then entities each draw-entity more party each draw-entity more - pneut draw-entity + player.state HASNEUT f@ if pneut draw-entity then showmouse @ if mouseworldpos 4 draw-sprite diff --git a/game.prj b/game.prj index b5590aa..8cd8ac9 100755 Binary files a/game.prj and b/game.prj differ diff --git a/lev00001.jor b/lev00001.jor index ef0ae2d..e32f8ed 100755 --- a/lev00001.jor +++ b/lev00001.jor @@ -1,7 +1,100 @@ ( L E V E L 0 0 0 0 1 ) +: intro + 30 sleep + 1 quaking ! + 30 sleep + jaye say" Woah!!..." + hide-footer + 10 sleep + 0 quaking ! + jaye say" That was an earthquake!" +; + + 4 const COMP-OFF + 5 const COMP-ON + 9 const DOOR-CLOSED +10 const DOOR-OPENED +11 const SWITCH-OFF +12 const SWITCH-ON + +: entity>tile ( entity -- tile ) entity>pos world>tile tile ; +: entity>tile? ( entity expected - b ) swap entity>tile b@ = ; + +: toggleval ( off on val -- off|on ) over = not if swap then drop ; +: toggletile ( entity off on -- ) + r r@ entity>tile b@ toggleval tile b! invalidate-map ; + +: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ; + +: handle-onoff ( ev on off -- ) + rot toggletile else + drop drop drop then then then ; +: statechange? ( ev -- b ) + dup EVACT = over EVDEACT = or swap EVTOG = or ; + +: blankentity array here >r N ' {blank} allotentity tile? and if + move-player + then + DOOR-OPENED DOOR-CLOSED handle-onoff + |; swap ! ; + +: handle-link ( ev ontile -- ) + swap statechange? if + responder swap entity>tile? if EVACT else EVDEACT then + responder entity.user @ swap entity>do + else drop then ; + +: switch blankentity swap , + :| dup EVTOUCH = isneut? and if move-player then + dup EVTOUCH = if responder EVTOG entity>do then + dup SWITCH-ON SWITCH-OFF handle-onoff + SWITCH-ON handle-link |; swap ! ; + +: computer blankentity swap , + :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then + dup EVTOUCH = isneut? and if move-player then + dup COMP-ON COMP-OFF handle-onoff + COMP-ON handle-link |; swap ! ; + +: chainev ( entity xp -- ) swap dup @ , ! ; immediate + +12 9 door d1 +d1 :noname + dup EVTOUCH = isjaye? and d1 DOOR-CLOSED entity>tile? and if + jaye say" It won't open!" + then chainev ; +d1 12 8 switch s1 +0 15 8 computer c1 + +7 6 door d2 +d2 6 6 switch s2 + +c1 :noname + dup EVTOUCH = isjaye? and if + player.state HASNEUT f@ not if + jaye say" Maybe Neut can help." + neut say" NEUT v0.71.4rc12\ONLINE" + neut say" PRESS SPACE TO TAKE CONTROL" + c1 entity>pos pneut entity.pos! + 1 player.state HASNEUT f! + else + jaye say" Neut is running now.\I can hit the space bar\to control them." + then + then chainev ; + :noname - :| done |; ' entities redefine + reset-level + :| d1 yield s1 yield c1 yield d2 yield s2 yield done |; ' entities redefine + +:| touch-begin 15 8 2= dup if +then touch-last |; ' jaye-touch redefine s" lev00001.map" load-map +( ' intro sched ) + ; ' onload redefine diff --git a/lev00001.map b/lev00001.map index 4df9252..8ef78bf 100755 Binary files a/lev00001.map and b/lev00001.map differ diff --git a/map.jor b/map.jor index efdae3f..8d01120 100755 --- a/map.jor +++ b/map.jor @@ -18,6 +18,11 @@ array tileflags ( table ) 0 b, ( chair ) 0 b, ( table-brok ) 0 b, +( door-close ) 0 b, +( door-open ) WALKABLE b, +( switch-off ) NEUTABLE b, +( switch-on ) NEUTABLE b, +( window ) 0 b, here tileflags - 1 - const MAXTILE diff --git a/portrait.gfx b/portrait.gfx index 485b9fe..d679118 100755 Binary files a/portrait.gfx and b/portrait.gfx differ diff --git a/sprite.gfx b/sprite.gfx index 65c7b46..2e52e11 100755 Binary files a/sprite.gfx and b/sprite.gfx differ diff --git a/testbed.c b/testbed.c index ae4e3f7..b117807 100755 --- a/testbed.c +++ b/testbed.c @@ -232,7 +232,9 @@ void f_keyIsDown() { } void f_drawSprite() { // ( x y sprite -- ) - drawSprite(&sprites[TOP().i * SPRITE_STRIDE], ST2().i, ST1().i, NULL); + if (TOP().i >= 0) { + drawSprite(&sprites[TOP().i * SPRITE_STRIDE], ST2().i, ST1().i, NULL); + } DROP(3); } diff --git a/tiles.gfx b/tiles.gfx index eaaa777..159ffcf 100755 Binary files a/tiles.gfx and b/tiles.gfx differ