@q
@program jmap.muf
1 99999 d
i
( jmap.muf    v1.0    Jessy @ FurryMUCK    9/00
 
  A utility for creating and displaying area maps.
  
  INSTALLATION:
  
  Set jmap.muf M3. Link a global action with a name such as 'map' or
  '+map' to the program. The program requires lib-lmgr, lib-editr,
  and lib-strings, all of which should be available on an established
  MUCK.
  
  USAGE:
 
  +map ..................... Display map of current area
  +map <map> ............... Display <map>
  +map #list ............... Display list of available maps
  +map #create ............. Create a map in current environment room
  +map #edit ............... Edit current map
  +map #remove ............. Remove current map
  +map #position ........... Set position of current room on map
 
  If your current location has an identified position on the map, the
  position will be shown as an 'X'. Maps for an area should be created
  in an environment room parenting the area. Once a map is created, it
  can be edited or removed from any room in the area. You must control
  the environment room in order to create, edit, or remove the map. You
  must control the current room in order to configure its position.
  Command options that require additional information will prompt for
  the information. You can talk and pose while at a map prompt, but
  cannot use other MUCK commands. #Option strings do not have to be
  typed in full: for example '+map #position' and '+map #p' will produce
  the same result.  
  
  jmap.muf may be freely ported. Please comment any changes.
)
 
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
 
$define Tell me @ swap notify $enddef
 
lvar ourBoolean                              (* int: flow control var *)
lvar ourCounter                           (* int or str: loop counter *)
lvar ourScratch                  (* int, dbref, or var: workspace var *)
lvar ourString                               (* string: workspace var *)
lvar maxColumns              (* int: number of columns on current map *)
lvar maxRows                    (* int: number of rows on current map *)
 
: DoPad  ( s i -- s' )                (* pad string s to i characters *)
  
  "                                                                    "
  rot swap strcat swap strcut pop
;
  
: DoEditLoop  ( listname dbref {rng} mask currline cmdstring  --  )
                                        (* read input for list editor *)
  EDITORloop
  dup "save" stringcmp not if
    pop pop pop pop
    3 pick 3 + -1 * rotate
    over 3 + -1 * rotate
    dup 5 + pick over 5 + pick 
    over over LMGR-DeleteList
    1 rot rot LMGR-PutRange
    4 pick 4 pick LMGR-GetList
    dup 3 + rotate over 3 + rotate
    ">>  List saved." Tell
    "" DoEditLoop exit
  then
  dup "abort" stringcmp not if
    ">>  List not saved." Tell
    pop pop pop pop pop pop pop pop pop exit
  then
  dup "end" stringcmp not if
    pop pop pop pop pop pop 
    dup 3 + rotate over 3 + rotate
    over over LMGR-DeleteList
    1 rot rot LMGR-PutRange
    ">>  List saved." Tell exit
  then
;
  
: DoEditList  ( d s --  )                         (* edit list s on d *)
  
  swap
">>  Welcome to the list editor. You can get help by entering '.h' on"
Tell
">>  a line by itself. '.end' will save and exit. '.abort' will abort"
Tell
">>  any changes. To save changes and continue editing, use '.save'."
Tell
  over over LMGR-GetList
  "save" 1 ".i $" DoEditLoop
;
  
: DoRemoveList  ( d s --  )                   (* remove list s from d *)
  
  "#" strcat ourString ! ourScratch !
  ourScratch @ ourString @ remove_prop
  ourString @ "/" strcat ourString !
  
  "1" ourCounter !
  begin                                   (* begin line-removing loop *)
    ourScratch @ ourString @ ourCounter @ strcat over over
    getpropstr while
    remove_prop
    ourCounter @ atoi 1 + intostr ourCounter !
  repeat                                    (* end line-removing loop *)
  pop pop
  
  ourScratch @ ourString @
  dup "*/" smatch if
    dup strlen 1 - strcut pop strip 
  then
  remove_prop
;
  
: DoShowList  ( d s --  )               (* display list s on object d *)
  
  "#/" strcat swap LMGR-GetList
  begin                                    (* begin line-listing loop *)
    dup while
    dup 1 + rotate Tell
    1 -
  repeat                                     (* end line-listing loop *)
  pop
;
 
: DoReadLine  (  -- s )  
 
    (* read keyboard input; emit poses|says and continue, else return *)
  
  begin                                  (* begin input-scanning loop *)
    read           (* does input begin with 'say ' or " ?  Emit if so *)
    dup "\"" stringpfx if
      1 strcut swap pop
      me @ name " says, \"" strcat
      swap strcat "\"" strcat
      loc @ swap 0 swap notify_exclude
      continue
    then
    
    dup "say " stringpfx if
      4 strcut swap pop
      me @ name " says, \"" strcat
      swap strcat "\"" strcat
      loc @ swap 0 swap notify_exclude
      continue
    then
                 (* does input begin with 'pose ' or : ?  Emit if so *)
    dup ":" stringpfx if
      1 strcut swap pop
      me @ name  " " strcat swap strcat
      loc @ swap 0 swap notify_exclude
      continue
    then
    
    dup "pose " stringpfx if
      5 strcut swap pop
      me @ name " " strcat swap strcat
      loc @ swap 0 swap notify_exclude
      continue
    then
           (* continue for strings of all spaces; i.e., treat as null *)
    dup strip not if
      pop continue
    then
    
    break                   (* it's not a pose or say; break and exit *)
  repeat
;
 
: QCheck  (  -- i )(* wrap smatch for .q in an if, to avoid null string
                      match error if user enters a string of all spaces,
                      which DoReadLine would strip to a null string   *)
  dup if
    dup ".quit" swap stringpfx 
    over ".end" swap stringpfx or if
      pop ">>  Done." Tell pid kill
    then
  then
;
 
: DoReadYesNo  (  -- i )  
 
  (* read from keyboard; accept only vars of yes|no; return 1 for yes *)
  begin                                  (* begin input-scanning loop *)
    DoReadLine
    QCheck
    "yes" over stringpfx if
      pop 1 break
    then
    "no" over stringpfx if
      pop 0 break
    then
    pop
    ">>  Please enter 'Yes' or 'No'." Tell 
  repeat                                   (* end input-scanning loop *)
;
 
: DoHelp  (  --  )                             (* display help screen *)
  
  " " 
  prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
  
  "A utility for creating and displaying area maps." Tell " " Tell
  
  "  $com ..................... Display map of current area"
  command @ "$com" subst Tell
  "  $com <map> ............... Display <map>"
  command @ "$com" subst Tell
  "  $com #list ............... Display list of available maps"
  command @ "$com" subst Tell
  "  $com #create ............. Create a map in current environment room"
  command @ "$com" subst Tell
  "  $com #edit ............... Edit current map"
  command @ "$com" subst Tell
  "  $com #remove ............. Remove current map"
  command @ "$com" subst Tell
  "  $com #position ........... Set position of current room on map"
  command @ "$com" subst Tell " " Tell
  
  "If your current location has an identified position on the map, the "
  "position will be shown as an 'X'. Maps for an area should be created "
  "in an environment room parenting the area. Once a map is created, it "
  "can be edited or removed from any room in the area. You must control "
  "the environment room in order to create, edit, or remove the map. You "
  "must control the current room in order to configure its position. "
  "Command options that require additional information will prompt for the "
  "information. You can talk and pose while at a map prompt, but cannot "
  "use other MUCK commands. #Option strings do not have to be typed in "
  "full: for example '$com #position' and '$com #p' will produce the same "
  "result."
  strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat
  command @ "$com" subst Tell
;
 
: DoGetMapName  (  -- s )      (* return name of map for current area *)
  
  loc @ "_map#" envpropstr if
    #0 "_maps/" rot intostr strcat getpropstr
  else
    pop ""
  then
;
 
: DoDisplayMap  (  --  )               (* display map of current room *)
         (* replace char at current position, if configured, with 'X' *)
  
  ourScratch @ not if                       (* get map room if needed *)
    loc @ "_map#" envpropstr if
      ourScratch !
    else
      ">>  You are in an unmapped area." Tell exit
    then
  then
                                    (* verify that we have a map room *)
  ourScratch @ not if
    ">>  Map not found." Tell exit
  then
                             (* verify that map room really has a map *)
  ourScratch @ "_map#/" nextprop not if
    ">>  Map not found." Tell exit
  then
  
   (* if current room has a position on current map, set ourBool true *)
  0 ourBoolean !
  loc @ "_map#" envpropstr pop dup if
    ourScratch @ dbcmp if
      1
    else
      0
    then
  then
  loc @ "_mapy" getpropstr and
  loc @ "_mapx" getpropstr and if 1 ourBoolean ! then
  
  ourScratch @ "_map#/" "1" ourCounter !
  begin                                   (* begin emitting map lines *)
    over over ourCounter @ strcat getpropstr dup while
    ourBoolean @ if               (* show position as X if applicable *)
      loc @ "_mapy" getpropstr ourCounter @ smatch if
        loc @ "_mapx" getpropstr atoi strcut
        swap dup strlen 1 - strcut pop
        "X" strcat swap strcat
      then
    then
    Tell
    ourCounter @ atoi 1 + intostr ourCounter !
  repeat                                    (* end line-emitting loop *)
  pop pop pop
;
 
: DoCreateMap  (  --  )        (* edit a new map list on current room *)
  
                                                  (* check permission *)
  me @ loc @ controls not if ">>  Permission denied." Tell exit then
  
  ">>  What is the name of this map?" Tell            (* get map name *)
  ">> [Enter map name, or .q to quit]" Tell
  DoReadLine strip QCheck 
  
  dup "@*" smatch if        (* make sure we're not setting a wiz prop *)
    ">>  Sorry, invalid map name." Tell exit
  then
  
  loc @ "_map" DoEditList                 (* create and edit map list *)
  
  loc @ "_map#/" nextprop if            (* record loc and name of map *)
    #0 "_maps/" loc @ intostr strcat rot setprop
  then
;
 
: DoEditMap  (  --  )                             (* edit current map *)
  
  loc @ "_map#" envpropstr if     (* check: do we have a current map? *)
                                  (* if so, check permission and edit *)
    me @ over controls not if ">>  Permission denied." Tell exit then
    "_map" DoEditList
  else
    pop DoCreateMap                    (* otherwise, create a new map *)
  then
;
 
: DoRemoveMap  (  --  )                 (* remove map of current area *)
  
  loc @ "_map#" envpropstr if     (* check: do we have a current map? *)
  
         (* if so, check permission, get confirmation, and delete map *)
    me @ over controls not if ">>  Permission denied." Tell exit then
    DoGetMapName dup if 
      ">>  Please confirm: You want to remove the $name map? (y/n)"
      swap "$name" subst 
    else
      ">>  Please confirm: You want to remove "
      "the map of the this area? (y/n)" strcat swap pop
    then
    Tell DoReadYesNo not if ">>  Aborted." Tell exit then
    dup "_map" DoRemoveList
    #0 "_maps/" rot intostr strcat remove_prop
    ">>  Map removed." Tell
  else                                     (* otherwise, notify no-go *)
    ">>  You are in an unmapped area. No map to remove." Tell pop
  then
;
 
: DoSetMapPos  (  --  )(* set position of current room on current map *)
  
                                                  (* check permission *)
  me @ loc @ controls not if ">>  Permission denied." Tell exit then
  
  loc @ "_map#" envpropstr if          (* if we have a current map... *)
    ourScratch ! 
    0 maxColumns ! (* loop through once, getting num rows and columns *)
    0 maxRows !
    ourScratch @ "_map#/" nextprop
    begin
      dup while
      ourScratch @ over getpropstr strlen 
      dup maxColumns @ > if
        maxColumns !
      else
        pop
      then
      maxRows @ 1 + maxRows !
      ourScratch @ swap nextprop
    repeat
    pop
                  (* display current map, with row and column indices *)
"   123456789012345678901234567890123456789012345678901234567890123456789012345678"
    maxColumns @ 3 + strcut pop
"   000000000111111111122222222223333333333444444444455555555556666666666777777777"
    maxColumns @ 3 + strcut pop
    Tell Tell " " Tell
    "1" ourCounter !
    begin
      ourScratch @ "_map#/" ourCounter @ strcat getpropstr
      dup while
      ourCounter @ 3 DoPad swap strcat Tell
      ourCounter @ atoi 1 + intostr ourCounter !
    repeat
    pop
    " " Tell
  
       (* prompt for row of current room; verify input; record as 'y' *)
    begin
      ">>  What is this room's row number on the map?" Tell
      ">> [Enter row number, or .q to quit]" Tell
      DoReadLine strip QCheck
      dup number? not if
        ">>  Sorry, that's not a number." Tell pop continue
      then
      dup atoi 0 <= if
        ">>  Invalid entry: the row number must be at least 1."
        Tell pop continue
      then
      dup atoi maxRows @ > if
        ">>  Invalid entry: there are only $num rows on the map."
        maxRows @ intostr "$num" subst Tell pop continue
      then
      loc @ "_mapy" rot setprop break
    repeat
      
       (* prompt for row of current room; verify input; record as 'x' *)
    begin
      ">>  What is this room's column number on the map?" Tell
      ">> [Enter column number, or .q to quit]" Tell
      DoReadLine strip QCheck
      dup number? not if
        ">>  Sorry, that's not a number." Tell pop continue
      then
      dup atoi 0 <= if
        ">>  Invalid entry: the column number must be at least 1."
        Tell pop continue
      then
      dup atoi maxColumns @ > if
        ">>  Invalid entry: there are only $num columns on the map."
        maxColumns @ intostr "$num" subst Tell pop continue
      then
      loc @ "_mapx" rot setprop break
    repeat
  
    ">>  Set." Tell                                (* notify and exit *)
  else
    ">>  Sorry, you're in an unmapped location." Tell
  then
;
 
: DoListMaps  (  --  )              (* display list of available maps *)
  
  #0 "_maps/" nextprop
  dup if
    ">>  Available maps:" Tell " " Tell
    begin
      dup while
      "    " #0 3 pick getpropstr
      1 strcut swap toupper swap strcat strcat Tell
      #0 swap nextprop
    repeat
    pop
    " " Tell
  else
    ">>  Sorry, no maps have been installed." Tell
  then
;    
 
: DoShowMap  (  --  )                     (* display a specified map *)
  
  ourString @ if    (* if map specified as cmd arg, find and display *)
    #0 "_maps/" nextprop
    begin
      dup while
      #0 over getpropstr ourString @ stringpfx if
        "" "_maps/" subst atoi dbref ourScratch !
        DoDisplayMap exit
      then
      #0 swap nextprop
    repeat
    ">>  Map '$name' not found."
    ourString @ "$name" subst Tell 
  
  else   (* if no map specifed, prompt for map name and then display *)
    DoListMaps
    begin
      ">>  Which map do you want to display?" Tell
      ">> [Enter map name, or .q quit]" Tell
      DoReadLine strip QCheck
      ourString !
      #0 "_maps/" nextprop
      begin
        dup while
        #0 over getpropstr ourString @ stringpfx if
          "" "_maps/" subst atoi dbref "_map" DoDisplayMap exit
        then
        #0 swap nextprop
      repeat
      ">>  Map '$name' not found."
      ourString @ "$name" subst Tell pop
    repeat
  then
;
  
: main
  
  dup if
    "#help"     over stringpfx if DoHelp      exit then
    "#position" over stringpfx if DoSetMapPos exit then
    "#create"   over stringpfx if DoCreateMap exit then
    "#remove"   over stringpfx if DoRemoveMap exit then
    "#edit"     over stringpfx if DoEditMap   exit then
    "#list"     over stringpfx if DoListMaps  exit then
    "#show"     over stringpfx if DoShowMap   exit then
    dup "#*" smatch if 
      ">>  #Option not understood." Tell exit
    else
      ourString ! DoShowMap
    then
  else
    DoDisplayMap
  then
;
.
c
q