@q @program asys-shift 1 99999 d i ( asys-shift v1.2 Jessy @ FurryMUCK 6/97, 11/99 The +shift command is used by players with the Shapeshifting advantage to change between two forms. INSTALLATION: Set asys-shift W and type '+install asys-shift'. USAGE: +shift
................ Shift to form +shift #list ................. List form names, show current +shift #rename = ... Change name of form to +shift #desc .......... Set a desc for form +shift #desc #clear .......... Clear all +shift descs +shift #desc #reset .......... Go back to original desc asys-shift may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo lvar scratch (* workspace var *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourArg (* inital arg string, unmodified *) lvar ourOpt (* string: #option string *) lvar ourCom (* string: 'official' name of command *) lvar ourBoolean (* int: misc flow control var *) lvar ourForm (* string: prop for form we're handling *) : 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-shift" setprop RecOldActions (* create and register command; set default props *) #0 "+shift" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+shift" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+shift" setprop (* set the prop for this coded dis-ad *) ourDataObj @ "@a/dis-ad/Shapeshifting" "3" 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/+shift" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions ourDataObj @ "@a/dis-ad/Shapeshifting" remove_prop ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoHelp ( -- ) (* display help screen *) " " Tell "asys-shift \(#" prog intostr strcat "\)" strcat Tell " " Tell "The $command command allows characters with the Shapeshifting " "advantage to switch between two forms, and to manage settings " "for form descs. The two forms may have independent stats, skills, " "etc. Each form is alloted the standard starting allotment of " "character development points, minus the cost of the Shapeshifting " "advantage ($cost). Changes made to your +background only apply to " "the form you are in at the time the change is made." strcat strcat strcat strcat strcat strcat command @ "$command" subst ourDataObj @ "@a/dis-ad/Shapeshifting" getpropstr "$cost" subst Tell " " Tell "Syntax:" Tell " " Tell " $command ................ Shift to form " command @ "$command" subst Tell " $command #list ................. List form names, show current" command @ "$command" subst Tell " $command #rename = ... Change name of form to " command @ "$command" subst Tell " $command #desc .......... Set a desc for form " command @ "$command" subst Tell " $command #desc #clear .......... Clear all +shift descs" command @ "$command" subst Tell " $command #desc #reset .......... Go back to original desc" command @ "$command" subst Tell " " Tell ; : DoCheckShifting ( -- ) (* check: user has shapeshifting? *) (* notify and kill process if not *) me @ "@a/dis-ad/shapeshifting" getprop not if ">> Sorry, you don't have the Shapeshifting advantage." Tell pid kill then ; : DoResetDesc ( -- ) (* go back to pre-+shift desc *) me @ "_prefs/argo/prevdesc" getpropstr if me @ dup "_prefs/argo/prevdesc" getprop setdesc ">> Your desc has been reset to its original setting." Tell else ">> Sorry, no previous desc stored!" Tell then ; : DoClearDescs ( -- ) (* remove +shift descs *) (* reset to old desc, if we have one *) me @ dup "_prefs/argo/prevdesc" getprop setdesc me @ "@a/shapes/" nextprop begin (* loop through +shift descs, remove *) dup while dup "@a/shapes/current" smatch not if me @ "_prefs/argo/$formdesc#/" 3 pick "" "@a/shapes/" subst "$form" subst RemoveDir me @ "_prefs/argo/$formdesc#" 3 pick "" "@a/shapes/" subst "$form" subst remove_prop then me @ swap nextprop repeat pop (* notify if we don't have a prev desc to reset to *) ">> +shift descs removed." Tell me @ "_/de" getpropstr not if ">> NOTE: You did not have a previous desc stored." Tell ">> You do not currently have a desc." Tell then ; : DoList ( -- ) (* show current form names *) ">> Your form names:" Tell " " Tell me @ "@a/shapes/" nextprop begin (* loop through forms *) dup while dup "@a/shapes/current" smatch not if dup "" "@a/shapes/" subst " " swap strcat me @ "@a/shapes/current" getpropstr dup if 3 pick "" "@a/shapes/" subst smatch if (* mark current form *) " <--- Current" strcat then else pop then Tell (* list form name *) then me @ swap nextprop repeat pop ; : DoDesc ( -- ) (* set a desc for form ourArg *) Disabled? (* check permission *) me @ ArgoPermCheck DoCheckShifting ourArg @ CapAll ourArg ! (* format form name *) "#reset" ourArg @ stringpfx if (* check: user wants to reset? *) DoResetDesc exit then (* check: user wants to clear descs? *) "#clear" ourArg @ stringpfx if DoClearDescs exit then (* check: does user have named desc? *) me @ "@a/shapes/" ourArg @ strcat "/" strcat nextprop if "@a/shapes/" ourArg @ strcat ourForm ! else ">> Sorry, you don't have $form form." ourArg @ A-An "$form" subst Tell exit then (* edit form desc *) me @ "_prefs/argo/$formdesc" ourArg @ "$form" subst EditList (* bail out if user .aborted, and we have no desc to work with *) me @ "_prefs/argo/$formdesc" ourArg @ "$form" subst nextprop not if exit then (* store pre +shift desc if we haven't already *) me @ "_prefs/argo/prevdesc" getprop not if me @ "_prefs/argo/prevdesc" me @ "_/de" getpropstr setprop ">> Your previous description string is stored under prop" Tell ">> _prefs/argo/prevdesc" Tell then (* see if other forms need descs; remind if so *) me @ "@a/shapes/" nextprop begin dup while dup "@a/shapes/current" smatch not if dup "_prefs/argo/" "@a/shapes/" subst "desc#/" strcat me @ over nextprop not if pop ">> NOTE: You may wish to also set a desc for your $form form." over dup "/" rinstr strcut swap pop "$form" subst Tell ">> If you do not, your previous desc will be used for that form." Tell else pop then then me @ swap nextprop repeat pop (* use new desc if applicable *) me @ "_prefs/argo/$formdesc#/" me @ "@a/shapes/current" getpropstr "$form" subst nextprop if me @ "{eval:{list:_prefs/argo/$formdesc,this}}" me @ "@a/shapes/current" getpropstr "$form" subst setdesc then ; : DoRename ( -- ) (* rename form ourArg *) Disabled? (* check permission *) me @ ArgoPermCheck DoCheckShifting ourArg @ "=" instr if (* check syntax *) ourArg @ "=" explode 2 = if strip CapAll (* format form name *) (* check: does user have the named form? *) me @ "@a/shapes/" 3 pick strcat "/" strcat nextprop not if ">> You don't have a $form form." swap "$form" subst Tell pop exit then (* check: is user trying to use 'current' as a form name? *) (* this would conflict with the @a/shapes/current prop *) "@a/shapes/" swap strcat ourForm ! CapAll dup "current" smatch if ">> Sorry, the string 'Current' is used by this program." Tell ">> Please chose a different name." Tell pop exit else "@a/shapes/" swap strcat scratch ! then (* move form data to new propdir *) me @ scratch @ me @ ourForm @ getprop setprop me @ ourForm @ "/" strcat me @ scratch @ "/" strcat MoveDir-r me @ ourForm @ remove_prop (* reset current form to new name if applicable *) me @ "@a/shapes/current" ourForm @ "" "@a/shapes/" subst smatch if me @ "@a/shapes/current" scratch @ "" "@a/shapes/" subst setprop then (* move +shift desc to new name if needed *) me @ "_prefs/argo/$form2desc#" scratch @ "" "@a/shapes/" subst "$form2" subst me @ "_prefs/argo/$form1desc#" ourForm @ "" "@a/shapes/" subst "$form1" subst getprop setprop me @ "_prefs/argo/$form1desc#/" ourForm @ "" "@a/shapes/" subst "$form1" subst me @ "_prefs/argo/$form2desc#/" scratch @ "" "@a/shapes/" subst "$form2" subst MoveDir me @ "_prefs/argo/$form1desc#" ourForm @ "" "@a/shapes/" subst "$form1" subst remove_prop (* reset desc to new form name if applicable *) me @ "@a/shapes/current" getpropstr dup if ourForm @ "" "@a/shapes/" subst smatch if me @ "@a/shapes/current" scratch @ setprop me @ "_prefs/argo/$formdesc#/" scratch @ "$form" subst nextprop if me @ "{eval:{list:_prefs/argo/$formdesc,this}}" scratch @ "$form" subst setdesc then then else pop then (* notify with results *) ">> The name for your '$form1' form has been changed to '$form2'." ourForm @ "" "@a/shapes/" subst "$form1" subst scratch @ "" "@a/shapes/" subst "$form2" subst Tell else ">> Syntax: $command #rename = " command @ "$command" subst Tell then else ">> Syntax: $command #rename = " command @ "$command" subst Tell then ; : DoShift ( -- ) (* shift user to specified form *) Disabled? (* check permission *) me @ ArgoPermCheck DoCheckShifting (* check: did user specify a form? *) ourArg @ not if ">> Syntax: $command " command @ "$command" subst Tell exit then (* if we have a propdir for named form, copy data to active Argo propdir *) me @ "@a/shapes/" ourArg @ strcat "/" strcat nextprop if (* format propdir and form name, store *) ourArg @ CapAll ourArg ! "@a/shapes/" me @ "@a/shapes/current" getpropstr strcat "/" strcat ourForm ! me @ ourForm @ "/avail/" strcat RemoveDir-r me @ ourForm @ "/dis-ad/" strcat RemoveDir-r me @ ourForm @ "/psiabs/" strcat RemoveDir-r me @ ourForm @ "/skills/" strcat RemoveDir-r me @ ourForm @ "/spells/" strcat RemoveDir-r me @ ourForm @ "/stats/" strcat RemoveDir-r me @ ourForm @ "/disad_total/" strcat RemoveDir-r me @ ourForm @ "/stats" strcat remove_prop me @ ourForm @ "/avail" strcat remove_prop me @ "@a/avail/" me @ ourForm @ "/avail/" strcat CopyDir-r me @ "@a/dis-ad/" me @ ourForm @ "/dis-ad/" strcat CopyDir-r me @ "@a/psiabs/" me @ ourForm @ "/psiabs/" strcat CopyDir-r me @ "@a/skills/" me @ ourForm @ "/skills/" strcat CopyDir-r me @ "@a/spells/" me @ ourForm @ "/spells/" strcat CopyDir-r me @ "@a/stats/" me @ ourForm @ "/stats/" strcat CopyDir-r me @ "@a/disad_total" me @ ourForm @ "/disad_total" strcat CopyProp me @ "@a/status" me @ ourForm @ "/status" strcat CopyProp me @ "@a/bg/" me @ "@a/shapes/$current/bg/" me @ "@a/shapes/current" getpropstr "$current" subst over over RemoveDir-r CopyDir-r "@a/shapes/" ourArg @ strcat ourForm ! me @ "@a/avail/" RemoveDir-r (* remove current settings *) me @ "@a/dis-ad/" RemoveDir-r me @ "@a/skills/" RemoveDir-r me @ "@a/spells/" RemoveDir-r me @ "@a/psiabs/" RemoveDir-r me @ "@a/stats/" RemoveDir-r me @ "@a/bg/" RemoveDir-r me @ "@a/disad_total" remove_prop me @ "@a/status" remove_prop (* copy new settings to active propdir *) me @ ourForm @ "/avail/" strcat me @ "@a/avail/" CopyDir me @ ourForm @ "/dis-ad/" strcat me @ "@a/dis-ad/" CopyDir me @ ourForm @ "/psiabs/" strcat me @ "@a/psiabs/" CopyDir me @ ourForm @ "/skills/" strcat me @ "@a/skills/" CopyDir me @ ourForm @ "/spells/" strcat me @ "@a/spells/" CopyDir me @ ourForm @ "/stats/" strcat me @ "@a/stats/" CopyDir me @ ourForm @ "/bg/" strcat me @ "@a/bg/" CopyDir-r me @ ourForm @ "/disad_total" strcat me @ "@a/disad_total" CopyProp me @ ourForm @ "/status" strcat me @ "@a/status" CopyProp (* set prop indicating current form *) me @ "@a/shapes/current" ourArg @ setprop (* change into form desc if needed *) me @ "_prefs/argo/$formdesc#/" ourArg @ "$form" subst nextprop if me @ "{eval:{list:_prefs/argo/$formdesc,this}}" ourArg @ "$form" subst setdesc else me @ "_prefs/argo/prevdesc" getpropstr if me @ dup "_prefs/argo/prevdesc" getpropstr setdesc then then (* notify with results *) ">> You assume your $form form." ourArg @ "$form" subst Tell else ">> Form $form not found." ourArg @ "$form" subst Tell then ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! trig "@a/name" getpropstr ourCom ! Update dup if dup "#*" smatch if dup " " instr if dup " " instr strcut strip ourArg ! strip ourOpt ! else strip dup ourOpt ! ourArg ! then "#help" ourOpt @ stringpfx if DoHelp else "#desc" ourOpt @ stringpfx if DoDesc else "#rename" ourOpt @ stringpfx if DoRename else "#list" ourOpt @ stringpfx if DoList else "#enable" ourOpt @ stringpfx if DoEnable else "#disable" ourOpt @ stringpfx if DoDisable else "#version" ourOpt @ stringpfx if DoVersion else "#install" ourOpt @ stringpfx if DoInstall else "#uninstall" ourOpt @ stringpfx if DoUninstall else ourOpt @ ourArg ! DoHelp then then then then then then then then then exit else strip ourArg ! then then Disabled? DeadCheck DoShift ; . c q @set asys-shift=W