@q @program asys-mask 1 99999 d i ( asys-mask v1.2 Jessy@FurryMUCK 6/00 This program controls the +mask and +unmask commands, staff utilities for hiding and unhiding entries in the Argo database. INSTALLATION: asys-mask uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-mask' USAGE: +mask / ....... Hide a database entry +unmask / ..... Unhide a database entry asys-mask may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo lvar ourArg (* inital arg string, unmodified *) lvar ourBoolean (* int: misc flow control var *) lvar ourCat (* string: dbase category *) lvar ourCom (* string: 'official' name of command *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourEntry (* string: dbase entry *) lvar ourString (* string: propdir for dbase entry*) lvar scratch (* workspace var *) : DoInstall ( -- ) (* install program into Argo system *) caller program? not if (* confirm installation method *) ">> Programs must be installed via the " "+install" GetCommandName strcat " command." strcat Tell exit then prog "@a/version" getpropstr if ">> Reinstalling..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-mask" setprop RecOldActions (* create and register command; set default props *) #0 "+mask" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+mask" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+mask" setprop #0 "+unmask" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+unmask" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+unmask" setprop ">> Installed." Tell ; : DoUninstall (* uninstall program from Argo *) prog "@a/name" getpropstr if #0 "@a/prog_list/" prog "@a/name" getpropstr strcat getprop not if ">> " prog name strcat " is not currently installed." strcat Tell pid kill then else ">> " prog name strcat " is not currently installed." strcat Tell pid kill then ">> Please confirm: You wish to uninstall " prog name strcat "?" strcat Tell ReadYesNo not if ">> Aborted." Tell pid kill Then background "@a/comm_list/+mask" RemoveCommand "@a/comm_list/+unmask" RemoveCommand RecOldActions #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $mask command is a staff utility used to hide entries in the " "Argo database: masked entries do not show up on lists such as " "those output by the $info and $list commands. When used on " "a masked object, the $check command will show whether or not " "it is Argo enabled, but will not list its classes. The $unmask " "command unmasks or unhides entries." strcat strcat strcat strcat strcat "+mask" GetCommandName "$mask" subst "+unmask" GetCommandName "$unmask" subst "+info" GetCommandName "$info" subst "+list" GetCommandName "$list" subst "+check" GetCommandName "$check" subst Tell " " Tell " $mask / ....... Hide a database entry" "+mask" GetCommandName "$mask" subst Tell " $unmask / ..... Unhide a database entry" "+unmask" GetCommandName "$unmask" subst Tell " " Tell ; : DoGetCategory ( -- i ) (* get category to view *) (* return true if successful *) (* store cat name in ourCat; store cat propdir in ourString *) "advantages" ourCat @ stringpfx if "@a/dis-ad/" "advantage" else "creatures" ourCat @ stringpfx if "@a/creatures/" "creature" else "disadvantages" ourCat @ stringpfx if "@a/dis-ad/" "disadvantage" else "groups" ourCat @ stringpfx if "@a/groups/" "group" else "jobs" ourCat @ stringpfx if "@a/jobs/" "job" else "npcs" ourCat @ stringpfx if "@a/npcs/" "NPC" else "languages" ourCat @ stringpfx if "@a/languages/" "psiab" else "objects" ourCat @ stringpfx if "@a/objects/" "object" else "psiabs" ourCat @ stringpfx if "@a/psiabs/" "psiab" else "psionic abilities" ourCat @ stringpfx if "@a/psiabs/" "psiab" else "skills" ourCat @ stringpfx if "@a/skills/" "skill" else "spells" ourCat @ stringpfx if "@a/spells/" "spell" else "templates" ourCat @ stringpfx if "@a/tplates/" "template" else ">> Category not found." Tell 0 exit then then then then then then then then then then then then then ourCat ! ourString ! 1 ; : DoParse ( -- ) (* parse command arg *) ourArg @ if ourArg @ "/" rinstr if ourArg @ dup "/" rinstr strcut strip ourEntry ! strip dup strlen 1 - strcut pop strip ourCat ! DoGetCategory not if exit then ourDataObj @ ourString @ nextprop not if ">> Category `$cat' not found." ourCat @ "$cat" subst Tell exit then ourDataObj @ ourString @ ourEntry @ strcat getpropstr ourDataObj @ ourString @ ourEntry @ strcat "/" strcat nextprop or not if ">> $cat `$inst' not found." ourCat @ CapAll "$cat" subst ourEntry @ "$inst" subst Tell pid kill then else "Syntax: $com /" command @ "$com" subst Tell pid kill then else "Syntax: $com /" command @ "$com" subst Tell pid kill then ; : DoMask ( -- ) StaffCheck not if ">> Permission denied." Tell exit then DoParse ourDataObj @ ourString @ ourEntry @ strcat "/masked" strcat "yes" setprop ">> Masked." Tell ; : DoUnmask ( -- ) StaffCheck not if ">> Permission denied." Tell exit then DoParse ourDataObj @ ourString @ ourEntry @ strcat "/masked" strcat remove_prop ">> Unmasked." Tell ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourArg @ if ourArg @ "#" stringpfx if "#help" ourArg @ stringpfx if DoHelp else "#enable" ourArg @ stringpfx if DoEnable else "#disable" ourArg @ stringpfx if DoDisable else "#version" ourArg @ stringpfx if DoVersion else "#install" ourArg @ stringpfx if DoInstall else "#uninstall" ourArg @ stringpfx if DoUninstall else ">> #Argument not understood." Tell then then then then then then exit then then me @ ArgoPermCheck Disabled? ourCom @ "+mask" smatch if DoMask exit then ourCom @ "+unmask" smatch if DoUnmask exit then ; . c q @set asys-mask=W