"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!!!!!!!