@q
@program staffscreen.muf
1 9999 d
i
  
( staffscreen.muf    v1.2    Jessy @ FurryMUCK    6/97, 2/99
  
  Another staff screen utitilty.
  
  INSTALLATION:
  
  Create a global action with a name such as 'wizzes;wizards;staff'
  and link it to this program.
  
  USAGE:
  
    <cmd> ............ Show staff members
    <cmd> #on ........ Go on duty <staff only>
    <cmd> #off ....... Go off duty <staff only>
    <cmd> #specialty.. Set a specialty string <staff only>
    <cmd> #add ....... Add a player to staff roster <wiz only>
    <cmd> #remove .... Remove a player from staff roster <wiz only>
    <cmd> #format .... Format display screen <staff only>
  
  
  Staffscreen.muf may be freely ported. Please comment any changes.
)
  
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
$def thisVersion "1.1"
  
$include $lib/reflist
$include $lib/lmgr
$include $lib/editor
$include $lib/strings
   
$define Tell me @ swap notify $enddef
 
lvar scratch                                         (* workspace var *)
lvar ourCounter                                  (* misc. counter var *)
lvar ourArg                          (* inital arg string, unmodified *) 
lvar ourCom                     (* string: 'official' name of command *)
 
: Pad  ( s i -- s' )                  (* pad string s to i characters *)
  
  "                                                                    "
  rot swap strcat swap strcut pop
;
 
: DoHelp  (  --  )                             (* display help screen *)
  
  " " Tell
  prog name " (#" strcat prog intostr strcat ")" strcat Tell
  " " Tell
  
  "The " command @ strcat
  " command is use to display staff members and their current "
  "duty status. Staff members may also use it to go on and off duty, "
  "and to set a 'specialty' string. Wizards may use it to add and re"
  "move players from the staff roster." strcat strcat strcat strcat
  Tell " " Tell
  
  "Syntax:  " command @ strcat " ............ Show staff members"
  strcat Tell
  "         " command @ strcat " #on ........ Go on duty <staff only>"
  strcat Tell
  "         " command @ strcat " #off ....... Go off duty <staff only>"
  strcat Tell
  "         " command @ strcat " #specialty.. Set a specialty string "
  "<staff only>" strcat strcat Tell
  "         " command @ strcat " #add ....... Add a player to staff "
  "roster <wiz only>" strcat strcat Tell
  "         " command @ strcat " #remove .... Remove a player from "
  "staff roster <wiz only>" strcat strcat Tell
  "         " command @ strcat " #format .... Format display screen "
  "<staff only>" strcat strcat Tell " " Tell
  
  "It is not necessary to type the "
  "#argument string completely: you only need to type the first one "
  "or several characters, enough to distinguish the option you want "
  "from the others." strcat strcat strcat Tell
;
   
: ReadLine  (  -- 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 ReadLine 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
;

: AddListLine  ( s s' --  )       (* add line s' to list s on library *)
  
  over prog LMGR-GetCount 1 + 3 pick prog LMGR-PutElem pop
;
  
: EditLoop  ( 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
    "" EditLoop 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
;
  
: EditList  ( 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 $" EditLoop
;
  
: ShowList  ( 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
;
  
: DoFormat  (  --  )            (* format screen's header and trailer *)
  
  ">>  Edit material to be shown at top of staff screen:" Tell
  trig "_staff/header" EditList
  
  ">>  Edit material to be shown at bottem of staff screen:" Tell
  trig "_staff/trailer" EditList
  
  ">>  Done." Tell
;
 
: DoAdd  (  --  )     (* prompt wiz user for a player to add to staff *)
  
  me @ "W" flag? not if                           (* check permission *)
    ">>  Permission denied." Tell exit
  then
                                                        (* get player *)
  ">>  Who do you want to add to the staff?" Tell
  ">> [Enter player name, or .q to quit]" Tell
  ReadLine strip QCheck
                                      (* if valid entry, add to staff *)
  .pmatch dup if
    dup intostr "#" swap strcat " " strcat
    trig "_staff/members" over over getpropstr 4 pick instr if
      pop pop pop
      ">>  " swap name strcat " is already a staff member." strcat Tell
      ">>  Done." Tell exit
    else
                               (* if duplicate entry, notify and quit *)
      over over getpropstr 4 rotate strcat setprop
      ">>  " swap name strcat " added to staff." strcat Tell
      ">>  Done." Tell
    then
  else                           (* if invalid entry, notify and quit *)
    ">>  Player not found." Tell
  then
;
  
: DoRemove (  --  )(* prompt wiz user for player to remove from staff *)
  
  me @ "W" flag? not if                           (* check permission *)
    ">>  Permission denied." Tell exit
  then
                                                        (* get player *)
  ">>  Who do you want to remove from the staff?" Tell
  ">> [Enter player name, or .q to quit]" Tell
  ReadLine strip QCheck
                                 (* if valid entry, remove from staff *)
  .pmatch dup if
    dup intostr "#" swap strcat " " strcat
    trig "_staff/members" over over getpropstr 4 pick instr if
      over over getpropstr 4 rotate "" swap subst setprop
      dup "_prefs/staff/offduty" remove_prop
      dup "_prefs/staff/spec"    remove_prop
      ">>  " swap name strcat " removed from staff." strcat Tell
      ">>  Done." Tell exit
    else                         (* if invalid entry, notify and quit *)
      pop pop pop
      ">>  " swap name strcat " is not a staff member." strcat Tell
      ">>  Done." Tell
    then
  else
    ">>  Player not found." Tell
  then
;
  
: DoOnDuty  (  --  )                             (* user goes on duty *)
  
  me @ "_prefs/staff/offduty" remove_prop
  ">>  You go on duty." Tell
;
  
: DoOffDuty  (  --  )                           (* user goes off duty *)
  
  me @ "_prefs/staff/offduty" "yes" setprop
  ">>  You go off duty." Tell
;
  
: DoSpecialty  (  --  ) (* prompt for and set user's specialty string *)
  
  ">>  What is your specialty or staff tag line?" Tell
  ">> [Enter string, .r to remove current string, or .q to quit]" Tell
  ReadLine strip QCheck
  
  dup ".r" smatch if
    me @ "_prefs/staff/spec" remove_prop pop
  else
    me @ "_prefs/staff/spec" rot setprop
  then
  ">>  Set." Tell
;
  
: DoStaff  (  --  )                           (* display staff screen *)
  
                                         (* display header if present *)
  trig "_staff/header" ShowList
                                      (* get reflist of staff members *)
  trig "_staff/members" getpropstr dup if 
    " " explode 1 -
    begin                                 (* begin staff-listing loop *)
      dup while
      swap strip 1 strcut swap pop atoi dbref 
      dup name 14 Pad
      over awake? if
        over "_prefs/staff/offduty" getpropstr if
          "[off-duty]  "
        else
          "[ on-duty]  " 
        then
        strcat
      else
        "[--------]  " strcat
      then
      swap "_prefs/staff/spec" getpropstr strcat 
      76 strcut pop Tell                             (* show one line *)
      1 -
    repeat                                  (* end staff-listing loop *)
    pop
  else
    pop "<no entries>" Tell
  then
                                        (* display trailer if present *)
  trig "_staff/trailer" ShowList
;
  
: main
  
  "me" match me !                                       (* initialize *)
  strip ourArg !
  
  ourArg @ if
    ourArg @ "#" stringpfx if
      "#help"      ourArg @ stringpfx if DoHelp      else
      "#on"        ourArg @ stringpfx if DoOnDuty    else
      "#off"       ourArg @ stringpfx if DoOffDuty   else
      "#specialty" ourArg @ stringpfx if DoSpecialty else
      "#add"       ourArg @ stringpfx if DoAdd       else
      "#remove"    ourArg @ stringpfx if DoRemove    else
      "#format"    ourArg @ stringpfx if DoFormat    else
      ">>  #Argument not understood." Tell
      then then then then 
      then then then 
      exit
    then
  then
  
  DoStaff
;
.
c
q