@program whatiz.muf 1 10000 d i $def header "-- WhatIsz 1.33d: " $def version "Ruffin@FurToonia Mar 26 1997" ( See the help below for docs. Basically, this looks for a directory named _flags on the action, each containing the abbreviation of the flag as the prop name, and the full name in the property. Also on the action, you need a _propdir property, that contains the name of the directory, where all the preferences will be kept on the player. Note that it needs the final "/"!: @set wi=_propdir:_prefs/whatis/ If you want users to have to turn on the listing, or be able to turn it off, you need two lists: lsedit wi=_on < #on message, and ask to turn on > lsedit wi=_off < #off message > 09/12/94 V1.0 - Initial release 09/17/94 V1.1 - More help, _wsobjector:far support. 05/11/95 V1.2 - Allow variable w_dir, so you can run wi and wixxx, etc. 05/13/95 V1.21 - Print owner name when flags are listed. 05/15/95 V1.3 - Allow wi #on and #off 05/18/95 V1.3a - Allow partial match of names in the same room 03/28/96 V1.3b - Don't show sleepers, show zombies on room show 04/02/96 V1.3c - Don't show dark players with * 03/26/97 V1.3d - Add one more char for name, for Justin_Cheetah ) $def footer "= - =" $def flagdir "_flags/" $def flagdirlen 7 $def w_dir WDIR @ $def w_custom WDIR @ "custom" strcat $def w_order WDIR @ "order" strcat $def w_flags WDIR @ "flags" strcat $def w_used WDIR @ "used" strcat lvar WDIR (the _prefs/whatis/ directory) lvar PLAYER (the dbref of the player) lvar LINE (construct line to print) lvar FLAGS (current set of flags) lvar FFLAGS (find flags) : tellme ( show string to user: s -- ) me @ swap notify ; : htellme ( show string to user: swi s -- ; replace %wi in s with swi ) over "%wi" subst me @ swap notify ; : headshow ( s -- ; show header line ) header swap strcat " --------------------------------------------------------------------" strcat 78 strcut pop tellme ; : help ( help screen: -- ) version headshow trig name dup ";" instr dup if 1 - strcut pop else pop then "WhatIsz lets you set a list of flags on yourself that others can look at" tellme "for quick reference. You can use all the standard flags and also add 20" tellme "custom letters - 20 only to keep from spamming everyone.\r\r" tellme "%wi #help2 - Important stuff! Read me!" htellme "%wi - Show whatis info for everyone awake in the room" htellme "%wi - Show whatis info for that person" htellme "%wi - Show whatis info for any person online whose name matches" htellme " the mask, such as 'Ruf*' or just '*' for all" htellme "%wi #help - This screen" htellme "%wi #flags - Show all the standard flags you can use." htellme "%wi #set - Set your whatis flags to those listed." htellme "%wi #add - Add the listed flags to your whatis setting." htellme "%wi #clear - Clear the listed flags from your whatis setting." htellme "%wi #custom - Set your custom text, up to 20 characters worth." htellme "%wi #find - Find anyone online with those whatis flags set." htellme "%wi #order - Show these flags first when viewing others." htellme " is a space separated list of flags (%wi #flags to see them)" htellme trig "_on#/1" getpropstr if "%wi #off - Turn off using this program." htellme then (footer tellme pop) ; : help2 ( help screen 2: -- ) version headshow trig name dup ";" instr dup if 1 - strcut pop else pop then "Nifty and important things to keep in mind about WhatIsz" tellme "\r* To turn off the '[unset]' in your WhatIsz listing without actually setting" tellme " any flags, just do a '%wi #set'. Or do a '%wi #set nwi' (whatiszless)." htellme "* To stop your sex/species showing from afar, do a '@set me=_wsobjector:far'" tellme "* Look at '%wi #custom' which will allow you to set any text you want." htellme "* WhatIsz is fairly forgiving about flag names. You don't have to remember" tellme " that 'silly' is 'si' instead of 's'. You can just use 'silly' or 'sil'" tellme "* WhatIsz displays your flags in the order you #set them (unless someone's" tellme " #order overrides it). You don't have to give them alphabetically." tellme "* This program has been supported by user contributions and a major grant" tellme " from the National Endowment for the Inanities." tellme footer tellme pop ; ( Given the name of a flag, match it to a propname in the flagsdir, realizing that it might be longer than the prop name. If it finds a match it is flagname -- matchedflagname propname 1 otherwise flagname -- flagname 0 ) : flagmatch dup dup ( save a copy ) flagdir swap strcat dup trigger @ swap getpropstr if (exect match?) rot pop 1 exit else pop then begin dup strlen 1 - strcut pop dup while ( Check while characters left ) dup flagdir swap strcat dup trigger @ swap getpropstr dup if 4 pick dup strlen strncmp not if (match text inside?) rot pop 1 exit (return with match) else pop pop 0 exit then (return with no match) else pop pop then repeat pop 0 ( no match ) ; : unknownflag ( s -- ; prints unknown flag warning ) "* Ignored: Flag '" swap strcat "' is unknown." strcat tellme ; : flagmsg ( s1 s2 -- s1 ; prints flag info with message in s1 ) over strip strcat " (" strcat trigger @ flagdir 4 pick strip strcat getpropstr strcat ")" strcat tellme ; : wrap ( s s -- s ; Do word wrapping ) over over strcat strlen 78 > if swap tellme ". " swap strcat else strcat then ; : showone ( d -- ; show one player ) ( debugon) dup PLAYER ! name " " strcat 14 strcut pop " " strcat LINE ! (save player ref and start line) PLAYER @ w_dir propdir? not if LINE @ "[unset] " strcat LINE ! then PLAYER @ w_flags getpropstr " " strcat " " swap strcat FLAGS ! (get flags) ( look for our custom flag order ) me @ w_order getpropstr strip dup if " " explode begin dup while 1 - swap " " swap strcat " " strcat FLAGS @ over instr if FLAGS @ " " 3 pick subst FLAGS ! ( erase from flags list ) trigger @ flagdir 3 pick strip strcat getpropstr ( get flag name ) strip dup if LINE @ swap " " strcat wrap LINE ! else ( add name to line ) pop then then pop repeat pop else pop then ( Now the rest of the flags ) FLAGS @ strip dup if " " explode begin dup while 1 - swap flagdir swap strcat trigger @ swap getpropstr ( get flag name ) strip dup if LINE @ swap " " strcat wrap LINE ! else ( add to line ) pop then repeat pop else pop then ( get the custom ) player @ w_custom getpropstr strip dup if LINE @ swap " " strcat wrap LINE ! else pop then ( objector? ) player @ "_wsobjector" getpropstr "far" stringcmp not if player @ location me @ location dbcmp if 1 else 0 then else 1 then if ( get the sex ) player @ "sex" getpropstr dup not if pop player @ "gender" getpropstr then dup if LINE @ swap " " strcat wrap LINE ! else pop then ( get the species ) player @ "species_prop" getpropstr dup if player @ swap getpropstr else pop player @ "species" getpropstr then dup if LINE @ swap wrap LINE ! else pop then else LINE @ "[unknown]" wrap LINE ! then LINE @ strip if LINE @ tellme then (debugoff) ; : showcheck ( d -- ; Show one player if not dark ) me @ "W" flag? if showone else dup "d" flag? if pop else showone then then ; : doflags ( s -- show flags ) "Show Available Flags (managed by %n)" trig owner name "%n" subst headshow "" flagdir begin trigger @ swap nextprop dup while ( get each flag prop ) dup trigger @ over getpropstr swap flagdirlen strcut swap pop ": " strcat 5 strcut pop swap strcat " " strcat 18 strcut pop " " strcat rot swap strcat dup strlen 70 > if tellme "" then ( print the line and start a new one ) swap repeat pop dup if tellme else pop then footer tellme ; : doset ( s -- ; set flags ) "Set Personal Flags" headshow " " FLAGS ! tolower " " explode ( check each flag ) begin dup while 1 - swap dup if flagmatch if pop dup FLAGS @ " " rot strcat " " strcat instr if ( don't add twice ) pop else FLAGS @ swap strcat " " strcat FLAGS ! then else unknownflag then else pop then repeat me @ w_flags FLAGS @ strip dup not if pop " " then 0 addprop me @ w_used "yes" 0 addprop me @ showone footer tellme ; : doadd ( s -- ; add flags ) "Add Personal Flags" headshow me @ w_flags getpropstr " " strcat " " swap strcat FLAGS ! tolower " " explode ( check each flag ) begin dup while 1 - swap dup if flagmatch if pop " " over strcat " " strcat FLAGS @ swap instring not if ( add flag if not in string ) "* Flag added: " flagmsg FLAGS @ swap strcat " " strcat FLAGS ! else pop then else unknownflag then else pop then repeat me @ w_flags FLAGS @ strip 0 addprop me @ w_used "yes" 0 addprop me @ showone footer tellme ; : doclear ( s -- ; clear flags ) "Clear Personal Flags" headshow me @ w_flags getpropstr " " strcat " " swap strcat FLAGS ! tolower " " explode ( check each flag ) begin dup while 1 - swap dup if flagmatch if pop " " over strcat " " strcat flags @ over instring if ( kill flag if in string ) "* Flag cleared: " flagmsg FLAGS @ " " rot subst FLAGS ! pop else pop pop then else unknownflag then else pop then repeat me @ w_flags FLAGS @ strip dup not if pop " " then 0 addprop me @ w_used "yes" 0 addprop me @ showone footer tellme ; : docustom ( s -- ; set custom text) "Set Custom Text" headshow strip dup strlen 20 > if "WhatIsz only allows 20 characters of custom text, for spam control." tellme then 20 strcut pop me @ w_custom 3 pick dup not if pop " " then 0 addprop "Your custom text has been set to '" swap strcat "'." strcat tellme me @ w_used "yes" 0 addprop me @ showone footer tellme ; : doorder ( s -- ; set order of flag display ) "Set Flag Display Order" headshow "" FLAGS ! tolower " " explode ( check each flag ) begin dup while 1 - swap dup if flagmatch if pop FLAGS @ swap strcat " " strcat FLAGS ! else unknownflag then else pop then repeat me @ w_order FLAGS @ strip dup not if pop " " then 0 addprop "* Order set." tellme footer tellme ; : showroom ( -- ; show all in a room ) "Show Room" headshow loc @ contents begin dup ok? while dup player? over thing? 3 pick "z" flag? and or if dup owner awake? if dup showcheck then then next repeat pop footer tellme ; : showmatch ( s -- ; show all that match ) "Show Matching" headshow online dup 2 + rotate ( dn d2 d1 N match ) begin over while swap 1 - swap ( count down ) 3 pick name over smatch if ( does it match? ) rot showcheck else rot pop then repeat pop pop footer tellme ; : dofind ( s -- ; find others online that match flags ) "Find Matching Flags" headshow "" FFLAGS ! strip tolower " " explode ( check each flag ) begin dup while 1 - swap dup if flagmatch if pop FFLAGS @ swap strcat " " strcat FFLAGS ! else unknownflag then else pop then repeat FFLAGS @ not if "* No flags left to match on - aborting" tellme footer tellme exit then online ( dn d2 d1 N ) begin dup while 1 - ( count down ) swap dup w_flags getpropstr ( dn d2 d1 n db pflags ) dup not if pop pop continue then " " swap strcat " " strcat FFLAGS @ strip " " explode dup 2 + rotate (dn d2 d1 n db fn f2 f1 n pflags ) ( check to see if flags are all present) begin swap dup while 1 - swap dup " " 5 rotate strcat " " strcat ( dn d2 d1 n db fn f2 f1 n pflags pflags flag ) instr not if ( string not found ) pop begin dup while 1 - swap pop repeat pop ( clear off flags ) pop 1 break then ( dn d2 d1 n 1 ) repeat not if pop showcheck then ( dn d2 d1 n db pflags ) repeat pop footer tellme ; : doon ( -- d ; check for turning on, return 1 if quitting ) me @ w_used getpropstr "yes" strcmp if (it's off - on?) trig "_on#/1" getpropstr if 1 begin trig over intostr "_on#/" swap strcat getpropstr dup while .tell 1 + repeat pop pop "Do you wish to use this program (y/n)" .tell read "y" stringpfx if me @ w_used "yes" setprop else "Program cancelled." .tell 1 exit then then then 0 ; : dooff ( -- ; turn it off ) trig "_on#/1" getpropstr not if exit then 1 begin trig over intostr "_off#/" swap strcat getpropstr dup while .tell 1 + repeat pop pop me @ w_used "no" setprop "This program is now disabled for you." .tell ; : main ( s -- ) "me" match me ! trig "_propdir" getpropstr dup not if pop "_prefs/whatis/" then WDIR ! doon if pop exit then ( check for turning on ) strip dup " " instr dup if strcut swap strip else pop "" swap then dup not if pop " " then dup "#off" stringpfx if pop dooff exit then dup "#help2" stringcmp not if pop help2 exit then dup "#h" stringpfx if pop help exit then dup "#fl" stringpfx if pop doflags exit then dup "#s" stringpfx if pop doset exit then dup "#a" stringpfx if pop doadd exit then dup "#cl" stringpfx if pop doclear exit then dup "#cu" stringpfx if pop docustom exit then dup "#o" stringpfx if pop doorder exit then dup "#fi" stringpfx if pop dofind exit then dup "#" stringpfx if swap pop "Error" headshow "* Unknown flag " swap strcat tellme footer tellme exit then strip dup not if showroom exit then dup "*" instr if showmatch exit then dup "?" instr if showmatch exit then "Show Character" headshow "*" over strcat .wizmatch dup ok? not if pop match else swap pop then dup ok? if dup player? over thing? if over "z" flag? else 0 then or if showone else "No such player or zombie in the same room found." tellme then else "That's not a player or zombie in the same room." tellme then footer tellme ; . c q