@q
@program asys-psionics
1 99999 d
i
( asys-psionics    v1.2    Jessy@FurryMUCK    6/00
   
  This program handles psiab-related commands and events. 
  
  INSTALLATION:
  
  asys-psionics uses the standard Argo installation method. Port the
  program and set it Wizard. Type '+install asys-psionics'
  
  USAGE:
    
    +focus <psiab> [at|on|versus|vs] [<target>]
  
  asys-psionics may be freely ported. Please comment any changes.
)
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
$def thisVersion "1.2"
  
$define Tell me @ owner swap notify $enddef
 
$define 
  VerifyEvent caller #0 "@a/calls/eventloop" getprop dbcmp not if
    ">>  This routine must be called from asys-eventmgr."
    me @ swap notify 0 exit
  then
$enddef
 
$include $lib/argo
  
lvar namestr                 (* string: notify format with spell name *)
lvar nonamestr            (* string: notify format with no spell name *)
lvar ourArg                          (* inital arg string, unmodified *) 
lvar ourAttackVal                    (* int: amound user made roll by *)
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 ourMaterial                 (* dbref: material object to be used *)
lvar ourString                                  (* string: psiab prop *)
lvar ourPsiab                        (* string: psiab name, formatted *)
lvar ourTarget                       (* dbref: object we're targeting *)
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-psionics" setprop
  RecOldActions
  
                    (* create and register command; set default props *)
  #0 "+focus" newexit dup scratch ! 
  prog setlink
  prog "@a/version" thisVersion setprop
  scratch @ "@a/version" thisVersion setprop
  #0 "@a/comm_list/+focus" scratch @ setprop
  #0 "@a/prog_list/" prog name strcat prog setprop
  scratch @ "@a/name" "+focus" 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/+focus"   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
  
;
 
: DoPsiabTargetTell  (  --  )(* notify target that something happened *)
  
  ourTarget @ ourString @ GetModAbility if
    me @ name  "$me" subst
    ourPsiab @ "$psiab" subst 
    "on you "  "$target" subst
    "'s" " 's" subst 
    " " "  "   subst
    ">> " ">>" subst
    "." " ."   subst 
    ourTarget @ swap notify exit
  then
  
  ourTarget @ "@a/skills/perception" GetModAbility
  ourTarget @ "@a/dis-ad/psionic aptitude" GetModAbility or if
    me @ name  "$me" subst
    "a psionic ability" "$psiab" subst 
    "on you "  "$target" subst
    "'s" " 's" subst 
    " " "  "   subst
    ">> " ">>" subst
    "." " ."   subst 
    ourTarget @ swap notify exit
  else
    "Someone"  "$me" subst
    "a psionic ability" "$psiab" subst 
    "on you "  "$target" subst
    "'s" " 's" subst 
    " " "  "   subst
    ">> " ">>" subst
    "." " ."   subst 
    ourTarget @ swap notify exit
  then
;
  
: DoPsiabTell  ( s --  )             (* notify room with psiab result *)
               (* mages who know the psiab will see what psiab it was *)
                                    (* others will just see 'a psiab' *)
  
  me @ name "$me" subst
  me @ ourTarget @ dbcmp if
    "" "$target" subst
  else
    "on " ourTarget @ name strcat " " strcat "$target" subst
  then
  
  dup "a psiab" "$psiab" subst 
  "'s" " 's" subst
  " " "  "   subst
  ">> " ">>" subst
  "." " ."   subst nonamestr !
  
  ourPsiab @ "$psiab" subst 
  "'s" " 's" subst
  " " "  "   subst 
  ">> " ">>" subst
  "." " ."   subst namestr !
  
  "@a/psiabs/" ourPsiab @ strcat ourString !
  
  me @ location contents
  begin
    dup while
    dup "@a/version" getpropstr if
      dup ourTarget @ dbcmp not if
        dup "@a/dis-ad/psionic aptitude" getpropstr 
        over "@a/skills/perception" getpropstr or if
          dup "@a/stats/int" GetModAbility
          over "@a/skills/perception" GetModAbility +
          over "@a/skills/mental discipline" GetModAbility +
          3 6 0 Dice >= if
            dup ourString @ GetModAbility if
              dup namestr @ 
            else
              dup nonamestr @
            then
          else
            dup nonamestr @ 
          then
          over "@a/veron" getpropstr if
            over "@a/verstring" getpropstr strcat
          then
          notify
        then
      then
    then
    next
  repeat
  pop
;
 
: DoCritSucc  (  --  ) (* notify room: null psiab succeeded criticaly *)
  
  ourTarget @ me @ dbcmp if
    ">>  $me successfully focuses the $psiab psiab. [CRITICAL]"
    me @ name "$me" subst TellRoom
    ourPsiab @ CapAll subst TellRoom
  else
    ">>  $me successfully focuses $psiab on $you. [CRITICAL]"
    me @ name "$me" subst
    ourTarget @ "$you" subst 
    ourPsiab @ CapAll subst TellRoom
  then
;
 
: DoCritFail  (  --  )    (* notify room: null psiab failed criticaly *)
  
  ourTarget @ me @ dbcmp if
    ">>  $me's attempt to focus $psiab fails. [CRITICAL]"
    me @ name "$me" subst TellRoom
    ourPsiab @ CapAll subst TellRoom
  else
    ">>  $me's attempt to focus $psiab on $you fails. [CRITICAL]"
    me @ name "$me" subst
    ourTarget @ "$you" subst 
    ourPsiab @ CapAll subst TellRoom
  then
;
 
: DoFocusNull  (  --  )          (* run a psiab with no coded effects *)
  
  me @ "@a/eloop/psiab" getpropstr dup if
    "@a/psiabs/" swap strcat scratch !
  
    me @ scratch @ GetModAbility if
      3
    else
      4
    then
    6 0 Dice
  
    dup 4  <= if DoCritSucc NukeStack exit then
    dup 17 >= if DoCritFail NukeStack exit then
  
    ourDataObj @ scratch @ getpropstr dup if
      dup "," instr 1 - strcut pop
      dup "phy" smatch if pop me @ GetPhysSkill  atoi else
      dup "phy" smatch if pop me @ GetCraftSkill atoi else
      me @ "@a/stats/" rot strcat GetModAbility
      then then
      me @ "@a/eloop/genmod" getpropstr atoi +
      me @ scratch @ GetModAbility +
      <= if
        me @ "@a/eloop/target" getprop me @ dbcmp not if
          ">>  $me successfully focuses $psiab on $you."
          me @ name "$me" subst
          me @ "@a/eloop/target" getprop name "$you" subst
          me @ "@a/eloop/psiab" getpropstr 
          CapAll "$psiab" subst TellRoom
        else
          ">>  $me successfully focuses the $psiab psiab."
          me @ name "$me" subst
          me @ "@a/eloop/psiab" getpropstr 
          CapAll "$psiab" subst TellRoom
        then
      else
        me @ "@a/eloop/target" getprop me @ dbcmp not if
          ">>  $me's attempt to focus $psiab on $you fails."
          me @ name "$me" subst
          me @ "@a/eloop/target" getprop name "$you" subst
          me @ "@a/eloop/psiab" getpropstr 
          CapAll "$psiab" subst TellRoom
        else
          ">>  $me's attempt to focus $psiab fails."
          me @ name "$me" subst
          me @ "@a/eloop/psiab" getpropstr 
          CapAll "$psiab" subst TellRoom
        then
      then
    else
      pop pop
    then
  
  else
    pop
  then
  
  TellWait
;
 
: DoParseArgs   (  --  )        (* parse command args; store in lvars *)
  
  ourArg @ "'s " instr if
    ourArg @ "" "'s" subst
    dup " " rinstr strcut strip 
    me @ "@a/eloop/subtarget" 
    rot setprop
    strip ourArg !
  then
  
  ourArg @ "$~$" " at "     subst ourArg !   (* mark target delimeter *)
  ourArg @ "$~$" " on "     subst ourArg !
  ourArg @ "$~$" " vs "     subst ourArg !
  ourArg @ "$~$" " versus " subst ourArg !
  
  ourArg @ ""  "."          subst ourArg !            (* clean string *)
  ourArg @ ""  "'"          subst ourArg !
  ourArg @ ""  ","          subst ourArg !
  
  ourArg @ "$~$" rinstr if                      (* tokenize if needed *)
    ourArg @ "$~$" explode
    2 = not if
      ">>  Syntax: $com [at|on|vs <target>]"
      command @ "$com" subst Tell NukeStack pid kill
    then
    strip ourString !
    strip ourTarget !
  else
    ourArg @ ourString !
  then

	ourString @ not if
	  ">>  Syntax: $com <spell> at|on|vs <target>"
		command @ "$com" subst Tell 0 exit
	then
  
  ourTarget @ not if
    "me" ourTarget !
  then
                                                      (* verify psiab *)
  ourDataObj @ "@a/psiabs/" ourString @ strcat getprop not if
    ">>  Psiab '$psiab' not found." 
    ourString @ Capitalize "$psiab" subst Tell 0 exit
  then
  
  me @ "@a/psiabs/" ourString @ strcat GetModAbility not if
    ">>  You don't know how to do that." Tell 0 exit
  then
  
  ourDataObj @ "@a/psiabs/$psiab/nodef" 
  ourString @ "$psiab" subst getpropstr
  me @ "@a/psiabs/" ourString @ strcat GetModAbility not and if
    ">>  You don't know how to do that." Tell 0 exit
  then
  
  ourDataObj @ "@a/psiabs/" nextprop
  begin
    dup while
    dup "" "@a/psiabs/" subst ourString @ smatch not while
    ourDataObj @ swap nextprop
  repeat
  dup if
    "" "@a/psiabs/" subst ourPsiab !
  else
    ">>  Psiab '$psiab' not found."
    ourString @ Capitalize "$psiab" subst Tell pop 0 exit
  then
  
  "@a/psiabs/" ourString @ strcat ourString !
  
  ourTarget @ if
    ourDataObj @ "@a/psiabs/$psiab/nonlocal"
    ourPsiab @ "$psiab" subst getpropstr if
      online ourCounter !
      begin
        ourCounter @ while
        dup name ourTarget @ smatch if
          ourTarget ! break
        else
          pop
        then
        ourCounter @ 1 - ourCounter !
      repeat
      NukeStack
      ourTarget @ string? if
        ">>  Target not found." Tell 0 exit
      then
      ourTarget @ CheckIdle
      ourTarget @ "@a/version" getpropstr not or
      ourTarget @ "@a/combat" getpropstr not or if
        ">>  $player is not a valid target." 
        ourTarget @ name "$player" subst Tell 0 exit
      then
      ourTarget @ "@a/ic" envpropstr pop not if
        ">>  $player is not in an IC area."
        ourTarget @ name "$player" subst Tell
        ">>  Cannot target." Tell 0 exit
      then
    else
      ourTarget @ FindOther ourTarget !
      ourTarget @ VerifyTarget not if
        ">>  $name is not a valid target."
        ourTarget @ name "$name" subst Tell NukeStack 0 exit
      then
    then
  then
  
  me @ "@a/stats/con" GetModAbility 
  me @ "@a/stats/str" GetModAbility +
  me @ GetEnduranceAdv + dup -1 * swap
  me @ "@a/stats/fat" getpropstr atoi - 
  ourDataObj @ ourString @ "/fat" strcat getpropstr atoi - 
  > if
    ">>  You don't have the energy to use $psiab right now."
    ourPsiab @ "$psiab" subst Tell 0 exit
  then
  1
;
 
: DoFocus  (  --  )         (* go parse cmd args; initiate event loop *)
  
  DoParseArgs not if exit then
  
  me @ "@a/eloop/act"
  #0 "@a/calls/focus" ourPsiab @ strcat getprop not if
    "focusnull"
  else
    "focus" ourPsiab @ tolower strcat 
  then
  setprop
  me @ "@a/eloop/psiab"   ourPsiab @           setprop
  me @ "@a/eloop/acting" "preparing an action" setprop
  me @ "@a/eloop/target"  ourTarget @          setprop
  ">>  Preparing action..." Tell
  EventLoop
;
 
: main
  
  "me" match me !                                       (* initialize *)
  GetDataObj ourDataObj !
  strip ourArg !
  trig "@a/name" getpropstr ourCom !
  Update
  me @ "@a/eloop/subtarget" remove_prop
  
  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
  
  Psionics?
  
  Approved? 
  
  me @ ArgoPermCheck
  
  Disabled?
  
  DoFocus
;
.
c
q
@set asys-psionics=W