This commit is contained in:
Jeremy Penner 2020-02-25 22:12:40 -05:00
parent 52664a0311
commit b69ce57b65
13 changed files with 79 additions and 37 deletions

BIN
end.jim

Binary file not shown.

BIN
game.jim

Binary file not shown.

View file

@ -106,7 +106,7 @@ defer neut-touch ( x y -- b )
: rexx-touch ( x y -- b ) : rexx-touch ( x y -- b )
2dup RUBBLE mapflag? if 2dup RUBBLE mapflag? if
tile 3 swap b! invalidate-map 0 tile 3 swap b! invalidate-map 0
else 2dup tile b@ 23 = if else 2dup tile b@ REXX-POD = if
move-player move-player
S posessed-rexx @ entity.dir ! S posessed-rexx @ entity.dir !
posessed-rexx @ entity>pos Neut entity.pos! posessed-rexx @ entity>pos Neut entity.pos!
@ -226,15 +226,6 @@ does> @ objects ! ;
dup defining-objects-head ! dup defining-objects-head !
defining-objects-ptr @ ! ; defining-objects-ptr @ ! ;
4 const COMP-OFF
5 const COMP-ON
9 const DOOR-CLOSED
10 const DOOR-OPENED
11 const SWITCH-OFF
12 const SWITCH-ON
20 const SCAN-OFF
21 const SCAN-ON
: entity>tile ( entity -- tile ) entity>pos world>tile tile ; : entity>tile ( entity -- tile ) entity>pos world>tile tile ;
: entity>tile? ( entity expected - b ) swap entity>tile b@ = ; : entity>tile? ( entity expected - b ) swap entity>tile b@ = ;
: responder>tile? ( expected - b ) responder swap entity>tile? ; : responder>tile? ( expected - b ) responder swap entity>tile? ;
@ -245,14 +236,6 @@ does> @ objects ! ;
: respondertile! ( tile -- ) responder entity>tile b! invalidate-map ; : respondertile! ( tile -- ) responder entity>tile b! invalidate-map ;
: handle-onoff ( ev on off -- )
<rot dup EVDEACT = if drop swap drop respondertile! else
dup EVACT = if drop drop respondertile! else
dup EVTOG = if drop responder >rot toggletile else
drop drop drop then then then ;
: statechange? ( ev -- b )
dup EVACT = over EVDEACT = or swap EVTOG = or ;
var _dorubber var _dorubber
: rubber _dorubber @ not _dorubber ! ; : rubber _dorubber @ not _dorubber ! ;
: {tileent} _dorubber @ if {duck} else {blank} then ; : {tileent} _dorubber @ if {duck} else {blank} then ;
@ -261,25 +244,16 @@ var _dorubber
: linked-entity responder entity.user @ execute ; : linked-entity responder entity.user @ execute ;
: handle-link ( ev ontile -- )
swap statechange? if
responder>tile? if EVACT else EVDEACT then
linked-entity swap entity>do
else drop then ;
: computer-on? ( entity -- b ) COMP-ON entity>tile? ;
: handle-teleport ( ev -- )
EVTOUCH = isneut? and COMP-ON responder>tile? and if
linked-entity dup computer-on? if
entity>pos Neut entity.pos!
else drop then
then ;
: create-object blankentity dup link-object ; : create-object blankentity dup link-object ;
: create-linked-object blankentity swap , dup link-object ; : create-linked-object blankentity swap , dup link-object ;
: listener! ( entity listener ) swap ! ; : listener! ( entity listener ) swap ! ;
: handle-onoff ( ev on off -- )
<rot dup EVDEACT = if drop swap drop respondertile! else
dup EVACT = if drop drop respondertile! else
dup EVTOG = if drop responder >rot toggletile else
drop drop drop then then then ;
: entering-door? ( ev -- b ) : entering-door? ( ev -- b )
EVTOUCH = isneut? not and DOOR-OPENED responder>tile? and ; EVTOUCH = isneut? not and DOOR-OPENED responder>tile? and ;
@ -298,6 +272,15 @@ var _dorubber
then then
then |; listener! ; then |; listener! ;
: statechange? ( ev -- b )
dup EVACT = over EVDEACT = or swap EVTOG = or ;
: handle-link ( ev ontile -- )
swap statechange? if
responder>tile? if EVACT else EVDEACT then
linked-entity swap entity>do
else drop then ;
: switch create-linked-object : switch create-linked-object
:| dup EVTOUCH = isneut? and if move-player then :| dup EVTOUCH = isneut? and if move-player then
dup EVTOUCH = isrexx? not and if dup EVTOUCH = isrexx? not and if
@ -307,6 +290,16 @@ var _dorubber
dup SWITCH-ON SWITCH-OFF handle-onoff dup SWITCH-ON SWITCH-OFF handle-onoff
SWITCH-ON handle-link |; listener! ; SWITCH-ON handle-link |; listener! ;
: computer-on? ( entity -- b ) COMP-ON entity>tile? ;
: handle-teleport ( ev -- )
EVTOUCH = isneut? and COMP-ON responder>tile? and if
linked-entity dup computer-on? if
entity>pos Neut entity.pos!
else drop then
then ;
: computer blankentity swap , dup link-object : computer blankentity swap , dup link-object
:| dup EVTOUCH = isjaye? and if responder EVACT entity>do then :| dup EVTOUCH = isjaye? and if responder EVACT entity>do then
dup EVTOUCH = isneut? and COMP-ON responder>tile? and if move-player then dup EVTOUCH = isneut? and COMP-ON responder>tile? and if move-player then
@ -340,13 +333,15 @@ var _dorubber
: chain-listener ( entity xp -- ) swap dup @ , ! ; immediate : chain-listener ( entity xp -- ) swap dup @ , ! ; immediate
: cancel-ev ( ev -- EVNOP ) drop EVNOP ; : cancel-ev ( ev -- EVNOP ) drop EVNOP ;
: with-gord Gord follow 1 player.state HASGORD f! ;
Gord :noname Gord :noname
dup EVTOUCH = isjaye? and player.state HASGORD f@ not and if dup EVTOUCH = isjaye? and player.state HASGORD f@ not and if
move-player move-player
1 player.state HASGORD f! with-gord
Gord follow
then chain-listener ; then chain-listener ;
:noname :noname
reset-level reset-level
' mode-move ' tick redefine ' mode-move ' tick redefine

View file

@ -34,10 +34,11 @@ s" game.jor" loadfile
intern lev00001.jor intern lev00001.jor
intern lev00002.jor intern lev00002.jor
intern lev00003.jor intern lev00003.jor
intern lev00004.jor
intern end.jor intern end.jor
:noname loadfile ; checkpoint _loadlevel :noname loadfile ; checkpoint _loadlevel
' _loadlevel ' loadlevel redefine ' _loadlevel ' loadlevel redefine
lev00003.jor loadlevel lev00004.jor loadlevel

BIN
jiles.jim

Binary file not shown.

BIN
job.jim

Binary file not shown.

View file

@ -17,7 +17,7 @@ defer c1 ' c1 8 3 computer c3
' c3 12 11 computer c2 ' c3 12 11 computer c2
' c2 5 7 computer _c1 ' _c1 ' c1 redefine ' c2 5 7 computer _c1 ' _c1 ' c1 redefine
end.jor 0 4 exitdoor dx lev00004.jor 0 4 exitdoor dx
' dx 0 5 scanner sx ' dx 0 5 scanner sx
5 2 defrexx Rexx 5 2 defrexx Rexx

BIN
lev00004.jim Executable file

Binary file not shown.

36
lev00004.jor Executable file
View file

@ -0,0 +1,36 @@
( L E V 0 0 0 0 4 )
objects: O
15 6 door d1
11 6 door d2
10 4 door d3
end.jor 0 4 exitdoor dx
15 11 defrexx Rexx
defer c1-targ
' c1-targ 6 11 computer c1
' c1 1 2 computer c2
' c1 7 2 computer c3
' d2 12 6 scanner s1
' d3 7 1 scanner s2
' dx 0 3 scanner sx
' c2 13 9 switch b1
' d2 10 3 switch b2
' d1 7 6 switch b3
' c3 13 8 switch b4
:noname c2 computer-on? if c2 else c3 then ; ' c1-targ redefine
:noname
reset-level O
s" lev00004.map" load-map
18 4 tile>world Jaye entity.pos!
19 5 tile>world Neut entity.pos!
with-gord
; ' onload redefine

BIN
lev00004.map Executable file

Binary file not shown.

BIN
map.jim

Binary file not shown.

10
map.jor
View file

@ -37,6 +37,16 @@ array tileflags
here tileflags - 1 - const MAXTILE here tileflags - 1 - const MAXTILE
4 const COMP-OFF
5 const COMP-ON
9 const DOOR-CLOSED
10 const DOOR-OPENED
11 const SWITCH-OFF
12 const SWITCH-ON
20 const SCAN-OFF
21 const SCAN-ON
23 const REXX-POD
: mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ; : mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
: tick-mapedit : tick-mapedit

BIN
state.jim

Binary file not shown.