@q @program asys-realms 1 99999 d i ( asys-realms v1.2 Jessy@FurryMUCK 6/97, 11/99 This utility is used to display the name of the Argo realm you currently are in. Staff members may also use it to create and remove realms. INSTALLATION: Asys-realms uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-realms' USAGE: Realms are areas within a MUCK that may have different Argo settings and definitions. The boundaries of realms are defined by the environment tree: a realm environment room and any rooms below it in the environment tree are considered part of a single realm. +realm ..................... Show current realm +realm #add ................ Make current room a realm env room [Staff] +realm #remove ............. Remove realm defined on current room [Staff] Asys-realm may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo $include $lib/reflist lvar ourArg (* inital arg string, unmodified *) lvar ourBoolean (* int: misc flow control var *) lvar ourCom (* string: 'official' name of command *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourOption (* string: command #option *) lvar ourSourceCat (* string: realm to copy/move from *) lvar ourTargetCat (* string: realm to copy/move to *) lvar ourSourceInst (* string: realm to copy/move from *) lvar ourTargetInst (* string: realm to copy/move to *) lvar ourSourceRealm (* string or dbref: realm to copy/move from *) lvar ourTargetRealm (* string or dbref: realm to copy/move to *) 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 (* confirm re-install *) ">> Reinstalling..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-realms" setprop RecOldActions (* create and register command; set default props *) #0 "+realm;+realms" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+realm" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+realm" 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/+realm" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "This utility is used to display the name of the Argo realm you " "currently are in. Staff members may also use it to create and remove " "realms." strcat strcat Tell " " Tell "Realms are areas within a MUCK that may have different Argo settings " "and definitions. The boundaries of realms are defined by the " "environment tree: a realm environment room and any rooms below it " "in the environment tree are considered part of a single realm." strcat strcat strcat Tell " " Tell " $com ..................... Show current realm" command @ "$com" subst Tell " $com #add ................ Make current room a realm env room (Staff)" command @ "$com" subst Tell " $com #remove ............. Remove realm defined on current room (Staff)" command @ "$com" subst Tell " " Tell "Staff members may also use the $com command to copy or move Argo " "database entries from one realm to another." strcat command @ "$com" subst Tell " " Tell " $com #copy =/,=/" command @ "$com" subst Tell " $com #move =/,=/" command @ "$com" subst Tell " " Tell " is the realm to copy from; is the realm to copy or " "move to. is the Argo database category of what you want to copy " "or move, such as 'skill' or 'object'. is the specific " "instance within this category, such as 'mechanic' or 'broadsword.'" strcat strcat strcat Tell ; : DoCreateRealm ( -- ) (* create a new realm *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then (* confirm *) ">> Please confirm: $room is to be the environment" loc @ name "$room" subst Tell " room for a new realm? (y/n)" Tell loc @ "@a/dataobj" getpropstr dup if " $realm realm." swap "$realm" subst ">> WARNING: Creating a new realm here will destroy all data for the" Tell Tell else pop then ReadYesNo not if ">> Aborted." Tell exit then (* get realm name *) ">> What is the name of this realm?" Tell ">> [Enter realm name, or .q to quit]" Tell ReadLine strip QCheck #0 "@a/realms" loc @ REF-add loc @ "@a/" RemoveDir-r loc @ "@a/dataobj" rot setprop (* set default sysparms *) ">> Setting default system parameters... " Tell #0 "@a/sysparms/" nextprop if #0 "@a/cat_list/" loc @ "@a/cat_list/" CopyDir-r #0 "@a/creatures/" loc @ "@a/creatures/" CopyDir-r #0 "@a/dis-ad/" loc @ "@a/dis-ad/" CopyDir-r #0 "@a/jobs/" loc @ "@a/jobs/" CopyDir-r #0 "@a/languages/" loc @ "@a/languages/" CopyDir-r #0 "@a/npcs/" loc @ "@a/npcs/" CopyDir-r #0 "@a/skills/" loc @ "@a/skills/" CopyDir-r #0 "@a/spells/" loc @ "@a/spells/" CopyDir-r #0 "@a/psiabs/" loc @ "@a/psiabs/" CopyDir-r #0 "@a/sysparms/" loc @ "@a/sysparms/" CopyDir-r #0 "@a/vehicles/" loc @ "@a/vehicles/" CopyDir-r ">> Copying +man data... " Tell #0 "@a/docs/" loc @ "@a/docs/" CopyDir-r else loc @ dup "@a/sysparms/auto_xp" "yes" setprop dup "@a/sysparms/cap_large_coin" "Silver piece" setprop dup "@a/sysparms/cap_large_coins" "Silver pieces" setprop dup "@a/sysparms/cap_small_coin" "Copper piece" setprop dup "@a/sysparms/cap_small_coins" "Copper pieces" setprop dup "@a/sysparms/character_approval" "yes" setprop dup "@a/sysparms/combat" "no" setprop dup "@a/sysparms/income_interval" "1 week" setprop dup "@a/sysparms/large_coin" "silver piece" setprop dup "@a/sysparms/large_coins" "silver pieces" setprop dup "@a/sysparms/magic" "no" setprop dup "@a/sysparms/max_disadvantages" "8" setprop dup "@a/sysparms/min_stats" "4" setprop dup "@a/sysparms/monitor" "Monitor" setprop dup "@a/sysparms/monitors" "Monitors" setprop dup "@a/sysparms/player_mods" "yes" setprop dup "@a/sysparms/psionics" "no" setprop dup "@a/sysparms/require_own" "yes" setprop dup "@a/sysparms/rumor_interval" "3 hours" setprop dup "@a/sysparms/small_coin" "copper piece" setprop dup "@a/sysparms/small_coins" "copper pieces" setprop dup "@a/sysparms/starting_points" "16" setprop dup "@a/sysparms/starting_large_coins" "1" setprop dup "@a/sysparms/starting_small_coins" "100" setprop dup "@a/sysparms/strict_disads" "no" setprop dup "@a/sysparms/tech_level" "4" setprop dup "@a/sysparms/turn_length" "30" setprop dup "@a/sysparms/vote_xp_given" "1" setprop dup "@a/sysparms/vote_interval" "1 week" setprop dup "@a/sysparms/votes_per_interval" "3" setprop dup "@a/sysparms/votes_required" "10" setprop dup "@a/cat_list/advantages" "Advantage" setprop dup "@a/cat_list/creatures" "Creature" setprop dup "@a/cat_list/disadvantages" "Disadvantage" setprop dup "@a/cat_list/groups" "Group" setprop dup "@a/cat_list/npcs" "Job" setprop dup "@a/cat_list/npcs" "NPC" setprop dup "@a/cat_list/psiabs" "Psiab" setprop dup "@a/cat_list/skills" "Skill" setprop dup "@a/cat_list/spells" "Spell" setprop dup "@a/cat_list/template" "Template" setprop pop then loc @ #0 "@a/calls/object" getprop if dup "@a/cat_list/objects" "Object" setprop dup "@a/cat_list/classes" "Class" setprop then dup "@a/sysparms/muck_version" version setprop pop ">> Realm created." Tell ; : DoDeleteRealm ( -- ) StaffCheck not if ">> Permission denied." Tell exit then loc @ "@a/dataobj" getpropstr dup if ">> Please confirm: You wish to remove the $realm realm? (y/n)" swap "$realm" subst Tell ReadYesNo if #0 "@a/realms" loc @ REF-delete loc @ "@a/dataobj" remove_prop loc @ "@a/" RemoveDir-r ">> Realm removed." Tell else ">> Aborted." Tell then else ">> You are not currently in a realm environment room." Tell ">> Cannot remove." Tell then ; : DoShowCopySyntax ( -- ) (* show syntax for #copy *) ">> Syntax: " Tell " " Tell " $command #copy =/,=/" Tell " " Tell " is the realm to copy from; is the realm to copy " "to. is the Argo database category of what you want to copy, " "such as 'skill' or 'object'. is the specific instance " "within this category, such as 'mechanic' or 'broadsword.'" strcat strcat strcat Tell ; : DoShowMoveSyntax ( -- ) (* show syntax for #move *) ">> Syntax: " Tell " " Tell " $command #move =/,=/" Tell " " Tell " is the realm to move from; is the realm to move " "to. is the Argo database category of what you want to move, " "such as 'skill' or 'object'. is the specific instance " "within this category, such as 'mechanic' or 'broadsword.'" strcat strcat strcat Tell ; : DoParseRealm ( s1 -- s2 s3 ) (* parse s1 into cat/inst string s2 and realm name string s3 *) dup "=" instr if dup "=" instr strcut strip swap strip dup strlen 1 - strcut pop strip else DoShowCopySyntax "" exit then ; : DoParseCatInst ( s1 -- s2 s3 ) (* parse s1 into instance string s2 and category string s3 *) dup "/" instr if dup "/" instr strcut strip swap strip dup strlen 1 - strcut pop strip else DoShowCopySyntax "" exit then ; : DoGetRealmDbref ( s -- d ) (* return env room dbref for realm s *) (* function nukes stack *) scratch ! #-1 ourBoolean ! (* ok, I'm not using it as a boolean *) #0 "@a/realms" REF-allrefs ourCounter ! begin ourCounter @ while dup "@a/dataobj" getpropstr dup if scratch @ smatch if dup ourBoolean ! then else pop then pop ourCounter @ 1 - ourCounter ! repeat ourBoolean @ ; : DoRealmCopy ( -- ) (* copy an argo db entry from realm to realm *) StaffCheck not if ">> Permission denied." Tell exit then ourArg @ not if DoShowCopySyntax exit then ourArg @ "," instr not ourArg @ "=" instr not or ourArg @ "/" instr not or if DoShowCopySyntax exit then ourArg @ dup "," instr strcut strip swap strip dup strlen 1 - strcut pop strip DoParseRealm dup if ourSourceRealm ! ourSourceCat ! else DoShowCopySyntax NukeStack exit then DoParseRealm dup if ourTargetRealm ! ourTargetCat ! else DoShowCopySyntax NukeStack exit then ourSourceCat @ DoParseCatInst dup if ourSourceCat ! ourSourceInst ! else DoShowCopySyntax NukeStack exit then ourTargetCat @ DoParseCatInst dup if ourTargetCat ! ourTargetInst ! else DoShowCopySyntax NukeStack exit then ourSourceRealm @ DoGetRealmDbref dup if ourSourceRealm ! else ">> Sorry, I can't find a realm named '$realm'." ourSourceRealm @ CapAll "$realm" subst Tell NukeStack exit then ourTargetRealm @ DoGetRealmDbref dup if ourTargetRealm ! else ">> Sorry, I can't find a realm named '$realm'." ourTargetRealm @ CapAll "$realm" subst Tell NukeStack exit then "advantages" ourSourceCat @ stringpfx if "@a/dis-ad/" else "creatures" ourSourceCat @ stringpfx if "@a/creatures/" else "disadvantages" ourSourceCat @ stringpfx if "@a/dis-ad/" else "groups" ourSourceCat @ stringpfx if "@a/groups/" else "jobs" ourSourceCat @ stringpfx if "@a/jobs/" else "npcs" ourSourceCat @ stringpfx if "@a/npcs/" else "objects" ourSourceCat @ stringpfx if "@a/objects/" else "psiabs" ourSourceCat @ stringpfx if "@a/psiabs/" else "skills" ourSourceCat @ stringpfx if "@a/skills/" else "spells" ourSourceCat @ stringpfx if "@a/spells/" else "templates" ourSourceCat @ stringpfx if "@a/tplates/" else ">> Sorry, category to copy from not found." Tell NukeStack exit then then then then then then then then then then then dup ourTargetCat ! ourSourceCat ! ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat over over "/" strcat nextprop rot rot getprop or not if ">> Sorry, instance to copy from not found." Tell NukeStack exit then ourSourceCat @ ourTargetCat @ smatch not if ">> Sorry, you can't copy from one category to another." Tell NukeStack exit then ourSourceInst @ CapAll ourSourceInst ! ourTargetInst @ CapAll ourTargetInst ! ourSourceRealm @ ourTargetRealm @ dbcmp ourSourceCat @ ourTargetCat @ smatch and ourSourceInst @ ourTargetInst @ smatch and if ">> Copied." Tell NukeStack exit then ourTargetRealm @ ourTargetCat @ ourTargetInst @ strcat ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat getprop setprop ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat "/" strcat ourTargetRealm @ ourTargetCat @ ourTargetInst @ strcat "/" strcat CopyDir-r ">> Copied." Tell ; : DoRealmMove ( -- ) (* move an argo db entry from realm to realm *) StaffCheck not if ">> Permission denied." Tell exit then ourArg @ not if DoShowCopySyntax exit then ourArg @ "," instr not ourArg @ "=" instr not or ourArg @ "/" instr not or if DoShowCopySyntax exit then ourArg @ dup "," instr strcut strip swap strip dup strlen 1 - strcut pop strip DoParseRealm dup if ourSourceRealm ! ourSourceCat ! else DoShowMoveSyntax NukeStack exit then DoParseRealm dup if ourTargetRealm ! ourTargetCat ! else DoShowMoveSyntax NukeStack exit then ourSourceCat @ DoParseCatInst dup if ourSourceCat ! ourSourceInst ! else DoShowMoveSyntax NukeStack exit then ourTargetCat @ DoParseCatInst dup if ourTargetCat ! ourTargetInst ! else DoShowMoveSyntax NukeStack exit then ourSourceRealm @ DoGetRealmDbref dup if ourSourceRealm ! else ">> Sorry, I can't find a realm named '$realm'." ourSourceRealm @ CapAll "$realm" subst Tell NukeStack exit then ourTargetRealm @ DoGetRealmDbref dup if ourTargetRealm ! else ">> Sorry, I can't find a realm named '$realm'." ourTargetRealm @ CapAll "$realm" subst Tell NukeStack exit then "advantages" ourSourceCat @ stringpfx if "@a/dis-ad/" else "creatures" ourSourceCat @ stringpfx if "@a/creatures/" else "disadvantages" ourSourceCat @ stringpfx if "@a/dis-ad/" else "groups" ourSourceCat @ stringpfx if "@a/groups/" else "jobs" ourSourceCat @ stringpfx if "@a/jobs/" else "npcs" ourSourceCat @ stringpfx if "@a/npcs/" else "objects" ourSourceCat @ stringpfx if "@a/objects/" else "psiabs" ourSourceCat @ stringpfx if "@a/psiabs/" else "skills" ourSourceCat @ stringpfx if "@a/skills/" else "spells" ourSourceCat @ stringpfx if "@a/spells/" else "templates" ourSourceCat @ stringpfx if "@a/tplates/" else ">> Sorry, category to copy from not found." Tell NukeStack exit then then then then then then then then then then then dup ourTargetCat ! ourSourceCat ! ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat over over "/" strcat nextprop rot rot getprop or not if ">> Sorry, instance to move not found." Tell NukeStack exit then ourSourceCat @ ourTargetCat @ smatch not if ">> Sorry, you can't move from one category to another." Tell NukeStack exit then ourSourceInst @ CapAll ourSourceInst ! ourTargetInst @ CapAll ourTargetInst ! ourSourceRealm @ ourTargetRealm @ dbcmp ourSourceCat @ ourTargetCat @ smatch and ourSourceInst @ ourTargetInst @ smatch and if ">> Moved." Tell NukeStack exit then ourTargetRealm @ ourTargetCat @ ourTargetInst @ strcat ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat getprop setprop ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat "/" strcat ourTargetRealm @ ourTargetCat @ ourTargetInst @ strcat "/" strcat CopyDir-r ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat remove_prop ourSourceRealm @ ourSourceCat @ ourSourceInst @ strcat RemoveDir-r ">> Moved." Tell ; : DoShowRealm ( -- ) (* show name of current realm *) ">> You are currently in the $realm realm." ourDataObj @ "@a/dataobj" getpropstr "$realm" subst Tell ; : DoListRealms ( -- ) (* list configured realms *) ">> CONFIGURED REALMS:" Tell " " Tell #0 "@a/realms" REF-allrefs ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourArg @ if ourArg @ "#" stringpfx if ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourArg ! strip ourOption ! else ourArg @ strip ourOption ! then "#help" ourOption @ stringpfx if DoHelp else "#enable" ourOption @ stringpfx if DoEnable else "#disable" ourOption @ stringpfx if DoDisable else "#version" ourOption @ stringpfx if DoVersion else "#install" ourOption @ stringpfx if DoInstall else "#uninstall" ourOption @ stringpfx if DoUninstall else Disabled? "#list" ourOption @ stringpfx if DoListRealms else "#add" ourOption @ stringpfx if DoCreateRealm else "#copy" ourOption @ stringpfx if DoRealmCopy else "#move" ourOption @ stringpfx if DoRealmMove else "#remove" ourOption @ stringpfx if DoDeleteRealm else ">> #Argument not understood." Tell then then then then then then then then then then then exit else DoShowRealm then else DoShowRealm then ; . c q @set asys-realms=W