@q
@program DescTools.muf
1 9999 d
i
( DescTools.muf    v1.3    Jessy @ FurryMUCK    9/96, 4/97
  
  A morphing program for storing and changing descs. Descs may have
  automatically set species and sex props associated with them. Users
  may also set an MPI string to be parsed when changing to specific
  descs.
  
  Installation:
  
  Create an action and link it to this program. DescTools.muf requires
  Mucker level 3 and the editor libraries lib-lmgr, lib-editor, and
  lib-strings, which should be available on any established MUCK, and
  lib-mucktools, which holds code shared by the MuckTools programs.
  The program uses no macros.
  
  The help screen uses the first alias of the command name in formatting
  output: name the action with the most common or intuitive alias first.
  Additional aliases are listed on the help screen.
  
  Use:
  
    <cmd> <string>      Wear desc <string>
    <cmd> #list         List your currently stored descs.
    <cmd> #add          Add a desc.
    <cmd> #edit         Edit a stored desc.
    <cmd> #delete       Delete a stored desc.
    <cmd> #format       Edit your look-notify formats.
    <cmd> #restore      Restore desc worn before using this program.
 
  Functions which require additional input will supply prompts. You may
  talk and pose while at a prompt line. The argument strings listed
  above need not be entered completely: typing the # octothorpe followed 
  by the first one or several characters will select the appropriate 
  function. DescTools data is stored in your '_descs/' directory.
 
  DescTools.muf may be freely ported. Please comment any changes.
)
  
$define Tell me @ swap notify $enddef
  
lvar ourString   (* These three variables are swapped around as needed,  *)
lvar ourBoolean  (* but in general ourString holds input from keyboard,  *)
lvar counter     (* counter controls loops, and ourBoolean does IF tests *)
    
(***************************lsedit functions******************************)
  
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
$include $lib/mucktools
 
$def LMGRgetcount lmgr-getcount
$def LMGRgetrange lmgr-getrange
$def LMGRputrange lmgr-putrange
$def LMGRdeleterange lmgr-deleterange
  
: LMGRdeletelist
    over over LMGRgetcount
    1 4 rotate 4 rotate LMGRdeleterange
;
  
: LMGRgetlist
    over over LMGRgetcount
    rot rot 1 rot rot
    LMGRgetrange
; 
  
: lsedit-loop            (* listname dbref {rng} mask currline cmdstr -- *)
    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 LMGRdeletelist
        1 rot rot LMGRputrange
        4 pick 4 pick LMGRgetlist
        dup 3 + rotate over 3 + rotate
        "< List saved. > .tell
        "" lsedit-loop 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 LMGRdeletelist
        1 rot rot LMGRputrange
        "< list saved. > .tell exit
    then
;
    
: ThisEditList  ( s --  )                       (* edit list s on player *)
    
    me @
                                                         (* enter editor *)
"<    Welcome to the list editor.  You can get help by entering '.h' >
    Tell
"< '.end' will exit and save the list.  '.abort' will abort any changes. >
    Tell
"<    To save changes to the list, and continue editing, use '.save' >
    Tell
    over over LMGRgetlist
    "save" 1 ".i $" lsedit-loop
;
   
(*************************Internal Functions******************************)
  
: ClearStack  (  --  )                   (* pop everything off the stack *)
    
    begin
        depth while pop
    repeat
;
  
: ListNames  (  -- s i )(* return trig aliases in comma-separeted string *)
                                          (* i is true if there are alia *)
   
           (* return null string and false if no addtional command names *)
   trig name ";" explode dup 1 = if
       pop "" 0 exit
       else
           counter !
   then
                                        (* make a string showing aliases *)
   "" ourBoolean !
   begin
       counter @ 1 = if
           pop break
       then
       swap ", " strcat ourBoolean @ swap strcat ourBoolean !
       counter @ 1 - counter !
   repeat
                                               (* return string and true *)
   ourBoolean @ dup strlen 2 - strcut pop 1
;
      
: DoInit  (  --  )                                (* set DescTools props *)
    
    me @ "_/de" getpropstr
    me @ "_descs/prefs/prev" getpropstr not and if
        me @ "_descs/prefs/prev"
        me @ "_/de" getpropstr 
        setprop
        ">>  Moving your current desc to prop '_descs/prefs/prev'." Tell
    then
    
    me @ "{my-desc}" setdesc
    
    me @ "_msgmacs/my-desc"
    "{if:{prop:_descs/{prop:_descs/prefs/current}#},"
    "{eval:{list:_descs/{prop:_descs/prefs/current}#}}"
    "{eval:{prop:_descs/prefs/lformat}}{eval:{prop:_descs/prefs/olformat}},"
    "{name:this} doesn't have a valid desc selected."
    "{null:{tell:[ {name:me} looked at you\\, but you don't have a valid "
    "desc selected. ],this}}}"
    strcat strcat strcat strcat strcat setprop
    
                              (* set a look-notify format if not present *)
    me @ "_descs/prefs/lformat" over over
    getpropstr not if
        "{null:{tell:[ {name:me} looked at you. ],this}}" setprop
        me @ me @ "_descs/prefs/olformat" "{null}" setprop
        else
            pop pop
    then
                              (* set a look-notify format if not present *)
    me @ "_descs/prefs/olformat" over over
    getpropstr not if
        "{null:{tell:[ {name:me} looked at you. ],this}}" setprop
        me @ me @ "_descs/prefs/olformat" 
        "{null:{tell:[ {name:this} sees you looking. ],me}}"  setprop
        else
            pop pop
    then
    
    me @ "_descs/prefs/ver" "1.3" setprop
;
  
: CheckInit  (  --  )                     (* initialize player if needed *)
   
    me @ "_descs/prefs/ver" getpropstr dup if
        "1.3" instr not if
            DoInit
        then
    then    
;  
  
: GrabADesc  (  --  )        (* set 'current' to first desc in directory, 
                                        or warn if user now has no descs *)
    
          (* find a desc list. ourBoolean stores true if a desc is found *)
    0 ourBoolean !
    me @ "_descs/" nextprop counter !
    begin
        counter @ while
        me @ counter @ "/1" strcat getpropstr if
  
                                              (* found one! set and exit *)
            1 ourBoolean !
            me @ "_descs/prefs/current"
            counter @ 7 strcut swap pop dup strlen 1 - strcut pop 
            dup ourString !
            setprop
            break
        then
        me @ counter @ nextprop counter !
    repeat
    
                                            (* no descs found; warn user *)
    ourBoolean @ not if
        ">>  Warning: You currently have no descs stored." Tell
        else
            ">>  Current desc is now invalid. Changing to your '"
            ourString @ strcat
            "' desc." strcat Tell
    then
;
  
: DescCheck  ( --  )               (* check: 'current' desc still valid? 
                                              grab and set a desc if not *)
    me @ "_descs/prefs/current" getpropstr dup not if
        pop GrabADesc
        else
        "_descs/" swap strcat "#/1" strcat me @ swap getpropstr not if
            GrabADesc
        then
    then 
;
  
: MiscProps  (  --  )       (* set additional props associated with desc *)
    
              (* see if user wants to reset species or sex for this desc *)
    begin
     ">>  Do you want to reset your species prop when changing to this desc?"
        Tell
        ">> [Enter 'yes', 'no', or .q to quit]" Tell
        SayPose strip
    
        dup ".quit" swap stringpfx if
             DescCheck exit
        then
        
        dup "yes" swap stringpfx if
            ">>  What species is associated with this desc?" Tell
            ">> [Enter species, or .q to quit]" Tell
            SayPose strip
            
            dup ".quit" swap stringpfx if
                DescCheck exit
            then
            
            me @ "_descs/" ourString @ strcat "/spec" strcat rot setprop
            ">>  Set." ClearStack break
        then
        
        "no" swap stringpfx if
            me @ "_descs/" ourString @ strcat "/spec" strcat remove_prop
            break
            else
                ">>  Command not understood." Tell continue
        then
    repeat 
            
    begin
        ">>  Do you want to reset your sex prop when changing to this desc?"
        Tell
        ">> [Enter 'yes', 'no', or .q to quit]" Tell
        SayPose strip
    
        dup ".quit" swap stringpfx if
             DescCheck exit
        then
        
        dup "yes" swap stringpfx if
            ">>  What sex is associated with this desc?" Tell
            ">> [Enter species, or .q to quit]" Tell
            SayPose strip
            
            dup ".quit" swap stringpfx if
                DescCheck Tell exit
            then
            
            me @ "_descs/" ourString @ strcat "/sex" strcat rot setprop
            ">>  Set." ClearStack break
        then
        
        "no" swap stringpfx if
            me @ "_descs/" ourString @ strcat "/sex" strcat remove_prop
            break
            else
                ">>  Command not understood." Tell continue
        then
    repeat 
    
     begin
        ">>  Do you want to run an MPI string when changing to this desc?"
        Tell
        ">> [Enter 'yes', 'no', or .q to quit]" Tell
        SayPose strip
    
        dup ".quit" swap stringpfx if
             DescCheck Tell exit
        then
        
        dup "yes" swap stringpfx if
            ">>  What MPI should be parsed when you change to this desc?"
             Tell
            ">> [Enter MPI string, or .q to quit]" Tell
            SayPose strip
            
            dup ".quit" swap stringpfx if
                DescCheck Tell exit
            then
            
            dup
            me @ "_descs/" ourString @ strcat "/mpi" strcat rot setprop
            ">>  Set to " Tell " " Tell
            "       " swap strcat Tell " " Tell
            break
        then
        
        "no" swap stringpfx if
            me @ "_descs/" ourString @ strcat "/mpi" strcat remove_prop
            break
            else
                ">>  Command not understood." Tell continue
        then
    repeat 
;
  
(*************************************************************************)
  
: DoHelp  ( s --  )                                  (* show help screen *)
    
    " " Tell "DescTools.muf, v1.3" 
    prog "L" flag? if
        " (program #" prog intostr strcat ")" strcat strcat
    then
    Tell " " Tell
    
    trig name MainName " <string>" 20 Pad "Wear desc <string>." 
    strcat strcat Tell
    trig name MainName " #list" 20 Pad "List your currently stored descs." 
    strcat strcat Tell
    trig name MainName " #add" 20 Pad "Add a desc." 
    strcat strcat Tell
    trig name MainName " #edit" 20 Pad "Edit a stored desc." 
    strcat strcat Tell
    trig name MainName " #delete" 20 Pad "Delete a stored desc." 
    strcat strcat Tell
    trig name MainName " #format" 20 Pad "Edit your look-notify formats." 
    strcat strcat Tell
    trig name MainName " #restore" 20 Pad "Restore desc worn before using this "
    "program." strcat strcat strcat Tell " " Tell
    ListNames if
        "Command aliases: " swap strcat Tell " " Tell
    then
    "Functions which require additional input will supply prompts. You may "
    "talk and pose while at a prompt line. The argument strings listed "
    "above need not be entered completely: typing the # octothorpe followed " 
    "by the first one or several characters will select the appropriate "
    "function. DescTools data is stored in your '_descs/' directory." 
    strcat strcat strcat strcat
    Tell " " Tell
;
  
: DoList  ( s --  )                         (* show list of stored descs *)
    
    pop CheckInit
    " " Tell "Currently stored descs:" Tell " " Tell
    me @ "_descs/" nextprop counter !
    begin
        counter @ while
        counter @ "*#" smatch if
            "  " counter @ 7 strcut swap pop 
            dup strlen 1 - strcut pop strcat
            Tell
        then
        me @ counter @ nextprop counter !
    repeat
    " " Tell 
;
  
: DoWear  ( s --  )  (* set prop '_descs/current' to user-specified desc *)
    
                                     (* check: have a desc by that name? *)
    pop CheckInit 
    me @ "_descs/" ourString @ strcat "#/1" strcat getpropstr not if
        ">>  You don't have a desc called '" 
        ourString @ strcat
        "'." strcat  Tell exit
    then
                                                               (* set it *)
    me @ "_descs/prefs/current" ourString @ setprop
    me @ "_descs/" ourString @ strcat "/spec" strcat getpropstr dup if
        me @ "species" rot setprop
        else
            pop
    then
    me @ "_descs/" ourString @ strcat "/sex" strcat getpropstr dup if
        me @ "sex" rot setprop
        else
            pop
    then
    me @ "_descs/" ourString @ strcat "/mpi" strcat getpropstr if
        me @ "_descs/" ourString @ strcat "/mpi" strcat ParseThis
    then
    
    ">>  You are now wearing your '" ourString @ strcat "' desc." strcat
    Tell
;
  
: DoAdd  ( s --  )           (* add a desc to user's '_descs/' directory *)
    
              (* check: does user have a non-DescTools desc? Store if so *)
    pop CheckInit
                                        (* set DescTools props if needed *)
    me @ "_descs/prefs/ver" getpropstr dup if
        "1.1" smatch not if
             DoInit
         then
         else
             DoInit
    then
                                              (* get desc name from user *)
    ">>  What is the name of this description?" Tell
    ">> [Enter a name, or .q to quit]" Tell
    SayPose strip ourString !
    
    ourString @ ".quit" swap stringpfx if 
        DescCheck ">>  Done." Tell exit
    then
                            (* check: would desc name create a wiz prop? *)
    ourString @ "@*" smatch if
">>  That name would cause the program to place the desc in a wizard-only"
    Tell
"    directory. Please choose a different name."
    Tell
        DescCheck ">>  Done." Tell exit
    then
                (* check: would desc name be interpreted as an argument? *)
    ourString @ "#*" smatch if
">>  A desc name beginning with an # octothorpe would be mis-interpreted by"
    Tell
"    the program as a command-line argument. Please choose a different name."
    Tell
        DescCheck ">>  Done." Tell exit
    then
                             (* check: already have a desc by that name? *)
    me @ "_descs/" ourString @ strcat "#/1" strcat getpropstr if
        ">>  You already have a desc by that name." Tell
        DescCheck ">>  Done." Tell exit
    then
    
    " " Tell
"*************Entering lsedit. Type your new description here. ***********"
    Tell
"***********The description can modified with the #edit command***********"
    Tell " " Tell
                                             (* use editor to enter desc *)
    "_descs/" ourString @ strcat ThisEditList
    
    MiscProps     
   
      (* set new desc to current if user has no current DescTools desc set *)
    me @ "_descs/prefs/current" over over getpropstr not if 
        ourString @ setprop
        else
            pop pop
    then
    
    DescCheck ">>  Done." Tell
;
  
: DoEdit  ( s --  )                                  (* edit stored desc *)
     
    pop CheckInit
                                        (* set DescTools props if needed *)
    me @ "_descs/prefs/ver" getpropstr dup if
        "1.1" smatch not if
             DoInit
         then
         else
             DoInit
    then
                                                        (* get desc name *)
    ">>  Which desc do you want to edit?" Tell
    ">> [Enter a desc name, or .q to quit]" Tell
    SayPose strip ourString !
    
    ourString @ ".quit" swap stringpfx if
        DescCheck ">>  Done." Tell exit
    then
                                      (* check: user has indicated desc? *)
    me @ "_descs/" ourString @ strcat "#/1" strcat getpropstr not if
        ">>  You don't have a desc called '"
        ourString @ strcat
        "'." strcat Tell 
        DescCheck ">>  Done." Tell exit
    then
                                                              (* edit it *)
    "_descs/" ourString @ strcat ThisEditList
    
    MiscProps
    
    DescCheck ">>  Done." Tell
;
  
: DoDelete  ( s --  )                              (* delete stored desc *)
    
                                                        (* get desc name *)
    pop CheckInit
    ">>  Which desc do you want to delete?" Tell
    ">> [Enter a desc name, or .q to quit]" Tell
    SayPose strip ourString !
    
    ourString @ ".quit" swap stringpfx if
        DescCheck ">>  Done." Tell exit
    then
                                      (* check: user has indicated desc? *)
    me @ "_descs/" ourString @ strcat "#/1" strcat getpropstr not if
        ">>  You don't have a desc by that name." Tell exit
    then
                                                            (* delete it *)
    "_descs/" ourString @ strcat me @ swap RemoveList
    me @ "_descs/" ourString @ strcat "/spec" strcat remove_prop
    me @ "_descs/" ourString @ strcat "/sex"  strcat remove_prop
    me @ "_descs/" ourString @ strcat "/mpi"  strcat remove_prop
    
        (* check: 'current' desc still valid? grab and set a desc if not *)    
    DescCheck ">>  Done." Tell
;
  
: DoFormat  ( s --  )                     (* reformat look-notify string *)
    
                         (* set one to be reformated if there isn't one! *)
    pop CheckInit
    me @ "_descs/prefs/ver" getpropstr dup if
        "1.1" smatch not if
             DoInit
         then
         else
             pop
    then
    
    0 ourBoolean !
    begin
        ">>  Do you want to be told when someone looks at you?"
        Tell
        ">> [Enter 'yes', 'no', or .q to quit]" Tell
        SayPose strip
    
        dup ".quit" swap stringpfx if
             DescCheck ">>  Done." Tell exit
        then
        
        dup "yes" swap stringpfx if
            pop
            ">>  Your current MPI look-notify string is: " Tell " " Tell
            me @ "_descs/prefs/lformat" getpropstr Tell " " Tell
    
                                             (* show how it looks parsed *)
            ">>  If you were the 'looker', this would parse to: " 
            Tell " " Tell
            me @ "_descs/prefs/lformat" ParseThis ClearStack
            " " Tell
    
                                                      (* get new version *)
            ">>  What do you want to set your MPI look-notify string to?" 
            Tell
">> [Enter MPI for your look-notify, .d to return to the default setting, "
            Tell
"    .n for no change, or .q to quit]" Tell
    
            Saypose strip ourString !
    
            ourString @ ".quit" swap stringpfx if
                DescCheck ">>  Done." Tell exit
            then
                                             (* check: reset to default? *)
            ourString @ ".d" smatch if
                me @ "_descs/prefs/lformat"
                "{null:{tell:[ {name:me} looked at you. ],this}}" 
                setprop
                ">>  Set." Tell 1 ourBoolean !
            then
            
            ourBoolean @ not if
                ourString @ ".n" smatch not if
                                                      (* set new version *)
                    me @ "_descs/prefs/lformat" ourString @ setprop
                                               (* show what was just set *)
                    ">>  Format set to:" Tell " " Tell
                    ourString @ Tell " " Tell
                                             (* show how it looks parsed *)
                    ">>  If you were the 'looker', this would parse to: " 
                    Tell " " Tell
                    me @ "_descs/prefs/lformat" ParseThis ClearStack
                    " " Tell
                then
            then
            
            begin
">>  Do you want the player who looks at you to be told that you were "
                Tell
                "    notified?" Tell
                ">> [Enter 'yes', 'no', or .q to quit]" Tell
                SayPose strip ourString !
    
                ourString @ ".quit" swap stringpfx if
                    DescCheck ">>  Done." Tell exit
                then
        
                ourString @ "yes" swap stringpfx if
                    ">>  Your current MPI o-look-notify string is: " 
                    Tell " " Tell
                    me @ "_descs/prefs/olformat" getpropstr Tell " " Tell
   
                                             (* show how it looks parsed *)
                   ">>  If you were the 'looker', this would parse to: " 
                   Tell " " Tell
                    me @ "_descs/prefs/olformat" ParseThis ClearStack
                    " " Tell
    
                                                      (* get new version *)
                   ">>  What do you want to set your MPI "
                   "o-look-notify string to?" strcat Tell
">> [Enter MPI for your look-notify, .d to return to the default setting, "
                   Tell
                   "   .n for no change, or .q to quit]" Tell
    
                   Saypose strip ourString !
    
                   ourString @ ".quit" swap stringpfx if
                       DescCheck ">>  Done." Tell exit
                   then
                                             (* check: reset to default? *)
                   ourString @ ".d" smatch if
                       me @ "_descs/prefs/olformat"
                       "{null:{tell:[ {name:this} sees you looking. ],me}}" 
                       setprop
                       ">>  Set." Tell 
                       DescCheck ">>  Done." Tell exit
                   then
                   
                   ourString @ ".n" smatch if
                       DescCheck ">>  Done." Tell exit
                   then
                                                      (* set new version *)
                   me @ "_descs/prefs/olformat" ourString @ setprop
                                               (* show what was just set *)
                   ">>  Format set to:" Tell " " Tell
                    ourString @ Tell " " Tell
                                             (* show how it looks parsed *)
                   ">>  This parses to: " Tell " " Tell
                   me @ "_descs/prefs/olformat" ParseThis ClearStack
                   " " Tell
                   DescCheck ">>  Done." Tell exit
                then
                
                ourString @ "no" swap stringpfx if
                    me @ "_descs/prefs/olformat" "{null}" setprop
                    ">>  Set." Tell
                    DescCheck ">>  Done." Tell exit
                    else
                        ">>  Command not understood." Tell continue
                then
                break
            repeat
       then
                
       ourString @ "no" swap stringpfx if
           me @ "_descs/prefs/lformat" "{null}" setprop
           ">>  Set." Tell
           DescCheck ">>  Done." Tell exit
           else
               ">>  Command not understood." Tell continue
       then
       break
    repeat 
                                                 (* show current version *)    
    DescCheck ">>  Done." Tell
;
  
: DoRestore  ( s --  )                    (* restore old desc if present *)
    
                                    (* check: do we have one to restore? *)
    pop
    me @ "_descs/prefs/prev" getpropstr not if
        ">>  No previous desc to restore!" Tell
        ">>  If you want to stop using this program, erasing all data, type:"
        Tell " " Tell
        "       @set me = _descs/:" Tell " " Tell
        ">>  To erase only the DescTools props, saving your descs, type:"
        Tell " " Tell
        "       @set me = _descs/prefs/:" Tell " " Tell
        ">>  Your descs will remain in your '_descs/' directory, "
        "stored as lists." strcat Tell exit
    then
                                                              (* restore *)
    me @ dup "_descs/prefs/prev" getpropstr setdesc
                                                (* remove DescTools data *)
    me @ "_descs/prefs/lformat" remove_prop
    me @ "_descs/prefs/olformat" remove_prop
    me @ "_descs/prefs/prev" remove_prop
    me @ "_descs/prefs/current" remove_prop
    me @ "_descs/prefs/ver" remove_prop
    ">>  Restored." Tell
           (* notify if user still has descs stored in _descs/ directory *)
    me @ "_descs/" nextprop if
        ">>  Descs set with DescTools are still in your '_descs/' directory."
        Tell
    then
;
  
: main
    
    "me" match me !
    strip dup ourString !
    
                                                       (* set docs prop *)
    prog "_docs" "@list #" prog intostr strcat "=1-36" strcat setprop
    
    ourString @ not if
        DoHelp exit
    then
    
    dup if
        dup "#*" smatch if
            dup "#help"    swap stringpfx if DoHelp    else
            dup "#list"    swap stringpfx if DoList    else
            dup "#add"     swap stringpfx if DoAdd     else
            dup "#edit"    swap stringpfx if DoEdit    else
            dup "#delete"  swap stringpfx if DoDelete  else
            dup "#format"  swap stringpfx if DoFormat  else
            dup "#restore" swap stringpfx if DoRestore else
                ">>  Command not understood." Tell
            then then then then then then then
            exit
        then
    then
                                            (* screen for wiz-prop stuff *)
    ourString @ "@*" smatch if
        ">>  You don't have a desc called '"
        ourString @ strcat
        "'." strcat Tell exit
    then
        
    DoWear
;
.
c
q