@q
@program asys-wimpout
1 999999 d
i
( asys-wimpout    v1.2    Jessy@FurryMUCK    6/00
   
  This program controls Argo's +wimpout command, which is used to set
  a 'wimp out number'... A damage level at which characters will
  automatically flee combat.
  
  INSTALLATION:
  
  asys-wimpout uses the standard Argo installation method. Port the
  program and set it Wizard. Type '+install asys-wimpout'
  
  USAGE:
    
    +wimpout ................... Show your wimp out number
    +wimpout <number> .......... Set your wimp out number to <number>
    +wimpout #clear ............ Clear your wimpout number
   
  asys-wimpout 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 ourCom                     (* string: 'official' name of command *)
lvar ourBoolean                         (* int: misc flow control 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-wimpout" setprop
  RecOldActions
  
                    (* create and register command; set default props *)
  #0 "+wimpout;+wimp out;+wimp" newexit dup scratch ! 
  prog setlink
  prog "@a/version" thisVersion setprop
  scratch @ "@a/version" thisVersion setprop
  #0 "@a/comm_list/+wimpout" scratch @ setprop
  #0 "@a/prog_list/" prog name strcat prog setprop
  scratch @ "@a/name" "+wimpout" 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/+wimpout"   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 command is used to set your 'wimp out' number. If combat "
  "reduces your Damage Level to or below your wimp out number, you "
  "will immediately choose a random exit and bravely run away, "
  "terminating combat. Note that if a large amount of damage is "
  "dealt to you in a single combat event, it is still possible to "
  "die in combat even with a wimp out number set."
  strcat strcat strcat strcat strcat Tell " " Tell
  
  "Syntax:" Tell " " Tell
  
  "  $com ................... Show your wimp out number" 
  command @ "$com" subst Tell
  "  $com <number> .......... Set your wimp out number to <number>"
  command @ "$com" subst Tell 
  "  $com #clear ............ Clear your wimp out number"
  command @ "$com" subst Tell " " Tell
;
 
: DoSetWimpOut  (  --  )                     (* set a wimp out number *)
  
  ourArg @ number? if
    me @ "@a/stats/wimpout" ourArg @ setprop
    ">>  Your wimp out number is now set to $num."
    ourArg @ "$num" subst Tell
  else
    ">>  Syntax:  $command <number>"
    command @ "$command" subst Tell
    ">> ('$arg' isn't a number.)"
    ourArg @ "$arg" subst Tell
  then
;
 
: DoShowWimpOut  (  --  )           (* display user's wimp out number *)
  
  me @ "@a/stats/wimpout" getpropstr dup if
    ">>  Your wimp out number is set to $num."
    swap "$num" subst Tell
  else
    ">>  You do not have a wimp out number set." Tell pop 
  then
;
 
: DoWimpOut  (  --  )                                        (* route *)
  
  ourArg @ if
    DoSetWimpOut
  else
    DoShowWimpOut
  then
;
  
: DoClear  (  --  )                          (* clear wimp out number *)
  
  me @ "@a/stats/wimpout" remove_prop
  ">>  Wimp out number cleared." 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
      "#clear"     ourArg @ stringpfx if DoClear     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 then
      exit
    then
  then
  
  me @ ArgoPermCheck
  
  Disabled?
   
  DeadCheck
  
  DoWimpOut
;
.
c
q
@set asys-wimpout=W