"Now upgrading the TerraForm planet manager system.
@name mover=terraform-mover
@program terraform-mover
1 19999 d
i
( TerraForm - planet generation system )
( Terrain generator... room maintenence )
( By Triggur of Brazilian Dreams )
( {C} 1994 by Kevin Kelm, pferd@netcom.com )
( All rights reserved. )
( DO MODIFY WITHOUT EXPLICIT PERMISSION! )
( V1.00 - Original )
( V1.01 - Added code to pull terrain types from map hierarchies )
( V1.02 - Added code to autosave/restore exits )
( V1.03 - Fixed wrap at north and south of world )
( V1.04 - Converted 2D -> 3D, oceans, skies, space )
( ---- RELEASED ---- )
( V1.06 - Diddled the order of looking for player's location )
( V1.08 - '!' terrain type now can use local/global fail/ofail set with
@editterrain )
( V1.09 - added support for 'inside' rooms and building )
( V1.10 - added support for terrain library rooms )
( V1.11 - made the room destroyer sleep for 1 second before starting so that
Riss's RIDE and other programs can finish what they need to do
before the room goes poof )
( V1.12 - modified: now only player positions are tracked with @/occupants )
( V1.15 - added on-the-spot sanity checking to make sure that the dbref
stored in the @/rooms propdir is valid. It might NOT be valid,
for instance, if someone has @rec'd the room in question. Note
that if it has since become ANOTHER spot on the planet, this will
NOT be detected... hence weirdness could result. But at least it
doesn't crash. )
( V1.16 - added skylinks )
( ------ RELEASE V1.18 ------ )
$define PARSELIMIT 50 $enddef ( max # of substitutions in text generator )
$define DEBUGON prog "d" set $enddef
$define DEBUGOFF prog "!d" set $enddef
lvar env
lvar cx
lvar cy
lvar cz
lvar lx
lvar ly
lvar lz
lvar lastroom
lvar nextroom
lvar terrain
lvar altitude
lvar val1
lvar val2
lvar val3
lvar val4
lvar val5
lvar temp
lvar cttstop
lvar x1
lvar y1
lvar x2
lvar y2
lvar mapdbref
lvar mapwide
lvar maptall
lvar terrains
: calculate_sky_link ( -- bool )
( skylink entries are in the format: x1 y1 x2 y2 dbref )
( where x1,y1 = upper left corner, x2,y2=lower right corner, )
( dbref = dbref of the primary map room of the destination world.)
( NOTE: You MUST store the lower-resolution )
( maps at the bottom of the list and the higher resolution maps at )
( the top! The dbref MUST be a room and this room MUST be )
( a world's primary environment room! )
env @ "./skymaps#" getpropstr atoi cttstop !
1 temp !
begin
temp @ cttstop @ > if ( out of maps )
break
then
env @ "./skymaps#/" temp @ intostr strcat getpropstr
dup ":" instr dup if 1 - strcut pop else pop then
strip " " explode pop
atoi x1 !
atoi y1 !
atoi x2 !
atoi y2 !
atoi dbref mapdbref !
cx @ x1 @ < not cx @ x2 @ > not and ( is current x value in range? )
cy @ y1 @ < not cy @ y2 @ > not and ( is current y value in range? )
and if ( match! )
( get fractions into this rectangle and translate to fractions across other
world, flipped horizontally. )
mapdbref @ "./maxx" getpropstr atoi mapwide !
mapdbref @ "./maxy" getpropstr atoi maptall !
mapdbref @ "./maxz" getpropstr atoi
cz @ env @ "./maxz" getpropstr atoi - 1 - - cz ! ( move into other sky )
cz @ 0 < if
0 cz !
then
x1 @ x2 @ = if ( map into destination planet width {flipped} )
0 cx !
else
mapwide @ cx @ x1 @ - mapwide @ * x2 @ x1 @ - 1 + / - cx !
then
y1 @ y2 @ = if ( map into destination planet 'height' )
0 cy !
else
cy @ y1 @ - 1 + maptall @ * y2 @ y1 @ - 1 + / cy !
then
1 exit
then
temp @ 1 + temp !
repeat
DEBUGOFF
0 exit ( no error message if we can't find one... just fail. )
;
: calculate_terrain_type ( -- bool )
( map entries are in the format: x1 y1 x2 y2 dbref )
( where x1,y1 = upper left corner, x2,y2=lower right corner, )
( dbref = dbref that contains mapping data. It is broken up )
( like this so that Revar's caching system can still do its )
( job & save memory. NOTE: You MUST store the lower-resolution )
( maps at the bottom of the list and the higher resolution maps at )
( the top! The dbref MUST be a room and this room MUST have )
( the world's primary environment room as a parent or ancestor! )
env @ "./maps#" getpropstr atoi cttstop !
1 temp !
begin
temp @ cttstop @ > if ( out of maps )
break
then
env @ "./maps#/" temp @ intostr strcat getpropstr
dup ":" instr dup if 1 - strcut pop else pop then
strip " " explode pop
atoi x1 !
atoi y1 !
atoi x2 !
atoi y2 !
atoi dbref mapdbref !
mapdbref @ "./terrains" getpropstr dup if
atoi dbref terrains !
else
pop mapdbref @ terrains !
then
cx @ x1 @ < not cx @ x2 @ > not and ( is current x value in range? )
cy @ y1 @ < not cy @ y2 @ > not and ( is current y value in range? )
and if ( possible match! )
mapdbref @ "./map#" getpropstr atoi 1 + maptall ! ( get map dimensions )
mapdbref @ "./map#/1" getpropstr strlen 1 + mapwide !
cy @ y1 @ - maptall @ 1 - * y2 @ y1 @ - 1 + / 1 + ( get map line )
mapdbref @ swap "./map#/" swap intostr strcat getpropstr
cx @ x1 @ - mapwide @ 1 - * x2 @ x1 @ - 1 + / ( get map column )
strcut swap pop 1 strcut pop ( get the map character! )
dup terrains @ swap "./" swap strcat "/name" strcat getpropstr if
terrain ! 1 exit ( terrain type known ... done! )
then
then
temp @ 1 + temp !
repeat
( TODO: ENHANCE THIS ERROR TO PRINT LOCATION )
me @ "ERROR: Could not calculate terrain type. Notify " env @ owner name
strcat " immediately!" strcat notify
0 exit
;
: gettoken ( s -- s1 s2 token )
dup "%" instring dup not if ( none left... return )
pop "" exit
then
1 - strcut 1 strcut swap pop ( snip off prefix, % )
dup "%" instring 1 - strcut 1 strcut ( snip off suffix, % )
swap pop swap ( reverse )
val1 @ 137 + temp ! ( rotate to next string number )
val2 @ val1 !
val3 @ val2 !
val4 @ val3 !
val5 @ val4 !
temp @ val5 !
dup not if ( null token )
pop strcat gettoken ( put prefix, suffix back together and try again )
then
exit
;
lvar propnum
lvar propname
lvar limit
: parsetext ( s -- s )
( description parsing tokens are stored on the maproom in a wizpropsubdir )
( with the same letter as the terrain type for that location. Example: )
( for the terrain type 'j' and the token 'roomnames', the propdir name )
( should be @/j/roomnames )
PARSELIMIT limit !
begin
limit @ not if (exceeded max count)
exit
then
gettoken dup not if ( no more tokens... return )
pop break
then
"./" swap strcat propname !
mapdbref @ propname @ "#" strcat getpropstr atoi val1 @ swap % 1 + propnum !
mapdbref @ propname @ "#/" propnum @ intostr strcat strcat
getpropstr ( get the line )
swap strcat strcat ( join with suffix and prefix )
limit @ 1 - limit !
repeat
exit
;
lvar count
: itemcount ( -- i )
0 count !
lastroom @ contents
begin
dup #-1 dbcmp if
pop break
then
count @ 1 + count !
next
repeat
count @
exit
;
lvar numexits
lvar exitdir
lvar exitnum
: addexits ( d -- )
"@/exits/" cx @ intostr strcat "/" strcat cy @ intostr strcat "/" strcat
cz @ intostr strcat "#" strcat
exitdir !
env @ exitdir @ getpropstr atoi dup numexits !
exitdir @ "/" strcat exitdir !
begin
numexits @ not if ( no more exits to add )
break
then
env @ exitdir @ numexits @ intostr strcat getpropstr ( get the raw data )
( string format: names:link:succ:osucc:fail:ofail:drop:odrop:lock:desc )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch names )
dup ":" instr 1 - strcut 1 strcut swap pop swap atoi dbref swap ( link )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch succ )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch osucc )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch fail )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch ofail )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch drop )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch odrop )
dup ":" instr 1 - strcut 1 strcut swap pop ( fetch lock )
( desc is left )
10 rotate nextroom @ swap newexit exitnum ! ( create exit )
exitnum @ int 1 < if
me @ "ERROR: COULD NOT CREATE EXIT. PLEASE NOTIFY " env @ owner name
strcat "!!!" strcat notify
then
exitnum @ mapdbref @ owner setown ( chown to owner of region )
exitnum @ swap setdesc
exitnum @ swap setlockstr pop
exitnum @ swap setodrop
exitnum @ swap setdrop
exitnum @ swap setofail
exitnum @ swap setfail
exitnum @ swap setosucc
exitnum @ swap setsucc
exitnum @ swap setlink
numexits @ 1 - numexits !
repeat
exit
;
lvar exprop
lvar exnum
lvar exstr
: save_exits ( -- )
"@/exits/" cx @ intostr strcat "/" strcat cy @ intostr strcat
"/" strcat cz @ intostr strcat
"#" strcat exprop !
env @ exprop @ remove_prop
1 exnum !
lastroom @ exits
begin
dup #-1 dbcmp if
break
then
dup name ":" strcat exstr !
dup getlink exstr @ swap int intostr strcat ":" strcat exstr !
dup succ exstr @ swap strcat ":" strcat exstr !
dup osucc exstr @ swap strcat ":" strcat exstr !
dup fail exstr @ swap strcat ":" strcat exstr !
dup ofail exstr @ swap strcat ":" strcat exstr !
dup drop exstr @ swap strcat ":" strcat exstr !
dup odrop exstr @ swap strcat ":" strcat exstr !
dup getlockstr dup "*UNLOCKED*" stringcmp not if
pop ""
then
exstr @ swap strcat ":" strcat exstr !
dup desc exstr @ swap strcat exstr !
env @ exprop @ "/" strcat exnum @ intostr strcat exstr @ 0 addprop
exnum @ 1 + exnum !
next
repeat
exnum @ 1 = not if
env @ exprop @ exnum @ 1 - intostr 0 addprop
then
exit
;
lvar tx
lvar ty
lvar tz
: main ( s -- )
( this is a test to make it more solid to @tel'ing
"Arrive" stringcmp not if
preempt
loc @ lastroom !
lastroom @ "~x" getpropstr not if
exit
then
[...]
exit
then
)
"Depart" stringcmp not if ( clean up behind player )
1 sleep
preempt ( we do NOT want to be interrupted in here )
loc @ ok? not if ( doublecall, V1.0 leftover )
exit
then
loc @ lastroom !
lastroom @ "~x" getpropstr not if ( not really a generated room )
exit
then
lastroom @ "@/env" getpropstr atoi dbref env !
lastroom @ location me @ location location dbcmp not if ( exited world )
env @ "@/occupants/" me @ int intostr strcat remove_prop
then
itemcount not lastroom @ ".noflush" getpropstr not and if ( zap it )
lastroom @ "~x" getpropstr atoi cx !
lastroom @ "~y" getpropstr atoi cy !
lastroom @ "~z" getpropstr atoi cz !
save_exits
env @ "@/rooms/" cx @ intostr strcat "/" strcat
cy @ intostr strcat "/" strcat cz @ intostr strcat remove_prop
lastroom @ recycle
then
exit
then
preempt ( we do NOT want to be interrupted in here )
( get this player's current location, if any )
trigger @ "@/env" getpropstr atoi dbref env !
env @ #0 dbcmp if
me @ "ERROR: EXIT #" trigger @ int intostr strcat
" DOES NOT HAVE 'ENV' PROP SET TO ENV ROOM!!!" strcat notify
exit
then
0 cx ! 0 cy ! 0 cz !
( load location from location if possible, else bump )
me @ location "~x" getpropstr atoi cx !
me @ location "~y" getpropstr atoi cy !
me @ location "~z" getpropstr atoi cz !
cx @ 0 = cy @ 0 = cz @ 0 = and and if ( probably teleported in. naughty. )
env @ "@/occupants/" me @ int intostr strcat getpropstr
dup if "," explode pop else pop "" "" "" then atoi cx ! atoi cy ! atoi cz !
then
( get the dbref of the [existing] room at that location )
env @ "@/rooms/" cx @ intostr strcat "/" strcat cy @ intostr strcat
"/" strcat cz @ intostr strcat getpropstr atoi dbref lastroom !
cx @ lx !
cy @ ly !
cz @ lz !
cx @ 0 = cy @ 0 = cz @ 0 = and and if ( entering the world fresh )
trigger @ "@/x" getpropstr atoi cx !
trigger @ "@/y" getpropstr atoi cy !
trigger @ "@/z" getpropstr atoi cz !
else
trigger @ "@/dx" getpropstr atoi cx @ + cx !
trigger @ "@/dy" getpropstr atoi cy @ + cy !
trigger @ "@/dz" getpropstr atoi cz @ + cz !
then
cx @ lx @ = cy @ ly @ = cz @ lz @ = and and if ( get absolute )
trigger @ "@/x" getpropstr atoi cx !
trigger @ "@/y" getpropstr atoi cy !
trigger @ "@/z" getpropstr atoi cz !
then
cx @ 1 < if ( wrap around the world )
cx @ env @ "./maxx" getpropstr atoi + cx !
then
cx @ env @ "./maxx" getpropstr atoi > if
cx @ env @ "./maxx" getpropstr atoi - cx !
then
cy @ 1 < if ( wrap north... complex )
1 cy @ - cy ! ( move back )
cx @ env @ "./maxx" getpropstr atoi 2 / +
env @ "./maxx" getpropstr atoi %
dup not if pop env @ "./maxx" getpropstr atoi then cx !
then
cy @ env @ "./maxy" getpropstr atoi > if ( wrap south... complex )
env @ "./maxy" getpropstr atoi 2 * cy @ - cy ! ( move back )
cx @ env @ "./maxx" getpropstr atoi 2 / +
env @ "./maxx" getpropstr atoi %
dup not if pop env @ "./maxx" getpropstr atoi then cx !
then
( calculate description string numbers )
cx @ cy @ + dup 0 < if 0 swap - then val1 !
cy @ cx @ - dup 0 < if 0 swap - then val2 !
cx @ cy @ * cz @ + dup 0 < if 0 swap - then val3 !
cx @ 7 * cy @ cz @ + + dup 0 < if 0 swap - then val4 !
cx @ cy @ 3 * cz @ - + dup 0 < if 0 swap - then val5 !
( get the dbref of the new room )
env @ "@/rooms/" cx @ intostr strcat "/" strcat cy @ intostr strcat
"/" strcat cz @ intostr strcat getpropstr atoi dbref nextroom !
( sanity check: Is the stored dbref valid? )
nextroom @ dup #0 dbcmp not if
dup room? not if ( the old room reference is bad )
pop #0 nextroom !
else dup "@/env" getpropstr atoi dbref env @ dbcmp not if ( ref is bad )
pop #0 nextroom !
else ( ref is ok, use it )
pop
then then
then
( if it doesnt exist yet, create it, else get maproom/terrain/etc )
nextroom @ #0 dbcmp not if ( hunt down the mapdbref/terrains )
nextroom @ location mapdbref !
mapdbref @ "./terrains" getpropstr dup if
atoi dbref terrains !
else
pop mapdbref @ terrains !
then
else
calculate_terrain_type not if ( failed )
exit
then
loc @ ".inside" getpropstr not loc @ owner me @ dbcmp not or if
( if @inside and this player owns this room, can go any dir, else check )
( see if they can move in that direction )
terrain @ "!" stringcmp not if ( boundary character... fail )
me @ terrains @ "./!/fail" getpropstr dup not if
env @ fail dup not if
"You can't go that way."
else
pop
then
else
pop
then
notify ( deliver fail )
loc @ me @ me @ name " " strcat
terrains @ "./!/ofail" getpropstr dup not if
env @ ofail dup not if
exit
then
else
pop
then
notify_except
exit
then
( see if they're trying to go too high )
env @ "./maxz" getpropstr atoi cz @ < if ( yup )
calculate_sky_link not if
me @ env @ fail notify
exit
then
me @ "You cross over into the gravitational well of " mapdbref @ name
strcat "." strcat notify
( we're about to warp over to another planet... start the engines! :)
trigger @ "@/env" getpropstr temp ! (save old props if any )
trigger @ "@/x" getpropstr lx !
trigger @ "@/y" getpropstr ly !
trigger @ "@/z" getpropstr lz !
trigger @ "@/dx" getpropstr tx !
trigger @ "@/dy" getpropstr ty !
trigger @ "@/dz" getpropstr tz !
trigger @ "@/env" mapdbref @ intostr 0 addprop (set new props)
trigger @ "@/x" cx @ intostr 0 addprop
trigger @ "@/y" cy @ intostr 0 addprop
trigger @ "@/z" cz @ intostr 0 addprop
trigger @ "@/dx" remove_prop
trigger @ "@/dy" remove_prop
trigger @ "@/dz" remove_prop
prog "" swap call ( call ourselves for new world )
temp @ if ( restore old props if any )
trigger @ "@/env" temp @ 0 addprop
else
trigger @ "@/env" remove_prop
then
tx @ if
trigger @ "@/dx" tx @ 0 addprop
then
ty @ if
trigger @ "@/dy" ty @ 0 addprop
then
tz @ if
trigger @ "@/dz" tz @ 0 addprop
then
lx @ if
trigger @ "@/x" lx @ 0 addprop
else
trigger @ "@/x" remove_prop
then
ly @ if
trigger @ "@/y" ly @ 0 addprop
else
trigger @ "@/y" remove_prop
then
lz @ if
trigger @ "@/z" lz @ 0 addprop
else
trigger @ "@/z" remove_prop
then
me @ location loc @ dbcmp not if ( remove player from this tfbd )
env @ "@/occupants/" me @ intostr strcat remove_prop
then
DEBUGOFF
exit ( halt processing in THIS world... player's gone. )
then
cz @ 0 > if
env @ "./flyprop" getpropstr dup if
me @ swap getpropstr not if ( player doesnt have prop! )
me @ env @ fail notify
exit
then
else pop then
then
( see if they're trying to go too low )
mapdbref @ "./" terrain @ strcat "/minz" strcat getpropstr atoi cz @ > if
me @ env @ fail notify
exit
then
cz @ 0 < if
mapdbref @ "./" terrain @ strcat "/underprop" strcat getpropstr dup if
me @ swap getpropstr not if ( player doesnt have prop! )
me @ env @ fail notify
exit
then
else pop then
then
then
( the new room's name and desc prototypes come from the maproom itself )
( UNLESS there is a redirection prop. )
terrains @
cz @ not if ( get name )
terrains @ "./" terrain @ strcat "/name" strcat getpropstr
else cz @ 0 > if ( get a sky name )
env @ "./skymap#" getpropstr atoi temp !
begin
temp @ not if break then
env @ "./skymap#/" temp @ intostr strcat getpropstr " " explode pop
atoi cz @ > not swap atoi cz @ < not and if ( in range! )
temp @ altitude !
env @ "./skyname/" temp @ intostr strcat getpropstr
break
then
temp @ 1 - temp !
repeat
else ( get 'under' name )
terrains @ "./" terrain @ strcat "/undername" strcat getpropstr
then then
parsetext dup not if pop "a room" then newroom nextroom !
nextroom @ int 1 < if ( failed )
me @ "ERROR: Could not create room! Please notify " env @ owner name
strcat "." strcat notify
exit
then
loc @ ".inside" getpropstr cz @ 0 = not and if
nextroom @ ".inside" "y" 0 addprop
nextroom @ ".noflush" "y" 0 addprop
then
nextroom @ mapdbref @ owner setown ( chown the room to owner of the map )
nextroom @
cz @ not if ( get desc )
terrains @ "./" terrain @ strcat "/desc" strcat getpropstr
else cz @ 0 > if ( get a sky desc )
env @ "./skydesc/" altitude @ intostr strcat getpropstr
else ( get 'under' desc )
terrains @ "./" terrain @ strcat "/underdesc" strcat getpropstr
then then
parsetext setdesc ( describe the room )
nextroom @ "~x" cx @ intostr 0 addprop ( tell the room its location )
nextroom @ "~y" cy @ intostr 0 addprop
nextroom @ "~z" cz @ intostr 0 addprop
nextroom @ "~listen" env @ "./_listen" getpropstr 0 addprop
env @ "@/rooms/" cx @ intostr strcat "/" strcat cy @ intostr strcat
"/" strcat cz @ intostr strcat
nextroom @ env @ succ setsucc
nextroom @ "~terrain" terrain @ 0 addprop (tell room its terrain )
nextroom @ "@/env" env @ int intostr 0 addprop (tell room its env)
nextroom @ int intostr 0 addprop ( tell envroom about the new room )
nextroom @ addexits
then
( move the player to the next room, update envroom props )
cz @ not lz @ not and loc @ ".inside" getpropstr or if ( use terrestrial verb )
me @ trigger @ "succ" getpropstr ( print succ )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/verb" strcat
getpropstr "%v" subst me @ swap pronoun_sub notify
loc @ me @ trigger @ "osucc" getpropstr ( print osucc )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/overb" strcat
getpropstr "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
nextroom @ me @ trigger @ "odrop" getpropstr ( print odrop )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/overb" strcat
getpropstr "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
else cz @ 0 < lz @ 0 < or if ( use under verb )
me @ trigger @ "succ" getpropstr ( print succ )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/underverb" strcat
getpropstr "%v" subst me @ swap pronoun_sub notify
loc @ me @ trigger @ "osucc" getpropstr ( print osucc )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/underoverb" strcat
getpropstr "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
nextroom @ me @ trigger @ "odrop" getpropstr ( print odrop )
terrains @ "./" loc @ "~terrain" getpropstr strcat "/underoverb"
strcat getpropstr "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
else ( use "fly/flies" verb )
me @ trigger @ "succ" getpropstr ( print succ )
"fly" "%v" subst me @ swap pronoun_sub notify
loc @ me @ trigger @ "osucc" getpropstr ( print osucc )
"flies" "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
nextroom @ me @ trigger @ "odrop" getpropstr ( print odrop )
"flies" "%v" subst me @ name " " strcat swap strcat
me @ swap pronoun_sub notify_except
then then
me @ nextroom @ moveto
me @ player? if
env @ "@/occupants/" me @ int intostr strcat cx @ intostr "," strcat
cy @ intostr strcat "," strcat cz @ intostr strcat 0 addprop
then
( hmmmmmm. that should do it. )
exit
;
.
c
q
@program terraform-commands
1 19999 d
i
( TerraForm - planet generation system )
( user interface commands )
( By Triggur of Brazilian Dreams )
( {C} 1995 by Kevin Kelm, pferd@netcom.com )
( All rights reserved. )
( DO NOT MODIFY WITHOUT EXPLICIT PERMISSION! )
( V1.00 - Original )
( ... )
( V1.11 - added 'version' string maintenence )
( V1.12 - added sanity checker to help clear up problems with installation of
upgrages, expose possible deficiencies in terrain coverage, and
correct problems in the @/rooms/ and @/occupants/ propdirs. )
( V1.13 - added @killworld )
( V1.14 - removed @recycle command as a potential cause of trouble )
( V1.15 - fixed a permissions bug in @editmap {Cara/BD} )
( V1.16 - added @skylink )
( fiddled @loc to return the planet's name, too )
( V1.17 - added @admin )
( V1.18 - added @own )
( ------ RELEASE V1.18 ------ )
$include $lib/editor
$define LOC_OK_DEFAULT 1 $enddef
$define DEBUGON prog "d" set $enddef
$define DEBUGOFF prog "!d" set $enddef
$define VERSION "1.18" $enddef
$define GET-DATA get-text not if exit then $enddef
$define PERMISSION-CHECK has-permission not if exit then $enddef
lvar tmove
lvar tmp
lvar gttmp
lvar gtout
: get-text ( s -- s i )
gttmp !
begin
" " .tell gttmp @ .tell
"(Type .quit to abort, or \"say or :pose)" .tell
read striplead striptail gtout !
gtout @ 1 strcut pop dup ":" stringcmp not if
loc @ #-1 me @ name " " strcat gtout @ 1 strcut swap pop strcat
notify_except
else "\"" stringcmp not if
loc @ #-1 me @ name " " strcat
me @ "_say/def/osay" getpropstr dup not if pop "says," then strcat
" " strcat gtout @ "\"" strcat strcat
notify_except
else gtout @ ".quit" stringcmp not if
"Aborted." .tell gtout @ 0 exit
else
gtout @ 1 exit
then then then
repeat
exit
;
: has-permission ( -- i )
( is the trigger a wizard-owned one, or a hack? )
trig owner "w" flag? not if
"Permission denied." .tell 0 exit
then
( is this a terraform room? )
loc @ "@/env" getpropstr not loc @ "./map#" getpropstr not and if
"Permission denied." .tell 0 exit
then
me @ "w" flag? if 1 exit then ( wizards can always do it )
loc @ owner me @ dbcmp if 1 exit then ( player owns THIS room )
loc @ "./map#" getpropstr not if
loc @ location tmp !
else
loc @ tmp !
then
begin
tmp @ "./map#" getpropstr not if (out of rooms to check)
"Permission denied." .tell
0 exit
then
me @ tmp @ owner dbcmp if (player owns map room)
1 exit
then
tmp @ "@/admins" getpropstr "|" me @ intostr strcat "|" strcat instr if
1 exit ( player listed as an admin )
then
tmp @ location tmp !
repeat
0
exit
;
lvar locroom
: is-loc_ok? ( d -- i )
locroom !
locroom @ "~x" getpropstr dup not if
0 exit
then
locroom @ "./loc_ok?" getpropstr dup "yes" stringcmp not if
pop 1 exit
else "no" stringcmp not if
pop 0 exit
then then
locroom @ location locroom !
begin
locroom @ int 0 < if break then
locroom @ "@/env" getpropstr not locroom @ "./map" getpropstr not and if
LOC_OK_DEFAULT exit ( no more rooms to check )
then
locroom @ "./loc_ok?" getpropstr dup "yes" stringcmp not if
pop 1 exit
else "no" stringcmp not if
pop 0 exit
then then
locroom @ location locroom !
repeat
LOC_OK_DEFAULT exit
exit
;
lvar pnum
lvar primary
: do-loc ( s -- ) ( @loc )
dup if
PERMISSION-CHECK
.pmatch pnum ! pnum @ int 0 > not if
"I don't know who that is." .tell
exit
then
loc @ "@/env" getpropstr dup if
atoi dbref primary !
else
pop loc @ primary !
then
primary @ "@/occupants/" pnum @ intostr strcat getpropstr dup not if
pnum @ name " is currently in " strcat pnum @ location name strcat "."
strcat .tell exit
then
pnum @ name " is currently" pnum @ location "@/env" getpropstr dup if
atoi dbref name " on " swap strcat strcat
else
pop
then
" at " strcat pnum @ location "~x" getpropstr
strcat ", " strcat pnum @ location "~y" getpropstr strcat pnum @
location "~z" getpropstr dup if
", " swap strcat strcat
else
pop
then
"." strcat .tell exit
then
loc @ is-loc_ok? not if
pop "You are currently in " loc @ name strcat "." strcat .tell
else
"You are currently on " loc @ "@/env" getpropstr atoi dbref name
strcat " at " strcat swap strcat ", " strcat loc @ "~y" getpropstr
strcat loc @ "~z" getpropstr dup if
", " swap strcat strcat
else
pop
then
"." strcat .tell
then
exit
;
lvar tpx
lvar tpy
lvar tpz
: do-tport ( s -- )
PERMISSION-CHECK
" " "," subst
loc @ "@/env" getpropstr dup if
atoi dbref primary !
else pop loc @ "./map#" getpropstr if
loc @ primary !
else
"Permission denied." .tell exit
then then
trigger @ "@/env" primary @ intostr 0 addprop
0 0 0 tpx ! tpy ! tpz !
dup not if
"USAGE:" .tell "@TPORT <x> <y> [z]" .tell
"@TPORT <placename>" .tell "@TPORT #ADD <placename>" .tell
"@TPORT #LIST" .tell exit
then
dup "#list" stringcmp not if
primary @ "./tportdests/" nextprop tpx !
0 tpy !
"Placename Coordinates" .tell
"-------------------------------" .tell
begin
tpx @ not if break then
tpx @ dup "/" rinstr strcut swap pop dup strlen 20 swap -
" " swap strcut pop strcat
primary @ tpx @ getpropstr strcat .tell
primary @ tpx @ nextprop tpx !
tpy @ 1 + tpy !
repeat
tpy @ intostr " teleport destinations listed." strcat .tell
exit
then
dup dup strip " " instr strcut swap striptail "#add" stringcmp not if
loc @ "~x" getpropstr not if
"ERROR: You must be in a TerraForm-generated room to add a room to the list."
.tell exit
then
dup not if
"ERROR: You must specify the one-word name of this place." .tell exit
then
dup "./tportdests/" swap strip strcat primary @ swap getpropstr if
"ERROR: A destination already exists with that name." .tell exit
then
primary @ swap "./tportdests/" swap strcat loc @ "~x" getpropstr
" " strcat loc @ "~y" getpropstr strcat " " strcat loc @ "~z" getpropstr
strcat 0 addprop "Done." .tell exit
else
pop
then
dup primary @ swap "./tportdests/" swap strcat getpropstr dup if
swap pop
else
pop dup 2 strcut pop strip number? not if
"ERROR: Unknown placename. @TPORT #LIST to list valid ones." .tell exit
then
then
dup " " instr strcut swap atoi tpx !
striplead dup " " instr dup not if
pop atoi tpy !
else
strcut swap atoi tpy !
strip atoi tpz !
then
( this is sort of a whacky hook into the normal entrance management code.
I teleported home one night with Ron and Sid and Peg.
Ron stole Peggy's heart away and I got Sidney's leg! )
preempt ( we do NOT want to get interrupted here in coincident teleports :)
trigger @ "@/x" tpx @ intostr 0 addprop
trigger @ "@/y" tpy @ intostr 0 addprop
trigger @ "@/z" tpz @ intostr 0 addprop
loc @ "_reg/tmove" envpropstr dup not if
"Permission denied; TerraForm has not been installed on this system." .tell
pop exit
then
"" "#" subst atoi dbref "" swap call
trigger @ "@/x" remove_prop
trigger @ "@/y" remove_prop
trigger @ "@/z" remove_prop
exit
;
lvar blocked
lvar bexit
lvar bcount
lvar bnew
: coord-correct ( x y z -- x' y' z' )
tpz ! tpy ! tpx !
tpz @ primary @ "./maxz" getpropstr atoi > if (not a valid room)
-1 -1 -1 exit
then
tpz @ loc @ location "./" loc @ "~terrain" getpropstr strcat "/minz" strcat
getpropstr atoi < if ( not a valid room )
-1 -1 -1 exit
then
tpx @ 1 < if ( wrap around the world )
tpx @ primary @ "./maxx" getpropstr atoi + tpx !
then
tpx @ primary @ "./maxx" getpropstr atoi > if
tpx @ primary @ "./maxx" getpropstr atoi - tpx !
then
tpy @ 1 < if ( wrap north... complex )
1 tpy @ - tpy ! ( move back )
tpx @ primary @ "./maxx" getpropstr atoi 2 / +
primary @ "./maxx" getpropstr atoi %
dup not if pop primary @ "./maxx" getpropstr atoi then tpx !
then
tpy @ primary @ "./maxy" getpropstr atoi > if ( wrap south... complex )
primary @ "./maxy" getpropstr atoi 2 * tpy @ - tpy ! ( move back )
tpx @ primary @ "./maxx" getpropstr atoi 2 / +
primary @ "./maxx" getpropstr atoi %
dup not if pop primary @ "./maxx" getpropstr atoi then tpx !
then
tpx @ tpy @ tpz @ exit
;
: reflex-direction ( x y z s -- x' y' z' s' )
( calculate the room coords and reflex direction to a given exit name )
swap tpz ! swap tpy ! swap tpx !
dup "n" stringcmp not if pop tpx @ tpy @ 1 - tpz @ coord-correct "s" exit then
dup "s" stringcmp not if pop tpx @ tpy @ 1 + tpz @ coord-correct "n" exit then
dup "w" stringcmp not if pop tpx @ 1 - tpy @ tpz @ coord-correct "e" exit then
dup "e" stringcmp not if pop tpx @ 1 + tpy @ tpz @ coord-correct "w" exit then
dup "ne" stringcmp not if pop tpx @ 1 + tpy @ 1 - tpz @ coord-correct "sw" exit then
dup "nw" stringcmp not if pop tpx @ 1 - tpy @ 1 - tpz @ coord-correct "se" exit then
dup "sw" stringcmp not if pop tpx @ 1 - tpy @ 1 + tpz @ coord-correct "ne" exit then
dup "se" stringcmp not if pop tpx @ 1 + tpy @ 1 + tpz @ coord-correct "nw" exit then
dup "u" stringcmp not if pop tpx @ tpy @ tpz @ 1 + coord-correct "d" exit then
"d" stringcmp not if tpx @ tpy @ tpz @ 1 - coord-correct "u" exit then
tpx @ tpy @ tpz @ "" exit
;
: add-block-direction ( x y z s -- )
dup not if pop pop pop pop exit then ( invalid exit...skip )
swap dup -1 = if pop pop pop pop exit else swap then ( invalid room... skip )
";" strcat ";" swap strcat tmp ! tpz ! tpy ! tpx !
primary @ "@/rooms/" tpx @ intostr strcat "/" strcat tpy @ intostr strcat
"/" strcat tpz @ intostr strcat getpropstr dup if ( room exists, fiddle it )
atoi dbref dup tpx !
tpx @ "@tf" rmatch dup #-1 dbcmp not if ( set name on existing exit )
dup name ";" tmp @ subst tmp @ swap strcat setname
else ( create new exit )
pop tpx @ "@tf" tmp @ strcat newexit dup #-1 dbcmp if
"ERROR CREATING BLOCK EXIT! Notify a wizard immediately." .tell
else
dup "me&!me" setlockstr
then
then
else ( room doesn't exist, fiddle props )
primary @ "@/exits/" tpx @ intostr strcat "/" strcat tpy @ intostr strcat
"/" strcat tpz @ intostr strcat "#" strcat dup gtout ! getpropstr atoi
gttmp !
begin ( search through exits in list looking for blocks )
gttmp @ 0 = if break then
primary @ gtout @ "/" strcat gttmp @ intostr strcat getpropstr
dup "@tf;" instr dup if ( found it! replace old. )
pop ";" tmp @ subst dup "@tf;" instr ( cut old if any )
3 + strcut tmp @ swap strcat strcat ";" ";;" subst
primary @ swap gtout @ "/" strcat gttmp @ intostr strcat swap
0 addprop exit
else pop
then
gttmp @ 1 - gttmp !
repeat
( not found... add new )
primary @ gtout @ getpropstr atoi 1 + gttmp !
primary @ gtout @ gttmp @ intostr 0 addprop ( bump count )
primary @ gtout @ "/" strcat gttmp @ intostr strcat "@tf" tmp @ strcat
":-1:::::::#1&!#1:" strcat 0 addprop
then
exit
;
: kill-block-direction ( x y z s -- )
dup not if pop pop pop pop exit then ( invalid exit...skip )
swap dup -1 = if pop pop pop pop exit else swap then ( invalid room... skip )
";" strcat ";" swap strcat tmp ! tpz ! tpy ! tpx !
primary @ "@/rooms/" tpx @ intostr strcat "/" strcat tpy @ intostr strcat
"/" strcat tpz @ intostr strcat getpropstr dup if ( room exists, fiddle it )
atoi dbref dup tpx !
tpx @ "@tf" rmatch dup #-1 dbcmp not if ( set name on existing exit )
dup name ";" tmp @ subst dup "@tf;" stringcmp not if
pop recycle (get rid of the exit...nothing left)
else
setname
then
then
else ( room doesn't exist, fiddle props )
primary @ "@/exits/" tpx @ intostr strcat "/" strcat tpy @ intostr strcat
"/" strcat tpz @ intostr strcat "#" strcat dup gtout ! getpropstr atoi
dup tpz ! gttmp !
begin ( search through exits in list looking for blocks )
gttmp @ 0 = if break then
primary @ gtout @ "/" strcat gttmp @ intostr strcat getpropstr
dup "@tf;" instr dup if ( found it! replace old. )
pop ";" tmp @ subst ( cut old if any )
dup tpy !
dup "@tf;:" instr if ( no exits left... kill this and compress list )
pop
tpz @ 1 = if ( get rid of the whole list )
primary @ gtout @ remove_prop exit
then
begin
gttmp @ tpz @ = if break then
primary @ gtout @ "/" strcat gttmp @ intostr strcat
primary @ gtout @ "/" strcat gttmp @ 1 + intostr strcat getpropstr
0 addprop
gttmp @ 1 + gttmp !
repeat
primary @ gtout @ tpz @ 1 - intostr 0 addprop
exit
else
primary @ gtout @ "/" strcat gttmp @ intostr strcat tpy @ 0 addprop
then
else pop
then
gttmp @ 1 - gttmp !
repeat
( not found... do nothing )
then
exit
;
: do-block ( s -- )
PERMISSION-CHECK
loc @ "~x" getpropstr not if
"Permission denied; You need to be in a TerraForm-generated room." .tell
exit
then
loc @ "@/env" getpropstr dup if
atoi dbref primary !
else pop loc @ "./map#" getpropstr if
loc @ primary !
else
"Permission denied." .tell exit
then then
loc @ "@tf" rmatch dup #-1 dbcmp not if
dup bexit ! name ";" "@tf;" subst blocked !
else
pop #-1 bexit ! "" blocked !
then
0 bcount !
strip dup "" stringcmp not if ( list existing blocked exits )
"Directions blocked from this location:" .tell
" "
blocked @ 1 strcut blocked ! pop
begin
blocked @ not if break then
bcount @ if ", " strcat then
blocked @ dup ";" instr dup 0 = not if
1 - strcut 1 strcut blocked ! pop
else
"" blocked ! pop
then
strcat
bcount @ 1 + bcount !
repeat
.tell bcount @ intostr " directions listed." strcat .tell
exit
then
"" " " subst bnew !
begin
bnew @ not if break then
bnew @ dup "," instr dup 0 = not if
1 - strcut 1 strcut bnew ! pop
else
"" bnew ! pop
then
loc @ "~x" getpropstr atoi tpx !
loc @ "~y" getpropstr atoi tpy !
loc @ "~z" getpropstr atoi tpz !
dup 1 strcut swap "!" stringcmp not if ( remove if present )
dup if
dup blocked @ swap ";" swap ";" strcat ";" swap strcat subst blocked !
tpx @ swap tpy @ swap tpz @ swap reflex-direction kill-block-direction
else pop then
else ( overwrite if there )
pop dup blocked @ swap ";" swap ";" strcat ";" swap strcat subst blocked !
dup ";" strcat blocked @ swap strcat blocked ! ( add in )
tpx @ swap tpy @ swap tpz @ swap reflex-direction add-block-direction
then
repeat
"@tf;" blocked @ strcat ";" ";;" subst blocked !
bexit @ #-1 dbcmp not if ( set name on existing exit )
"@tf;" blocked @ stringcmp not if ( none left... delete. )
bexit @ recycle "Done." .tell exit
then
bexit @ blocked @ setname
else ( create new exit )
loc @ blocked @ newexit dup #-1 dbcmp if
"ERROR CREATING BLOCK EXIT! Notify a wizard immediately." .tell
else
"me&!me" setlockstr
then
then
"Done." .tell
exit
;
lvar toroom
lvar exitout
lvar exitin
: do-tlink ( s -- )
PERMISSION-CHECK
loc @ "_reg/tmove" envpropstr dup not if
"Permission denied; TerraForm has not been installed on this system." .tell
pop exit
then
"" "#" subst atoi dbref tmove ! pop
loc @ "~x" getpropstr not if
"Permission denied; You need to be in a TerraForm-generated room." .tell
exit
then
"Enter the dbref of the destination room:" GET-DATA strip
"" "#" subst atoi dbref toroom !
toroom @ room? not if
"Permission denied; the destination is not a room." .tell exit
then
toroom @ "l" flag? not me @ "w" flag? not and me @ toroom @ owner dbcmp not
and if
"Permission denied; that room is not set linkable." .tell exit
then
"Enter the name(s) of the exit from here to " toroom @ name strcat ":" strcat
GET-DATA loc @ swap newexit dup int 0 > not if
"Aborted; exit creation failed." .tell exit
then
exitout !
( determine how to link the exit... special case if terraform room )
toroom @ "@/env" getpropstr dup not if ( just a normal room )
pop exitout @ toroom @ setlink
else ( destination is a terraform room )
exitout @ "@/env" toroom @ "@/env" getpropstr 0 addprop
exitout @ "@/x" toroom @ "~x" getpropstr 0 addprop
exitout @ "@/y" toroom @ "~y" getpropstr 0 addprop
exitout @ "@/z" toroom @ "~z" getpropstr 0 addprop
exitout @ tmove @ setlink
exitout @ location "~x" getpropstr if
exitout @ location ".noflush" "p" 0 addprop
"This room is automatically being set @FLUSH NO so the TerraForm exit will not be destroyed." .tell
then
then
"Enter the name(s) of the exit from " toroom @ name strcat " to here:" strcat
GET-DATA toroom @ swap newexit dup int 0 > not if
exitout @ recycle
"Aborted; exit creation failed." .tell exit
then
exitin !
( determine how to link the exit... special case if terraform room )
loc @ "@/env" getpropstr dup not if ( just a normal room )
pop exitin @ loc @ setlink
else ( source is a terraform room ) (this path is always taken)
exitin @ "@/env" loc @ "@/env" getpropstr 0 addprop
exitin @ "@/x" loc @ "~x" getpropstr 0 addprop
exitin @ "@/y" loc @ "~y" getpropstr 0 addprop
exitin @ "@/z" loc @ "~z" getpropstr 0 addprop
exitin @ tmove @ setlink
exitin @ location "~x" getpropstr if
exitin @ location ".noflush" "p" 0 addprop
"The destination room is automatically being set @FLUSH NO so the TerraForm exit will not be destroyed." .tell
then
then
" " .tell "Done." .tell
exit
;
lvar inside
: do-inside ( s -- ) (@inside [yes|no])
PERMISSION-CHECK
loc @ "_reg/tmove" envpropstr dup not if
"Permission denied; TerraForm has not been installed on this system." .tell
pop exit
then
"" "#" subst atoi dbref tmove !
loc @ "~x" getpropstr not if
"Permission denied; You need to be in a TerraForm-generated room." .tell
exit
then
loc @ ".inside" getpropstr inside !
pop dup not if ( just checking )
"This room is currently " inside @ not if "NOT " strcat then
"marked as 'inside'." strcat .tell
exit
then
dup "no" stringcmp not if
loc @ ".inside" remove_prop
loc @ ".noflush" getpropstr "y" stringcmp if
"This room is NOT marked as 'inside' but is still 'no flush'." .tell
else
"This room is NOT marked as 'inside' and will be flushed when empty."
.tell
then
exit
then
dup "yes" stringcmp not if
loc @ ".inside" "y" 0 addprop
loc @ ".noflush" getpropstr not if
loc @ ".noflush" "y" 0 addprop
then
"This room is marked as 'inside' as well as 'no flush'." .tell
exit
then
"Unknown @inside command \"" swap strcat "\"." strcat .tell
;
: do-own ( s -- ) (@own)
PERMISSION-CHECK
loc @ "~x" getpropstr not if
"Permission denied; this is only for TerraForm-generated rooms." .tell
exit
then
loc @ me @ setown
"You now own this room." .tell
;
: do-flush ( s -- ) (@flush [yes|no])
PERMISSION-CHECK
loc @ "~x" getpropstr not if
"Permission denied; this is not a TerraForm-generated room." .tell exit
then
loc @ ".noflush" getpropstr "p" stringcmp not if
loc @ ".noflush" "y" 0 addprop (remove protected status temporarily)
then
loc @ exits ( update protected status )
begin
dup #-1 dbcmp if break then
dup "@/env" getpropstr if
loc @ ".noflush" "p" 0 addprop
then
next
repeat pop
dup not if
pop "This room will " loc @ ".noflush" getpropstr not if
"be flushed from the system when empty." strcat .tell
else
"NOT be be flushed from the system when empty." strcat .tell
loc @ ".noflush" getpropstr "p" stringcmp not if
"(It is locked as @FLUSH NO because of special TerraForm exits.)" .tell
then
then
exit
then
dup "clear" stringcmp not if
"WARNING: This operation will destroy any existing TerraForm exits here and clear 'inside' status if present. Proceed? (NO/yes)" GET-DATA "yes" stringcmp if
"Aborted." .tell exit
then
loc @ exits ( destroy any terraform exits )
begin
dup #-1 dbcmp if break then
dup "@/env" getpropstr if
dup "Exit '" swap name strcat "' has been destroyed." strcat .tell
recycle loc @ exits
else
next
then
repeat
loc @ ".inside" remove_prop
pop loc @ ".noflush" remove_prop
"This room will be flushed when empty." .tell
exit
then
dup "yes" stringcmp not if
loc @ ".noflush" getpropstr "p" stringcmp not if
"Permission denied; This room's @FLUSH NO status is locked because of the presence of TerraForm exits. @FLUSH CLEAR to override." .tell
exit
then
pop loc @ ".noflush" remove_prop
"This room will be flushed when empty." .tell
exit
then
dup "no" stringcmp not if
pop loc @ ".noflush" "1" 0 addprop
"This room will NOT be flushed when empty." .tell
exit
then
exit
;
lvar etchar
: do-editterrain ( s -- )
PERMISSION-CHECK
loc @ "./map#" getpropstr dup primary ! not if
pop
"Permission denied; this room is not a TerraForm map room. Use @EDITMAP."
.tell exit
then
loc @ "./terrains" getpropstr dup if
"Permission denied; this room is using terrain library #" swap strcat
". (@editmap to change that)" strcat .tell
exit
else
pop
then
dup not if ( list stats of all terrains here? )
"USAGE: @EDITTERRAIN <map token letter>" .tell exit
then
dup "!" stringcmp not if ( special case... set fail and ofail for blocked )
loc @ "./!/fail" getpropstr tmp !
"Enter the FAIL message for when the player runs into blocked terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap "./!/fail" swap 0 addprop
else pop then
loc @ "./!/ofail" getpropstr tmp !
"Enter the OFAIL message for when the player runs into blocked terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap "./!/ofail" swap 0 addprop
else pop then
"Done." .tell
exit
then
tolower etchar !
etchar @ strlen 1 = not if
"ERROR: The map token must be one character and refers to one on the map."
.tell exit
then
"./" etchar @ strcat "/" strcat etchar !
loc @ etchar @ "name" strcat getpropstr tmp !
"Enter the name prototype for this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "name" strcat swap 0 addprop
else pop then
loc @ etchar @ "desc" strcat getpropstr tmp !
"Enter the description prototype for this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "desc" strcat swap 0 addprop
else pop then
loc @ etchar @ "verb" strcat getpropstr tmp !
"Enter the verb the player sees when moving in this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "verb" strcat swap 0 addprop
else pop then
loc @ etchar @ "overb" strcat getpropstr tmp !
"Enter the verb OTHERS see when someone moves in this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "overb" strcat swap 0 addprop
else pop then
loc @ etchar @ "minz" strcat getpropstr atoi dup 0 < if 0 swap - then
intostr tmp !
"Enter the depth of this terrain (0 = solid ground):"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
atoi dup not if
loc @ etchar @ "minz" strcat remove_prop "Done." .tell exit
then
dup 0 > if 0 swap - then intostr
loc @ swap etchar @ "minz" strcat swap 0 addprop
else pop then
loc @ etchar @ "minz" strcat getpropstr atoi if
loc @ etchar @ "undername" strcat getpropstr tmp !
"Enter the name prototype for rooms UNDER this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "undername" strcat swap 0 addprop
else pop then
loc @ etchar @ "underdesc" strcat getpropstr tmp !
"Enter the description prototype for rooms UNDER this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "underdesc" strcat swap 0 addprop
else pop then
loc @ etchar @ "underverb" strcat getpropstr tmp !
"Enter the verb the player sees when moving UNDER this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "underverb" strcat swap 0 addprop
else pop then
loc @ etchar @ "underoverb" strcat getpropstr tmp !
"Enter the verb OTHERS see when someone moves UNDER this terrain :"
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
loc @ swap etchar @ "underoverb" strcat swap 0 addprop
else pop then
loc @ etchar @ "underprop" strcat getpropstr tmp !
"What player prop shall I check to allow movement under? (0 = none) "
tmp @ if "(currently " tmp @ ", . = no change)" strcat strcat strcat then
GET-DATA striplead striptail dup "." stringcmp if
dup not if "Aborted." .tell exit then
dup "0" stringcmp not if
"Anybody can go under in this terrain." .tell
loc @ etchar @ "underprop" strcat remove_prop
else
loc @ swap etchar @ "underprop" strcat swap 0 addprop
then
then
then
" " .tell "Done." .tell
exit
;
lvar emcount
lvar emcount2
lvar insertit
lvar temp
lvar x1
lvar y1
lvar x2
lvar y2
lvar comment
: do-admin ( s -- ) (@ADMIN [<name>|!<name>])
PERMISSION-CHECK
loc @ owner me @ dbcmp not if
"Permission denied; you must own the map room to execute this command."
.tell exit
then
loc @ "./map#" getpropstr not if
"Permission denied; the room must be a map room." .tell exit
then
dup not if (no parameters... just checking)
"Local admins:"
loc @ "@/admins" getpropstr dup not if
pop "{None}"
else
" " "|" subst strip
" " explode "" temp !
begin
dup not if break then
swap atoi dbref dup player? if
name temp @ " " strcat swap strcat temp !
else
pop
then
1 -
repeat
pop temp @
then
strcat .tell
exit
then
comment !
comment @ 1 strcut swap "!" stringcmp not if ( delete )
dup temp !
.pmatch dup comment ! int 0 > not if
"Permission denied; " temp @ strcat " is not a known player."
strcat .tell exit
then
comment @ intostr comment !
loc @ "@/admins" getpropstr "|" "|" comment @ strcat "|" strcat subst
loc @ swap "@/admins" swap dup "|" stringcmp not if
pop remove_prop
else
0 addprop
then
"Removed " comment @ atoi dbref name strcat " from the local admin list."
strcat .tell
exit
else
pop
then
comment @ temp !
comment @ .pmatch dup comment ! int 0 > not if
"Permission denied; " temp @ strcat " is not a known player."
strcat .tell exit
then
comment @ intostr comment !
loc @ "@/admins" getpropstr "|" "|" comment @ strcat "|" strcat subst
dup not if
"|" comment @ strcat "|" strcat
else
comment @ strcat "|" strcat
then
loc @ swap "@/admins" swap 0 addprop
"Added " comment @ atoi dbref name strcat " to the local admin list."
strcat .tell
exit
;
: do-skylink ( s -- )
PERMISSION-CHECK
loc @ "@/env" getpropstr if ( we must have the primary map room )
"Permission denied. You must be in the primary map room." .tell
exit
then
0 comment !
begin
comment @ if break then ( done )
( present list of skylinks and options to add or remove )
" " .tell
"TerraForm skylink editor" .tell " " .tell
"# Sky region (x,y->x,y) Destination world" .tell
"------------------------------------------------" .tell
1 emcount !
begin
emcount @ loc @ "./skymaps#" getpropstr atoi > if break then
loc @ "./skymaps#/" emcount @ intostr strcat getpropstr
dup " " rinstr 1 - strcut 1 strcut swap pop atoi dbref primary !
emcount @ intostr ". " strcat temp !
"," " " subst dup strlen dup 25 < if
" " swap strcut swap pop strcat temp @ swap
strcat temp !
else
pop temp @ swap strcat temp !
then
temp @ primary @ name strcat "(#" strcat primary @ intostr strcat
")" strcat .tell
emcount @ 1 + emcount !
repeat
"Enter # of link to edit or A to add one, D to delete one, or Q to quit."
GET-DATA
dup 1 strcut pop "Q" stringcmp not if ( quit )
"Done." .tell exit
then
dup 1 strcut pop "D" stringcmp not if ( delete )
loc @ "./skymaps#" getpropstr atoi not if
"There are no sky links to delete." .tell continue
then
pop "Enter the link number to delete." GET-DATA
atoi dup 1 < if
"Error: link number must be greater than 0." .tell continue
then
dup emcount @ > if
"Error: link number must be less than " emcount @ 1 + intostr strcat
"." strcat .tell continue
then
emcount2 !
begin
emcount2 @ emcount @ < not if break then
loc @ "./skymaps#/" emcount2 @ intostr strcat
loc @ "./skymaps#/" emcount2 @ 1 + intostr strcat getpropstr
0 addprop
emcount2 @ 1 + emcount2 !
repeat
loc @ "./skymaps#/" emcount @ 1 - intostr strcat remove_prop
loc @ "./skymaps#"
loc @ "./skymaps#" getpropstr atoi 1 - dup if
intostr 0 addprop
else
pop remove_prop
then
continue
then
dup 1 strcut pop "A" stringcmp not if ( add )
pop "Enter the link number to add a link AFTER (0 to be the first)."
GET-DATA
atoi dup 0 < if
"Error: link number must be greater than or equal to 0." .tell continue
then
dup loc @ "./skymaps#" getpropstr atoi > if
"Error: link number must be less than " emcount @ intostr strcat
"." strcat .tell continue
then
1 insertit !
1 + emcount2 !
0 0 0 0 0 x1 ! y1 ! x2 ! y2 ! primary !
else dup number? if ( edit existing entry )
loc @ "./skymaps#" getpropstr atoi not if
"There are no sky links to edit." .tell continue
then
atoi dup 1 < if
"Error: link number must be greater than 0." .tell continue
then
dup emcount @ < not if
"Error: link number must be less than " emcount @ intostr strcat
"." strcat .tell continue
then
0 insertit !
emcount2 !
loc @ "./skymaps#/" emcount2 @ intostr strcat getpropstr strip
" " explode pop atoi x1 ! atoi y1 ! atoi x2 ! atoi y2 ! atoi primary !
else
pop "Error: Not a valid option." .tell continue
then then
"What is the X value of the WEST edge of this link? (1-"
loc @ "./maxx" getpropstr strcat
x1 @ if ", currently " strcat x1 @ intostr strcat then ")" strcat GET-DATA
atoi x1 ! x1 @ 1 < x1 @ loc @ "./maxx" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the X value of the EAST edge of this link? (" x1 @ intostr
strcat "-" strcat loc @ "./maxx" getpropstr strcat
x2 @ if ", currently " strcat x2 @ intostr strcat then ")" strcat GET-DATA
atoi x2 ! x2 @ x1 @ < x2 @ loc @ "./maxx" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the Y value of the NORTH edge of this link? (1-"
loc @ "./maxy" getpropstr strcat
y1 @ if ", currently " strcat y1 @ intostr strcat then ")" strcat GET-DATA
atoi y1 ! y1 @ 1 < y1 @ loc @ "./maxy" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the Y value of the SOUTH edge of this link? (" y1 @ intostr strcat
"-" strcat loc @ "./maxy" getpropstr strcat
y2 @ if ", currently " strcat y2 @ intostr strcat then ")" strcat GET-DATA
atoi y2 ! y2 @ y1 @ < y2 @ loc @ "./maxy" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"Enter the dbref of the primary map room of the destination world. "
primary @ dup if
"(currently #" swap intostr strcat ")" strcat strcat
else
pop
then
GET-DATA "" "#" subst
atoi dbref dup room? not if
"Error: Not a valid room. Aborting." .tell exit
then
dup "./maps#" getpropstr not if
"Error: Not a valid TerraForm primary map room. Aborting." .tell exit
then
primary !
preempt
insertit @ if ( ripple existing entries down )
emcount @ 1 + temp !
begin
temp @ emcount2 @ > not if break then
loc @ "./skymaps#/" temp @ intostr strcat
loc @ "./skymaps#/" temp @ 1 - intostr strcat getpropstr
0 addprop
temp @ 1 - temp !
repeat
loc @ "./skymaps#" loc @ "./skymaps#" getpropstr atoi 1 + intostr
0 addprop
then
loc @ "./skymaps#/" emcount2 @ intostr strcat ( compose link, add )
x1 @ intostr " " strcat y1 @ intostr strcat " " strcat
x2 @ intostr strcat " " strcat y2 @ intostr strcat " " strcat
primary @ intostr strcat
0 addprop
"Link added." .tell
repeat
" " .tell "Done." .tell
exit
;
: do-editmap ( s -- )
loc @ "@/env" getpropstr not if (if this is a new map room, help a little)
loc @ location "@/env" getpropstr dup if
loc @ swap "@/env" swap 0 addprop
else
pop
then
then
PERMISSION-CHECK
loc @ "@/env" getpropstr dup not if
pop loc @ location "@/env" getpropstr dup if
atoi dbref primary !
else pop loc @ location "./maxx" getpropstr if
loc @ location primary !
else loc @ "./maxx" getpropstr if
loc @ primary !
else
"Permission denied; this room or its parent are not TerraForm map rooms."
.tell "Use @INITWORLD to create a new planet." .tell exit
then then then
loc @ "./maxx" getpropstr not if
loc @ "@/env" primary @ intostr 0 addprop
then
else
atoi dbref primary !
then
loc @ "./map#" getpropstr atoi tmp !
tmp @ not if
"Creating a new map." .tell 0
else
1 emcount !
begin
emcount @ tmp @ > if break then
loc @ "./map#/" emcount @ intostr strcat getpropstr
emcount @ 1 + emcount !
repeat
tmp @
then
EDITOR "end" stringcmp if (abort of user opted out )
"Aborted." .tell exit
then
tmp @ emcount ! ( erase old map )
begin
emcount @ not if break then
loc @ "./map#/" emcount @ intostr strcat remove_prop
emcount @ 1 - emcount !
repeat
dup tmp ! emcount ! ( load new map )
begin
tmp @ 0 = if break then
loc @ swap "./map#/" tmp @ intostr strcat swap 0 addprop
tmp @ 1 - tmp !
repeat
loc @ "./map#" emcount @ intostr 0 addprop (store line count)
" " .tell
loc @ "./map#/" emcount @ intostr strcat getpropstr strlen tmp !
emcount @ 1 - emcount ! ( perform a validity check on strlens )
begin
emcount @ not if break then
loc @ "./map#/" emcount @ intostr strcat getpropstr strlen tmp @ = not if
"WARNING: Not all lines of the map are the same length; I hope this is OK."
.tell break
then
emcount @ 1 - emcount !
repeat
primary @ "./maps#" getpropstr atoi emcount ! (add to map list of maps)
0 tmp ! (set flag: not found in list)
0 0 0 0 x1 ! y1 ! x2 ! y2 ! ": " loc @ name strcat comment !
begin
emcount @ not if break then
primary @ "./maps#/" emcount @ intostr strcat getpropstr
dup ":" instr 1 - strcut comment ! striptail dup " " rinstr strcut
atoi loc @ int = if (found it!)
emcount @ tmp !
striptail dup " " rinstr strcut atoi y2 !
striptail dup " " rinstr strcut atoi x2 !
striptail dup " " rinstr strcut atoi y1 !
atoi x1 ! break
then
emcount @ 1 - emcount !
repeat
"What is the X value of the WEST edge of this map? (1-"
primary @ "./maxx" getpropstr strcat
x1 @ if ", currently " strcat x1 @ intostr strcat then ")" strcat GET-DATA
atoi x1 ! x1 @ 1 < x1 @ primary @ "./maxx" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the X value of the EAST edge of this map? (" x1 @ intostr strcat "-"
strcat primary @ "./maxx" getpropstr strcat
x2 @ if ", currently " strcat x2 @ intostr strcat then ")" strcat GET-DATA
atoi x2 ! x2 @ x1 @ < x2 @ primary @ "./maxx" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the Y value of the NORTH edge of this map? (1-"
primary @ "./maxy" getpropstr strcat
y1 @ if ", currently " strcat y1 @ intostr strcat then ")" strcat GET-DATA
atoi y1 ! y1 @ 1 < y1 @ primary @ "./maxy" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
"What is the Y value of the SOUTH edge of this map? (" y1 @ intostr strcat
"-" strcat primary @ "./maxy" getpropstr strcat
y2 @ if ", currently " strcat y2 @ intostr strcat then ")" strcat GET-DATA
atoi y2 ! y2 @ y1 @ < y2 @ primary @ "./maxy" getpropstr atoi > or if
"ERROR: Bad value. Aborting." .tell exit
then
comment @ comment @ ":" instr strcut striplead striptail comment !
"Enter comment for this map's list entry, currently : " comment @ not if
"(none)"
else
comment @
then
strcat GET-DATA "" ":" subst
striplead striptail dup not if pop loc @ name then comment !
x1 @ intostr " " strcat y1 @ intostr strcat " " strcat
x2 @ intostr strcat " " strcat y2 @ intostr strcat " " strcat loc @ intostr
strcat " : " strcat comment @ strcat comment !
tmp @ not if ( add new map line )
primary @ "./maps#" getpropstr atoi 1 + emcount !
primary @ "./maps#" emcount @ intostr 0 addprop
primary @ "./maps#/" emcount @ intostr strcat comment @ 0 addprop
else (modify old)
primary @ "./maps#/" tmp @ intostr strcat comment @ 0 addprop
then
"Enter the dbref of the terrain library to use or 0 to have local definitions. "
loc @ "./terrains" getpropstr dup if
"(currently #" swap strcat ")" strcat strcat
then
GET-DATA "" "#" subst
dup atoi 1 < if
loc @ "./terrains" remove_prop
else
loc @ swap "./terrains" swap atoi intostr 0 addprop
then
" " .tell "Done." .tell
exit
;
lvar charsfound
lvar charsnotfound
lvar lines
lvar columns
lvar terrains
lvar xprop
lvar yprop
lvar zprop
$define SANITY-ADD-BAD-ROOM
loc @ "@/tftmp#" loc @ "@/tftmp#" getpropstr atoi 1 + intostr 0 addprop
loc @ "@/tftmp#/" loc @ "@/tftmp#" getpropstr strcat
zprop @ 8 strcut swap pop 0 addprop
$enddef
$define SANITY-ADD-BAD-OCCUPANT
loc @ "@/tftmp#" loc @ "@/tftmp#" getpropstr atoi 1 + intostr 0 addprop
loc @ "@/tftmp#/" loc @ "@/tftmp#" getpropstr strcat
xprop @ 12 strcut swap pop 0 addprop
$enddef
: do-sanity ( s -- )
PERMISSION-CHECK
loc @ "~x" getpropstr if
"Permission denied; you must be in a map room to run this." .tell
exit
then
preempt ( we do NOT want to be interrupted in here! )
loc @ "./maps#" getpropstr if
"Last version installed: " loc @ "@/tfversion" getpropstr dup not if
pop "1.04"
then
strcat .tell
"Current version : " VERSION strcat .tell " " .tell
loc @ "@/tfversion" getpropstr VERSION stringcmp if ( do updates )
"Updating command set..." .tell
trigger @ "@loc;@tport;@tlink;@inside;@block;@flush;@own;@editterrain;@editmap;@admin;@skylink;@initworld;@sanity;@killworld" setname
"Setting primary map room to use _depart..." .tell
loc @ "_depart" "$tmove" 0 addprop
loc @ "@/tfversion" VERSION 0 addprop ( update version number )
" " .tell
then
then
loc @ "./terrains" getpropstr dup if
atoi dbref terrains !
else
pop loc @ terrains !
then
loc @ "./map#" getpropstr atoi tmp !
tmp @ if ( scan through the whole map and see what characters there are )
"Now scanning the map..." .tell
"" charsfound ! 1 lines !
begin
lines @ tmp @ > if break then (no lines left)
loc @ "./map#/" lines @ intostr strcat getpropstr
begin
dup not if break then (nothing left in the line)
1 strcut swap
dup charsfound @ swap instr 0 > not if
charsfound @ strcat charsfound !
else
pop
then
repeat
lines @ 1 + lines !
repeat
charsfound @ strlen tmp !
"" charsnotfound !
charsfound @
begin
dup not if break then (nothing left in list)
1 strcut swap
dup terrains @ swap "./" swap strcat "/name" strcat getpropstr not if
charsnotfound @ strcat charsnotfound !
else
pop
then
repeat
charsnotfound @ if
"Of the " tmp @ intostr strcat " different characters in the map, "
strcat charsnotfound @ strlen intostr strcat
" were not found as defined terrains." strcat .tell
"MISSING TERRAINS FOR THESE CHARACTERS: \"" charsnotfound @ strcat
"\"" strcat .tell
terrains @ loc @ dbcmp not if
"(This map uses terrains from #" terrains @ intostr strcat ")." strcat
.tell
then
else
"All map characters have terrain definitions." .tell
then
" " .tell
then
loc @ "./maxx" getpropstr not if ( if not primary room, exit here. )
exit
then
( scan rooms propdir and make sure all rooms are valid, have no _depart prop )
"Scanning rooms to verify existence and clear _depart props..." .tell
0 tmp !
loc @ "@/rooms/" nextprop xprop !
begin
xprop @ not if break then
loc @ xprop @ "/" strcat nextprop yprop !
begin
yprop @ not if break then
loc @ yprop @ "/" strcat nextprop zprop !
begin
zprop @ not if break then
loc @ zprop @ getpropstr atoi dbref dup
ok? not if
pop SANITY-ADD-BAD-ROOM
else dup room? not if
pop SANITY-ADD-BAD-ROOM
else dup "~x" getpropstr not if
pop SANITY-ADD-BAD-ROOM
else
dup "_depart" getpropstr "$tmove" stringcmp not if
"_depart" remove_prop
else
pop
then
then then then
loc @ zprop @ nextprop zprop !
tmp @ 1 + tmp !
repeat
loc @ yprop @ nextprop yprop !
repeat
loc @ xprop @ nextprop xprop !
repeat
loc @ "@/tftmp#" getpropstr atoi dup if
dup tmp @ intostr " rooms scanned. " strcat swap intostr
" mis-marked room references were found. Correcting..." strcat strcat
.tell tmp !
begin
tmp @ not if break then
loc @ "@/rooms/" loc @ "@/tftmp#/" tmp @ intostr strcat getpropstr
strcat remove_prop
tmp @ 1 - tmp !
repeat
loc @ "@/tftmp#" remove_prop
else
"All " tmp @ intostr strcat " room references checked out ok." strcat .tell
then
" " .tell
( scan occupants propdir and make sure everybody's where it thinks they are )
"Scanning occupants to verify locations..." .tell
0 tmp ! 0 lines !
loc @ "@/occupants/" nextprop xprop !
begin
xprop @ not if break then
xprop @ 12 strcut atoi dbref columns ! pop
loc @ xprop @ getpropstr "/" "," subst "@/rooms/" swap strcat loc @
swap getpropstr dup not if ( that room doesn't really exist now )
SANITY-ADD-BAD-OCCUPANT
else atoi dbref columns @ location dbcmp not if ( move )
SANITY-ADD-BAD-OCCUPANT
then then
tmp @ 1 + tmp !
loc @ xprop @ nextprop xprop !
repeat
loc @ "@/tftmp#" getpropstr atoi dup if
dup tmp @ intostr " occupants scanned. " strcat swap intostr
" mis-marked occupants were found. Correcting..." strcat strcat
.tell tmp ! 0 lines !
begin
tmp @ not if break then
loc @ "@/occupants/" loc @ "@/tftmp#/" tmp @ intostr strcat getpropstr
strcat remove_prop
loc @ "@/tftmp#/" tmp @ intostr strcat getpropstr atoi dbref columns !
columns @ player? if ( see if player's in another place in this world )
columns @ location "@/env" getpropstr atoi dbref loc @ dbcmp
if ( in this world )
loc @ "@/occupants/" columns @ intostr strcat
columns @ location "~x" getpropstr "," strcat
columns @ location "~y" getpropstr strcat "," strcat
columns @ location "~z" getpropstr strcat
0 addprop
lines @ 1 + lines !
then
then
tmp @ 1 - tmp !
repeat
"Of the " loc @ "@/tftmp#" getpropstr strcat " bad occupants, " strcat
lines @ intostr strcat " were moved, and " strcat loc @ "@/tftmp#"
getpropstr atoi lines @ - intostr strcat " were removed from this world."
strcat .tell
loc @ "@/tftmp#" remove_prop
else
"All " tmp @ intostr strcat " occupant references checked out ok." strcat
.tell
then
" " .tell
"Done." .tell
exit
;
: do-killworld ( s -- )
HAS-PERMISSION
loc @ "./maps#" getpropstr not if
"Permission denied; you must be in the primary map room for this command."
.tell exit
then
"WARNING!!!" .tell
"THIS OPERATION WILL DESTROY THE _ENTIRE_ WORLD AND ALL ROOMS WITHIN IT."
.tell "PROCEED WITH @KILLWORLD? (NO/yes)" GET-DATA
1 strcut pop "y" stringcmp if
"Aborted." .tell exit
then
0 tmp !
loc @ "@/rooms/" nextprop xprop !
begin
xprop @ not if break then
loc @ xprop @ "/" strcat nextprop yprop !
begin
yprop @ not if break then
loc @ yprop @ "/" strcat nextprop zprop !
begin
zprop @ not if break then
loc @ zprop @ getpropstr atoi dbref dup
ok? not if ( not a valid object )
pop
else dup room? not if ( not a valid room )
pop
else dup "~x" getpropstr not if ( not a valid TERRAFORM room )
pop
else ( a valid terraform room. Nuke it. )
recycle
tmp @ 1 + tmp !
then then then
loc @ zprop @ nextprop zprop !
repeat
loc @ yprop @ nextprop yprop !
repeat
loc @ xprop @ nextprop xprop !
repeat
tmp @ intostr " rooms destroyed (submaprooms will not be destroyed)." strcat
.tell
loc @ "./maps#" remove_prop
loc @ "./map#" remove_prop
loc @ "./skymap#" remove_prop
loc @ "./skyname" remove_prop
loc @ "./skydesc" remove_prop
loc @ "./maxx" remove_prop
loc @ "./maxy" remove_prop
loc @ "./maxz" remove_prop
loc @ "@/rooms" remove_prop
loc @ "@/exits" remove_prop
loc @ "@/occupants" remove_prop
loc @ "@/tfversion" remove_prop
loc @ "./tportdests" remove_prop
loc @ "_depart" remove_prop
loc @ "~WARNING" remove_prop
"Relevant map properties destroyed." .tell
" " .tell "Done. This room can safely be @recycled now if necessary." .tell
exit
;
: do-initworld ( s -- )
me @ "w" flag? not me @ loc @ owner dbcmp not and if ( special perm check)
"Permission denied." .tell exit
then
loc @ location "./map#" getpropstr if (not the primary map room)
"Permission denied. This is not the primary map room." .tell exit
then
loc @ "./map#" getpropstr loc @ "@/env" getpropstr or if (already set up)
"Permission denied. This world has already been initialized." .tell exit
then
"TerraForm (C) 1994,5 by Triggur of Brazilian Dreams, pferd@netcom.com"
.tell " " .tell
"Enter the maximum X value (distance in rooms around the world):" GET-DATA
atoi tmp !
tmp @ 1 < if "Not a valid value. Initialization aborted." .tell exit then
loc @ "./maxx" tmp @ intostr 0 addprop
"Enter the maximum Y value (distance in rooms from pole to pole):" GET-DATA
atoi tmp !
tmp @ 1 < if "Not a valid value. Initialization aborted." .tell exit then
loc @ "./maxy" tmp @ intostr 0 addprop
"Enter the maximum Z value (height of atmosphere+space (0 = don't model this)):"
GET-DATA atoi tmp !
tmp @ 0 < if "Not a valid value. Initialization aborted." .tell exit then
tmp @ not if
"Atmosphere will not be modelled." .tell
loc @ "./maxz" remove_prop
else
loc @ "./maxz" tmp @ intostr 0 addprop
"What player prop shall I check to allow flight? (0 = none)" GET-DATA
tmp ! tmp @ "0" stringcmp not if
"Everybody will be allowed to fly." .tell
loc @ "./flyprop" remove_prop
else
loc @ "./flyprop" tmp @ 0 addprop
then
"I am now setting up 3 default levels of atmosphere (air, thin air, space)." .tell
"You can change these or add to them later (./sky* props)" .tell
loc @ "./maxz" getpropstr atoi tmp !
loc @ "./skymap#" "3" 0 addprop
loc @ "./skymap#/1" "1 " tmp @ 4 / intostr strcat 0 addprop
loc @ "./skymap#/2" tmp @ 4 / 1 + intostr " " strcat tmp @ 2 / intostr
strcat 0 addprop
loc @ "./skymap#/3" tmp @ 2 / 1 + intostr " " strcat tmp @ intostr strcat
0 addprop
loc @ "./skyname/1" "In the air" 0 addprop
loc @ "./skyname/2" "High in the air" 0 addprop
loc @ "./skyname/3" "In space" 0 addprop
loc @ "./skydesc/1" "You are flying over the planet." 0 addprop
loc @ "./skydesc/2" "You are flying very high over the planet through thin air." 0 addprop
loc @ "./skydesc/3" "You are floating in space above the planet." 0 addprop
then
"What is the number (no # sign) of the program to call for _listen (0 = none)?" GET-DATA
dup atoi if loc @ swap "./_listen" swap 0 addprop then
loc @ "~WARNING" "DO _NOT_ MODIFY _ANY_ TERRAFORM VALUES BY HAND UNLESS YOU ARE _SURE_ YOU KNOW WHAT YOU'RE DOING! ASK TRIGGUR IF YOU HAVE ANY DOUBTS!"
0 addprop
" " .tell
"I am now creating exits to manage the 8 ordinal directions" .tell
"(n/s/e/w/nw/ne/sw/se) plus up and down." .tell
tmove @ "" "#" subst atoi dbref tmove !
loc @ exits
begin
dup #-1 dbcmp if break then
dup name "n" stringcmp not if recycle loc @ exits continue then
dup name "s" stringcmp not if recycle loc @ exits continue then
dup name "e" stringcmp not if recycle loc @ exits continue then
dup name "w" stringcmp not if recycle loc @ exits continue then
dup name "nw" stringcmp not if recycle loc @ exits continue then
dup name "ne" stringcmp not if recycle loc @ exits continue then
dup name "sw" stringcmp not if recycle loc @ exits continue then
dup name "se" stringcmp not if recycle loc @ exits continue then
dup name "u" stringcmp not if recycle loc @ exits continue then
dup name "d" stringcmp not if recycle loc @ exits continue then
next
repeat
(create north exit)
loc @ "n" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "-1" 0 addprop
tmp @ "succ" "You %v north." 0 addprop
tmp @ "osucc" "%v north." 0 addprop
tmp @ "odrop" "%v from the south." 0 addprop
(create south exit)
loc @ "s" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "1" 0 addprop
tmp @ "succ" "You %v south." 0 addprop
tmp @ "osucc" "%v south." 0 addprop
tmp @ "odrop" "%v from the north." 0 addprop
(create east exit)
loc @ "e" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dx" "1" 0 addprop
tmp @ "succ" "You %v east." 0 addprop
tmp @ "osucc" "%v east." 0 addprop
tmp @ "odrop" "%v from the west." 0 addprop
(create west exit)
loc @ "w" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dx" "-1" 0 addprop
tmp @ "succ" "You %v west." 0 addprop
tmp @ "osucc" "%v west." 0 addprop
tmp @ "odrop" "%v from the east." 0 addprop
(create northwest exit)
loc @ "nw" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "-1" 0 addprop
tmp @ "@/dx" "-1" 0 addprop
tmp @ "succ" "You %v northwest." 0 addprop
tmp @ "osucc" "%v northwest." 0 addprop
tmp @ "odrop" "%v from the southeast." 0 addprop
(create northeast exit)
loc @ "ne" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "-1" 0 addprop
tmp @ "@/dx" "1" 0 addprop
tmp @ "succ" "You %v northeast." 0 addprop
tmp @ "osucc" "%v northeast." 0 addprop
tmp @ "odrop" "%v from the southwest." 0 addprop
(create southwest exit)
loc @ "sw" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "1" 0 addprop
tmp @ "@/dx" "-1" 0 addprop
tmp @ "succ" "You %v southwest." 0 addprop
tmp @ "osucc" "%v southwest." 0 addprop
tmp @ "odrop" "%v from the northeast." 0 addprop
(create southeast exit)
loc @ "se" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dy" "1" 0 addprop
tmp @ "@/dx" "1" 0 addprop
tmp @ "succ" "You %v southeast." 0 addprop
tmp @ "osucc" "%v southeast." 0 addprop
tmp @ "odrop" "%v from the northwest." 0 addprop
(create up exit)
loc @ "u" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dz" "1" 0 addprop
tmp @ "succ" "You %v up." 0 addprop
tmp @ "osucc" "%v up." 0 addprop
tmp @ "odrop" "%v up from below." 0 addprop
(create down exit)
loc @ "d" newexit tmp !
tmp @ loc @ owner setown
tmp @ tmove @ setlink
tmp @ "@/env" loc @ intostr 0 addprop
tmp @ "@/dz" "-1" 0 addprop
tmp @ "succ" "You %v down." 0 addprop
tmp @ "osucc" "%v down." 0 addprop
tmp @ "odrop" "%v down from above." 0 addprop
loc @ "You can't go that way." setfail
loc @ "./map#" "0" 0 addprop
loc @ "_depart" "$tmove" 0 addprop
loc @ "@/tfversion" VERSION 0 addprop
" " .tell
"Initialization complete. Now install the primary map." .tell
exit
;
lvar rectmp
( Mama mia this is one nasty function if misused! )
: recycle-map ( MapRoomDBRef -- )
rectmp !
begin
rectmp @ contents ( get the room's contents )
dup #-1 if break then
dup ( AAACK. NOT FINISHED YET. DO NOT CALL!!! )
repeat
pop
dup "type something to recycle " swap dup intostr strcat " " strcat name strcat .tell READ
recycle
exit
;
: do-recycle ( s -- )
strip tmp ! #-1 tpx !
tmp @ "here" stringcmp not if ( this location )
loc @ tpx !
else me @ tmp @ rmatch dup int -1 > if ( match by name in inventory )
tpx !
else loc @ tmp @ rmatch dup int -1 > if ( match by name in room )
tpx !
else
tmp @ 1 strcut swap "#" stringcmp not if
atoi dbref tpx !
then
then then then
tpx @ #-1 dbcmp if ( invalid )
"I don't see that here." .tell exit
then
tpx @ room? not if
tpx @ location loc @ dbcmp not tpx @ location me @ dbcmp not and if
"I don't see that here." .tell exit
then
then
tpx @ "@/env" getpropstr tpx @ "./map#" getpropstr or if ( terraform thing )
me @ "w" flag? not if
"You cannot recycle TerraForm-related things." .tell exit
then
tpx @ "~x" getpropstr if ( trying to recycle generated room )
tpx @ ".noflush" remove_prop
tpx @ exits
begin ( loop through and destroy all exits )
dup #-1 dbcmp if break then
recycle tpx @ exits
repeat
"All walls and exits have been removed, and this room will be flushed when empty."
.tell
then
tpx @ "./maps#" getpropstr if ( trying to recycle whole PLANET )
"WARNING! THIS OPERATION WILL RECYCLE THE ENTIRE PLANET! ARE YOU SURE? (NO/YES)"
GET-DATA "yes" stringcmp if "Aborted." .tell exit then
"UNDER CONSTRUCTION: This operation has not yet been written. If you want to recycle a lot of rooms, best make a script." .tell exit
loc @ 1 recycle-map "The whole planet has been destroyed." .tell exit
then
tpx @ "./map" getpropstr if ( trying to recycle a map room )
"WARNING! This operation will destroy this map room and all rooms that its owner owns that are descended from it. Any map rooms that it contains and all rooms with other owners will be re-parented to this room's parent. ARE YOU SURE? (NO/YES)"
GET-DATA "yes" stringcmp if "Aborted." .tell exit then
loc @ "@/env" getpropstr atoi dbref primary ! ( remove from maps list )
primary @ "./maps#" getpropstr atoi dup tpx ! tpz !
begin
tpx @ 0 = if break then
primary @ "./maps#/" tpx @ intostr strcat getpropstr
dup ":" rinstr 1 - strcut pop strip
dup " " rinstr strcut swap pop
atoi loc @ int = if ( found the entry )
tpx @ tpy ! ( compress list )
begin
tpy @ tpz @ = if break then
primary @ "./maps#/" tpy @ intostr strcat
primary @ "./maps#/" tpy @ 1 + intostr strcat getpropstr
0 addprop
tpy @ 1 + tpy !
repeat
primary @ "./maps#/" tpz @ intostr strcat remove_prop
primary @ "./maps#" tpz @ 1 - intostr 0 addprop
break
then
tpx @ 1 - tpx !
repeat
tpx @ 0 = if
"WARNING: For some reason, this map was not listed in the primary map room." .tell
then
"UNDER CONSTRUCTION: This operation has not yet been written. If you want to recycle a lot of rooms, best make a script." .tell exit
loc @ 0 recycle-map "The map room has been destroyed." .tell exit
then
else ( just an ordinary every day object )
tpx @ recycle
then
"Done." .tell
exit
;
: main ( s -- )
#0 "_reg/tmove" getpropstr dup not if
"Permission denied; TerraForm has not been installed on this system." .tell
pop exit
then
tmove !
command @ "@loc" stringcmp not if
do-loc exit
then
command @ "@tport" stringcmp not if
do-tport exit
then
command @ "@block" stringcmp not if
do-block exit
then
command @ "@tlink" stringcmp not if
do-tlink exit
then
command @ "@inside" stringcmp not if
do-inside exit
then
command @ "@flush" stringcmp not if
do-flush exit
then
command @ "@own" stringcmp not if
do-own exit
then
command @ "@editterrain" stringcmp not if
do-editterrain exit
then
command @ "@editmap" stringcmp not if
do-editmap exit
then
command @ "@admin" stringcmp not if
do-admin exit
then
command @ "@skylink" stringcmp not if
do-skylink exit
then
command @ "@initworld" stringcmp not if
do-initworld exit
then
command @ "@sanity" stringcmp not if
do-sanity exit
then
command @ "@killworld" stringcmp not if
do-killworld exit
then
command @ tolower "@r" 2 strncmp not if
do-recycle exit
then
"INSTALLATION ERROR: " command @ " does not match a known TerraForm command."
strcat strcat .tell
exit
;
.
c
q
"Done. TerraForm has now been upgraded on this MUCK.
"BE SURE TO READ THE INSTRUCTIONS ON HOW TO UPGRADE YOUR WORLDS!!!!!!!