lev4
This commit is contained in:
parent
52664a0311
commit
b69ce57b65
65
game.jor
65
game.jor
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
BIN
lev00004.jim
Executable file
Binary file not shown.
36
lev00004.jor
Executable file
36
lev00004.jor
Executable 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
BIN
lev00004.map
Executable file
Binary file not shown.
10
map.jor
10
map.jor
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue