Implement basic character-swapping mechanics, tutorial / intro level

This commit is contained in:
Jeremy Penner 2020-02-02 18:29:49 -05:00
parent cd0d0bff8b
commit 779ae1bab3
12 changed files with 146 additions and 21 deletions

View file

@ -1,5 +1,8 @@
0 const EVTICK 0 const EVTICK
1 const EVTOUCH 1 const EVTOUCH
2 const EVACT
3 const EVDEACT
4 const EVTOG
: world>tile 4 >> swap 4 >> swap ; userword : world>tile 4 >> swap 4 >> swap ; userword
: tile>world 4 << swap 4 << swap ; userword : tile>world 4 << swap 4 << swap ; userword
@ -10,12 +13,21 @@
: -pos ( x1 y1 x2 y2 -- x y ) : -pos ( x1 y1 x2 y2 -- x y )
negate swap negate swap +pos ; userword 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.x 4 cells + ;
: entity.y 3 cells + ; : entity.y 3 cells + ;
: entity.dir 2 cells + ; : entity.dir 2 cells + ;
: entity>sprite cell + @ execute ; : 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 dup entity.x @ swap entity.y @ ; userword
: entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword : entity.pos! ( x y entity ) <rot over entity.x ! entity.y ! ; userword
@ -26,6 +38,7 @@ var entity-defstate
' dup , lit ' = , [ ' if , ] ; ' dup , lit ' = , [ ' if , ] ;
: :touch EVTOUCH entitydo-ev ; immediate : :touch EVTOUCH entitydo-ev ; immediate
: :tick EVTICK entitydo-ev ; immediate : :tick EVTICK entitydo-ev ; immediate
: :act EVACT entitydo-ev ; immediate
: ;entity ( entity cp ifhere -- ) : ;entity ( entity cp ifhere -- )
[ ' then , ] ' drop , [ ' ; , ] [ ' then , ] ' drop , [ ' ; , ]
0 entity-defstate ! swap ! ; immediate 0 entity-defstate ! swap ! ; immediate
@ -88,6 +101,7 @@ array frames
create b, dup b, 0 for b, next create b, dup b, 0 for b, next
does> ( dir a -- ) swap drop lookup-frame ; does> ( dir a -- ) swap drop lookup-frame ;
-1 defsingle {{blank}}
0 defstatic {car} 0 defstatic {car}
5 defstatic {car-lit} 5 defstatic {car-lit}
1 defstatic {pete-stand} 1 defstatic {pete-stand}
@ -108,6 +122,11 @@ array frames
46 defsingle {aliem} 46 defsingle {aliem}
13 14 2 5 defmulti {neut} 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 ) : sprite-bob ( x y sprindex -- x y sprindex )
dup 13 >= over 14 <= and if dup 13 >= over 14 <= and if
>rot 2dup + ticks + 40 % 20 < if 1 + then <rot >rot 2dup + ticks + 40 % 20 < if 1 + then <rot

View file

@ -29,7 +29,7 @@ WHITE text-color !
var textx var textx
var texty var texty
2 const textspeed 100 ( 2 ) const textspeed
var textleft var textleft
: textleftsay 6 textleft ! ; : textleftsay 6 textleft ! ;
: textleftchoice 8 textleft ! ; : textleftchoice 8 textleft ! ;
@ -106,11 +106,8 @@ var cchoose
: character ( iportrait color ) create , , : character ( iportrait color ) create , ,
does> dup @ text-color ! cell + @ draw-portrait ; does> dup @ text-color ! cell + @ draw-portrait ;
0 GREEN character pete userword 0 LGREEN character neut userword
1 MAGENTA character mary userword 3 LBLUE character jaye userword
2 BROWN character chuck userword
3 YELLOW character jeanne userword
4 LGRAY character phone userword
: noone WHITE text-color ! s" " dup dup dup : noone WHITE text-color ! s" " dup dup dup
8 portraity 16 portraity 24 portraity 32 portraity ; userword 8 portraity 16 portraity 24 portraity 32 portraity ; userword

BIN
game.exe

Binary file not shown.

View file

@ -21,10 +21,12 @@ var player.prevdir
1 const MOVING userword 1 const MOVING userword
2 const NOCLIP userword 2 const NOCLIP userword
4 const ISNEUT userword 4 const ISNEUT userword
8 const HASNEUT userword
: noclip player.state NOCLIP fnot! ; userword : noclip player.state NOCLIP fnot! ; userword
: isneut? player.state ISNEUT f@ ; userword : isneut? player.state ISNEUT f@ ; userword
: isjaye? isneut? not ; userword
: {jaye} : {jaye}
isneut? not player.state MOVING f@ and isneut? not player.state MOVING f@ and
@ -35,17 +37,15 @@ var player.prevdir
isneut? if NEUTABLE else WALKABLE then mapflag? isneut? if NEUTABLE else WALKABLE then mapflag?
else drop drop 1 then ; else drop drop 1 then ;
12 9 N ' {jaye} defentity pjaye 14 9 N ' {jaye} defentity pjaye
17 5 N ' {neut} defentity pneut 17 5 N ' {neut} defentity pneut
: player isneut? if pneut else pjaye then ; : player isneut? if pneut else pjaye then ;
: sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ; : sched-move-entity ( entity -- ) :| jobdata move-entity |; sched-with ;
: move-player : move-player
:| 1 player.state MOVING f! 1 player.state MOVING f!
player move-entity
0 player.state MOVING f!
|; sched
isneut? not if ( only jaye can have a party ) isneut? not if ( only jaye can have a party )
player.prevdir @ party each player.prevdir @ party each
dup player != if dup player != if
@ -53,7 +53,10 @@ var player.prevdir
dup >rot entity.dir ! dup >rot entity.dir !
sched-move-entity <r sched-move-entity <r
else entity.dir @ player.prevdir ! then more drop else entity.dir @ player.prevdir ! then more drop
then ; then
player move-entity
0 player.state MOVING f! ;
: out-of-bounds ( x y -- b ) : out-of-bounds ( x y -- b )
2dup 0 < swap 0 < or >rot mapsize ( b x y w h ) 2dup 0 < swap 0 < or >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 : queue-level q-level ! q-player.y ! q-player.x ! ; userword
: player-tick : 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 0 ^LEFT key-down if drop 1 W player entity.dir ! then
^RIGHT key-down if drop 1 E 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 ^UP key-down if drop 1 N player entity.dir ! then
@ -143,15 +147,20 @@ var q-player.y
var showmouse var showmouse
1 showmouse ! 1 showmouse !
var glitchlevel var glitchlevel
var quaking
: full-draw : full-draw
quaking @ not if
player entity.x @ 152 - player entity.x @ 152 -
player entity.y @ 92 - player entity.y @ 92 -
scroll scroll
else
0 ticks 3 % 13 * 8 % scroll
then
entities each draw-entity more entities each draw-entity more
party each draw-entity more party each draw-entity more
pneut draw-entity player.state HASNEUT f@ if pneut draw-entity then
showmouse @ if showmouse @ if
mouseworldpos 4 draw-sprite mouseworldpos 4 draw-sprite

BIN
game.prj

Binary file not shown.

View file

@ -1,7 +1,100 @@
( L E V E L 0 0 0 0 1 ) ( 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 -- )
<rot >r r@ entity>tile b@ toggleval <r 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 ;
: blankentity array here >r N ' {blank} allotentity <r ;
: door blankentity
:| dup EVTOUCH = isjaye? and responder DOOR-OPENED entity>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 :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 s" lev00001.map" load-map
( ' intro sched )
; ' onload redefine ; ' onload redefine

Binary file not shown.

View file

@ -18,6 +18,11 @@ array tileflags
( table ) 0 b, ( table ) 0 b,
( chair ) 0 b, ( chair ) 0 b,
( table-brok ) 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 here tileflags - 1 - const MAXTILE

Binary file not shown.

Binary file not shown.

View file

@ -232,7 +232,9 @@ void f_keyIsDown() {
} }
void f_drawSprite() { // ( x y sprite -- ) void f_drawSprite() { // ( x y sprite -- )
if (TOP().i >= 0) {
drawSprite(&sprites[TOP().i * SPRITE_STRIDE], ST2().i, ST1().i, NULL); drawSprite(&sprites[TOP().i * SPRITE_STRIDE], ST2().i, ST1().i, NULL);
}
DROP(3); DROP(3);
} }

BIN
tiles.gfx

Binary file not shown.