67 lines
1.6 KiB
Plaintext
Executable file
67 lines
1.6 KiB
Plaintext
Executable file
( M A P )
|
|
: +pos ( x1 y1 x2 y2 -- x y )
|
|
<rot + >rot + swap ;
|
|
|
|
var tileselect
|
|
8 const MAXTILE
|
|
|
|
: mouseworldpos mousepos scrollpos +pos ;
|
|
: world>tile 4 >> swap 4 >> swap ;
|
|
: mousetile mouseworldpos world>tile ;
|
|
: tile ( x y -- ptr ) mapsize drop * + map + ;
|
|
|
|
1 const WALKABLE
|
|
2 const DRIVABLE
|
|
|
|
array tileflags
|
|
( grass ) WALKABLE b,
|
|
( dirt ) WALKABLE b,
|
|
( water ) 0 b,
|
|
( pavement ) WALKABLE DRIVABLE | b,
|
|
( brick ) 0 b,
|
|
( forest ) 0 b,
|
|
( roof ) 0 b,
|
|
( brick ) 0 b,
|
|
( window ) 0 b,
|
|
|
|
: mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
|
|
: walkable? ( x y -- b ) WALKABLE mapflag? ;
|
|
: drivable? ( x y -- b ) DRIVABLE mapflag? ;
|
|
|
|
: tick-mapedit
|
|
tileselect @
|
|
^< key-pressed if 1 - then
|
|
^> key-pressed if 1 + then
|
|
dup 0 < if drop MAXTILE then
|
|
dup MAXTILE > if drop 0 then
|
|
tileselect !
|
|
|
|
MOUSEL mousedown if tileselect @ mousetile tile b! then
|
|
MOUSER clicked if mouseworldpos world>tile swap . . then ;
|
|
|
|
: copy-mapseg ( neww oldw y -- )
|
|
r> ( oldw neww r: y )
|
|
2dup min >rot ( copyw neww oldw )
|
|
r@ * map + ( copyw neww src )
|
|
swap r< * map + ( copyw src dst )
|
|
swap <rot memmove ;
|
|
|
|
: resize-map ( neww newh -- )
|
|
swap mapsize r> ( newh neww oldw r: oldh )
|
|
2dup < if 1 r< else r< 1 - 0 then ( newh neww copyw ystart ylim )
|
|
for 2dup i copy-mapseg next
|
|
drop swap mapsize! ;
|
|
|
|
: save-map ( filename -- )
|
|
fdeactivate swap overwrite
|
|
mapsize swap fput fput
|
|
mapsize * map fwrite
|
|
factivate ;
|
|
|
|
: load-map ( filename -- )
|
|
fdeactivate swap open
|
|
fget fget
|
|
2dup * map fread
|
|
mapsize!
|
|
factivate ;
|