@program xstaff.muf 1 10000 d i $include $ansihack $def HEADER "StaffList.muf -- Syvel @ FurryFaire -- Feb 11, 1998" $def VERSION "1.0" ( Purpose: A replacement for Mishael's cmd-lists. List staff members and their availability. Usage: Set this program W2. This program is designed for GlowMuck 1.9.2 and probably will not function on FuzzBall without modifications. To make your own list, do the following: 1. Create an action somewhere {environment rooms are the best} 2. Link that action to this program. The action can be named anything you like. [ the following properties belong on the action! ] 3. Set the _RefList to the name of the list. 4. Use lsedit for the _Header and _Footer lists. 5. For autocentering of header/footer, set these two props to 'yes'. _center_header? and _center_footer? 6. Set _ShowMode to one of the following numbers, to determine default listing mode: {1} Show All Members {2} Show Available Members {3} Show Awake Members 7. Set _Speciality to any text to display over #set text. 8. Use the #add option to add the members of the list. Porting: This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or any later version. ) $include $lib/reflist $include $lib/lmgr $define N me @ swap ansi_notify $enddef $def MAX_IDLE 300 lvar CMD lvar T1 lvar T2 lvar LISTMODE lvar SHOWN lvar NOTSHOWN lvar MAXLEN $def ansi_notify 3 parse_ansi \ansi_notify $def ansi_notify_except 3 parse_ansi 1 swap \ansi_notify_exclude $def ansi_notify_exclude 3 parse_ansi \ansi_notify_exclude $def .tell me @ swap ansi_notify $def .otell me @ location me @ rot ansi_notify_except $def .atell me @ swap ansi_notify $def notify ansi_notify $def notify_except ansi_notify_except $def notify_exclude ansi_notify_exclude $def specialparse 1 parse_ansi 3 parse_ansi dup strlen 4 - strcut pop $def ansi_strcut swap specialparse swap \ansi_strcut $def ansi_strlen specialparse \ansi_strlen ( general functions ) : split swap over over swap instr dup not if pop swap pop "" else 1 - strcut rot strlen strcut swap pop then ; : fillfield rot ansi_strlen - dup 1 < if pop pop "" exit then swap over begin swap dup strcat swap 2 / dup not until pop swap ansi_strcut pop ; : leftfitstr 3 pick ansi_strlen over >= if swap pop ansi_strcut pop else 3 pick -3 rotate fillfield strcat then ; : rightfitstr 3 pick ansi_strlen over >= if swap pop ansi_strcut pop else 3 pick -3 rotate fillfield swap strcat then ; : centfitstr 3 pick ansi_strlen over >= if swap pop ansi_strcut pop else 3 pick -3 rotate fillfield dup ansi_strlen 2 / ansi_strcut rot strcat swap strcat then ; : calculate-least-idle ( iN ... i2 i1 N -- i ) ( from Mishael's cmd-lists ) 0 swap begin dup while swap rot descrcon conidle over over < if swap then pop swap 1 - repeat pop ; : convert-idle-time ( i -- s ) ( from Mishael's cmd-lists ) 60 / "m" swap dup 60 / if 60 / swap pop "h" swap dup 24 / if 24 / swap pop "d" swap then then intostr swap strcat ; : get-reflistname ( -- s ; get the reflist name for this trigger ) TRIGGER @ "_reflist" getpropstr dup not if "^RED^ERROR! ^WHITE^_reflist is not set on trigger." N exit then ; : use-titles? ( -- i ; display titles column? ) TRIGGER @ "_Titles?" getpropstr "yes" stringcmp 0 = ; : show-headers ( -- ; display the headers ) TRIGGER @ "_header#" getpropstr atoi dup if TRIGGER @ "_center_header?" getpropstr "yes" stringcmp 0 = if 1 T1 ! else 0 T1 ! then 1 begin over over >= while dup "_header" TRIGGER @ LMGR-GetElem T1 @ if " " 78 centfitstr then N 1 + repeat else pop then use-titles? if "^AQUA^Title ^NAVY^Stat ^VIOLET^Duty ^FOREST^Name " else "^NAVY^Stat ^VIOLET^Duty ^FOREST^Name " then TRIGGER @ "_speciality" getpropstr dup not if pop "^GRAY^Speciality" then strcat N use-titles? if "^BLUE^------- ----- ----- ---------------- -----------------------------------------" else "^BLUE^----- ----- ---------------- -------------------------------------------------" then N ; : show-footers ( -- ; display the footers ) TRIGGER @ "_footer#" getpropstr atoi dup if TRIGGER @ "_center_footer?" getpropstr "yes" stringcmp 0 = if 1 T1 ! else 0 T1 ! then 1 begin over over >= while dup "_footer" TRIGGER @ LMGR-GetElem T1 @ if " " 78 centfitstr then N 1 + repeat else pop then ; : is-onduty? ( d -- i ; is d onduty? ) dup get-reflistname "_lists/" swap strcat "/duty" strcat getpropstr "on" stringcmp 0 = swap "H" flag? not and ; : show-this-ref? ( d -- i ; should we show d on the list? ) (-- LISTMODE: 1..use _showmode on the list 2..show all members 3..show available members 4..show awake members SHOWMODE: 1..show all members 2..show available members 3..show awake members --) LISTMODE @ case 1 = when ( normal list mode, using _showmode ) TRIGGER @ "_showmode" getpropstr atoi case 1 = when ( show all members ) pop 1 end 2 = when ( show available memebers ) dup awake? swap is-onduty? and end 3 = when ( show awake members ) awake? end default pop pop 1 end endcase end 2 = when ( show all members ) pop 1 end 3 = when ( show available members ) dup awake? swap is-onduty? and end 4 = when ( show awake members ) awake? end endcase ; : mlevel-title ( d -- s ; return 'title' for player's mlevel/meeper flags ) case mlevel 8 = when "^PURPLE^God" end mlevel 7 = when "^PURPLE^Avatar" end mlevel 6 = when "^PURPLE^ArchWiz" end mlevel 5 = when "^VIOLET^Wizard" end mlevel 4 = when "^VIOLET^Mage" end mlevel 3 = when "^RED^Master" end mlevel 2 = when "^RED^Jrnyman" end mlevel 1 = when "^CRIMSON^Novice" end default dup "meeper" flag? if pop "^CRIMSON^Meeper" else "builder" flag? if "^CRIMSON^Builder" else "^NAVY^Player" then then end endcase ; : get-stat ( d -- i ; return stat column info for d ) dup T2 ! awake? not if "^WHITE^[^NAVY^Zzz^WHITE^]" exit then T2 @ "H" flag? if "^WHITE^[^RED^HAV^WHITE^]" exit then T2 @ descriptors calculate-least-idle MAX_IDLE >= if "^WHITE^[^BROWN^IDL^WHITE^]" exit then ( ok, use ~status now ) T2 @ "~status" getpropstr dup if "^WHITE^[" swap dup case "IC" strcmp not when "^GREEN^" swap strcat end "OOC" strcmp not when "^WHITE^" swap strcat end dup "WIZ" strcmp not swap "HS" strcmp not or when "^PURPLE^" swap strcat end "IDL" strcmp not when "^BROWN^" swap strcat end default pop "^CYAN^" swap strcat end endcase strcat "^WHITE^] " strcat else pop "^WHITE^[^NAVY^...^WHITE^]" then ; : get-duty ( d -- s ; get on/off duty status ) dup awake? not if pop "^NAVY^[^BLUE^...^NAVY^]" else is-onduty? if "^NAVY^[^GREEN^On ^NAVY^]" else "^NAVY^[^RED^Off^NAVY^]" then then ; : do-list ( -- ; show the list ) show-headers get-reflistname "_" swap strcat TRIGGER @ over REF-first 0 0 SHOWN ! NOTSHOWN ! begin dup #-1 dbcmp not while dup show-this-ref? if SHOWN @ 1 + SHOWN ! use-titles? if dup mlevel-title " " 8 leftfitstr else "" then over get-stat " " 6 leftfitstr strcat over get-duty " " strcat strcat over name "^GREEN^" swap strcat " " 17 leftfitstr strcat 3 pick 3 pick swap 1 strcut swap pop "_lists/" swap strcat "/help" strcat getpropstr dup if "^PURPLE^" swap strcat else pop "^PURPLE^--" then strcat " " 78 leftfitstr N else NOTSHOWN @ 1 + NOTSHOWN ! then over swap TRIGGER @ -3 rotate REF-next repeat pop pop SHOWN @ 0 = if "^RED^No staff members were found..." N then "[ ^YELLOW^" SHOWN @ intostr strcat " of " strcat NOTSHOWN @ SHOWN @ + intostr strcat " found ^BLUE^]--" strcat "-" 78 rightfitstr "^BLUE^" swap strcat N show-footers ; : me-member? ( -- i ; is me a member of the list? ) get-reflistname "_" swap strcat TRIGGER @ swap ME @ REF-inlist? ; : go-onduty ( -- ) get-reflistname "_" swap strcat TRIGGER @ swap ME @ REF-inlist? if get-reflistname "_lists/" swap strcat "/duty" strcat dup ME @ swap getpropstr "on" stringcmp if ME @ swap "on" setprop "^GREEN^You are now onduty for the " get-reflistname strcat " list." strcat N else "^RED^You're already onduty for the " get-reflistname strcat " list." strcat N then else "^RED^You are not a member of the " get-reflistname strcat " list." strcat N then ; : go-offduty ( -- ) get-reflistname "_" swap strcat TRIGGER @ swap ME @ REF-inlist? if get-reflistname "_lists/" swap strcat "/duty" strcat dup ME @ swap getpropstr "off" stringcmp if ME @ swap "off" setprop "^GREEN^You are now offduty for the " get-reflistname strcat " list." strcat N else "^RED^You're already offduty for the " get-reflistname strcat " list." strcat N then else "^RED^You are not a member of the " get-reflistname strcat " list." strcat N then ; : do-help ( -- ) "^PURPLE^" HEADER strcat " " 78 centfitstr N "^BLUE^--[ ^YELLOW^#help ^BLUE^]" "-" 78 leftfitstr N "^AQUA^To show the list of staff:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat "^AQUA^'" strcat strcat N "^AQUA^To show all members:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #all^AQUA^'" strcat strcat N "^AQUA^To show available members:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #available^AQUA^'" strcat strcat N "^AQUA^To show awake members:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #awake^AQUA^'" strcat strcat N ( member commands ) me-member? if ( member commands ) " ^CYAN^-- Staff Commands --" N "^AQUA^To set yourself onduty:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #on^AQUA^'" strcat strcat N "^AQUA^To set yourself offduty:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #off^AQUA^'" strcat strcat N "^AQUA^To set your help-field:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #set [text]^AQUA^'" strcat strcat N "^BLUE^NOTE: ^FOREST^Setting yourself HAVEN automatically marks you offduty." N then ( manager/owner commands ) ME @ TRIGGER @ controls if " ^CYAN^-- Maintainer Commands --" N "^AQUA^To add a member:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #add ^AQUA^'" strcat strcat N "^AQUA^To remove a member:" " " 45 leftfitstr "'^YELLOW^" COMMAND @ strcat " #del ^AQUA^'" strcat strcat N then "^PURPLE^-- Words in <> are parameters. Parameters in [] are optional. --" " " 78 centfitstr N "^FOREST^This is the ^GREEN^" get-reflistname strcat " ^FOREST^list, maintained by ^GREEN^" strcat TRIGGER @ owner name strcat "^FOREST^." strcat " " 78 centfitstr N ; : add-member ( -- ; add a member to the list ) ME @ TRIGGER @ controls if CMD @ " " split swap pop .pmatch dup ok? over player? and if TRIGGER @ get-reflistname "_" swap strcat 3 pick REF-add "^GREEN^" swap name strcat " has been added to the " strcat get-reflistname strcat " list." strcat N else pop "^RED^Who is that?" N then else "^RED^You dont control this list." N then ; : del-member ( -- ; remove a member from the list ) ME @ TRIGGER @ controls if CMD @ " " split swap pop .pmatch dup ok? over player? and if TRIGGER @ get-reflistname "_" swap strcat 3 pick REF-inlist? if TRIGGER @ get-reflistname "_" swap strcat 3 pick REF-delete "^GREEN^" swap name strcat " has been deleted from the " strcat get-reflistname strcat " list." strcat N else "^RED^" swap name strcat " was not on the " strcat get-reflistname strcat " list." strcat N then else pop "^RED^Who is that?" N then else "^RED^You dont control this list." N then ; : do-set-speciality ( -- ) me-member? if use-titles? if 40 MAXLEN ! else 48 MAXLEN ! then CMD @ " " split swap pop dup ansi_strlen dup MAXLEN @ > if "^RED^" swap MAXLEN @ - intostr strcat " letters were lost. Try using " strcat MAXLEN @ intostr strcat " letters or less." strcat N MAXLEN @ strcut pop else pop then ME @ "_lists/" get-reflistname strcat "/help" strcat 3 pick setprop "^GREEN^Help Field set to: ^CYAN^" swap strcat N else "^RED^You are not a member of the " get-reflistname strcat " list." strcat N then ; : main-parser dup CMD ! "me" match ME ! CMD @ "" stringcmp 0 = if 1 LISTMODE ! do-list else CMD @ case "#on" stringcmp 0 = when go-onduty end "#off" stringcmp 0 = when go-offduty end "#h" stringpfx when do-help end "#al" stringpfx when 2 LISTMODE ! do-list end "#av" stringpfx when 3 LISTMODE ! do-list end "#aw" stringpfx when 4 LISTMODE ! do-list end "#ad" stringpfx when add-member end "#del" stringpfx when del-member end "#set" stringpfx when do-set-speciality end default "^RED^I dont understand \"^YELLOW^" swap strcat "^RED^\", check #help." strcat N end endcase then ; . c q