@q
@program asys-sheet
1 99999 d
i
( asys-sheet    v1.2    Jessy @ FurryMUCK    6/97, 2/99
  
  asys-sheet runs Argo +sheet command, displaying a player's Argo
  game system character sheet.
  
  INSTALLATION:
  
  asys-sheet uses the default Argo installation method. Port and install
  lib-argo. Set asys-sheet W. Type '+install asys-sheet' to install
  this program and its actions.
  
  See lib-argo and the Argo manual for further information.
  
  asys-sheet may be freely ported. Please comment any changes.
)
 
$def thisVersion "1.2"
 
$include $lib/reflist
$include $lib/argo
 
$define Tell me @ owner swap notify $enddef
 
lvar ourArg                    (* original arg to trigger, unmodified *)
lvar scratch                                         (* workspace var *)  
lvar ourPlayer                 (* holds dbref player in consideration *)
lvar ourCounter                                        (* counter var *) 
lvar ourDataObj             (* dbref: object holding system-wide data *)
lvar ourBoolean                         (* misc. decision control var *) 
lvar ourCom                     (* string: 'official' name of command *)
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
: 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-sheet" setprop
  RecOldActions
  
  #0 "+sheet" newexit dup scratch !                (* create command *)
  prog setlink
  prog "@a/version" thisVersion setprop               (* set version *)
  scratch @ "@a/version" thisVersion setprop
  #0 "@a/comm_list/+sheet" scratch @ setprop  (* register command *)
  #0 "@a/prog_list/" prog name strcat prog setprop
  scratch @ "@a/name" "+sheet" 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/+sheet"   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
  "asys-sheet \(#" prog intostr strcat "\)" strcat Tell
  " " Tell
  
  "The " command @ strcat
  " command displays your Argo character sheet, with current values. "
  "If you have never used Argo before, default values are set and "
  "displayed. Non-staff players may only display their own sheet; "
  "staff players may display their own or another player's sheet."
  strcat strcat strcat strcat Tell " " Tell
  
  "See the Argo manual for further information." Tell
;
 
: DoSheet  ( [s]  --  )   
  
                 (* display char sheet of player s; defaults to user *)
   
  ourArg @ if                                         (* find player *)
    StaffCheck if
      ourArg @ .pmatch dup if
        ourPlayer !
        ourPlayer @ "@a/version" getprop not if
           ">>  " ourPlayer @ name strcat 
           " is not an Argo player." strcat Tell exit
        then
      else
        ourArg @ match
        dup if
          dup #-2 dbcmp not if
            dup "Z" flag? if
              dup "@a/stats/dex" getpropstr if
                ourPlayer !
              else
                ">>  Player not found." Tell pop pid kill
              then
            else
              ">>  Player not found." Tell pop pid kill
            then
          else
            ">>  Player not found." Tell pop pid kill
          then
        else
          ">>  Player '" ourArg @ strcat "' not found." strcat 
          Tell pop exit 
        then
      then
    else
      ">>  You may only display your own character sheet." Tell exit
    then
  else
    me @ ourPlayer !
  then
  
  me @ "@a/version" getpropstr not if
    CheckCGRoom not if
  "    MUCK."
  "    to do this. Afterwards, you can use this command anywhere on the"
  "    default Argo values. You need to be in a designated setup room"
  ">>  Using this command for the first time sets your characters with" 
      Tell Tell Tell Tell exit
    then
  then
  
  ourPlayer @ me @ dbcmp      (* set user with default vals if needed *)
  me @ "@a/version" getprop not and if
    ">>  Setting your character with default Argo values.... " Tell
    me @ SetArgoDefaults  
  then
                                              (* display sheet header *)
  "-------------------------------------------------------------------"
  loc @ "@a/ic" envpropstr pop if
    "-IC--"
  else
    "OOC--"
  then
  strcat Tell
  ourPlayer @ name 
  ourPlayer @ "@a/status" getpropstr
  dup not if
    ourPlayer @ "@a/status" "na" setprop "na"
  then
  "approved"  over smatch if pop " (a)"  else
  "na"        over smatch if pop " (na)" else
  "dead"      over smatch if pop " (d)"  else
  "suspended" over smatch if pop " (s)"
  then then then then
  strcat 22 Pad
  ourPlayer @ "@a/tplates" getpropstr if
    ourPlayer @  "@a/tplates" getpropstr
    ";;" explode dup 2 = if
      pop swap pop strip
    else
      dup 2 > if
        "" scratch !
        begin
          dup 2 > while
          swap strip "," strcat scratch @ swap strcat scratch !
          1 -
        repeat
        pop swap pop
        scratch @ swap strcat
      else
        ourPlayer @ "species" getpropstr
      then
    then
    strcat 50 pad
  else
    ourPlayer @ "species" getpropstr strcat 50 pad
  then
  ourPlayer @ "sex" getpropstr strcat 60 pad Tell
  Line72 
                       (* calculate current physical and craft skills *)
  
                    (* display STR, and STR+Mod if different than STR *)
  "STR: " ourPlayer @ "@a/stats/str" getpropstr 2 LPad strcat
  ourPlayer @ "@a/stats/str_mod" getpropstr atoi dup if
    ourPlayer @ "@a/stats/str" getpropstr atoi +
    intostr "/" swap strcat strcat
  else
    pop
  then
                                    (* display current physical skill *)
  22 Pad
  "Physical Skill:   " ourPlayer @ GetPhysSkill
  3 LPad strcat strcat 50 Pad
                                       (* display current large coins *)
  ourDataObj @ "@a/sysparms/cap_large_coins" getpropstr strcat
  ": " strcat 
                    (* display CON, and CON+Mod if different than CON *)
  "CON: " ourPlayer @ "@a/stats/con" getpropstr 2 LPad strcat
  ourPlayer @ "@a/stats/con_mod" getpropstr atoi dup if
    ourPlayer @ "@a/stats/con" getpropstr atoi +
    intostr "/" swap strcat strcat
  else
    pop
  then
                                       (* display current craft skill *)
  22 Pad
  "Craft Skill:      " ourPlayer @ GetCraftSkill
  3 LPad strcat strcat 50 Pad
                                       (* display current small coins *)
  ourDataObj @ "@a/sysparms/cap_small_coins" getpropstr strcat
  ": " strcat
  over strlen over strlen > if
    over strlen ourCounter !
    swap 
    ourPlayer @ "@a/money/large_coins" getpropstr strcat
    swap ourCounter @ Pad 
    ourPlayer @ "@a/money/small_coins" getpropstr strcat
  else
    dup strlen ourCounter !
    ourPlayer @ "@a/money/small_coins" getpropstr strcat
    swap ourCounter @ Pad
    ourPlayer @ "@a/money/large_coins" getpropstr strcat
    swap
  then
  swap Tell Tell
  
                    (* display DEX, and DEX+Mod if different than DEX *)
  "DEX: " ourPlayer @ "@a/stats/dex" getpropstr 2 LPad strcat
  ourPlayer @ "@a/stats/dex_mod" getpropstr atoi dup if
    ourPlayer @ "@a/stats/dex" getpropstr atoi +
    intostr "/" swap strcat strcat
  else
    pop
  then
  Tell
 
                    (* display INT, and INT+Mod if different than INT *)
  "INT: " ourPlayer @ "@a/stats/int" getpropstr 2 LPad strcat
  ourPlayer @ "@a/stats/int_mod" getpropstr atoi dup if
    ourPlayer @ "@a/stats/int" getpropstr atoi +
    intostr "/" swap strcat strcat
  else
    pop
  then
  50 Pad 
  ourDataObj @ "@a/sysparms/combat" getpropstr "yes" smatch if
    "Fatigue: " strcat
    ourPlayer @ "@a/stats/con" GetModAbility
    ourPlayer @ "@a/stats/str" GetModAbility + 
    ourPlayer @ GetEnduranceAdv +
    dup 
    ourPlayer @ "@a/stats/fat" GetModAbility - intostr
    "/" swap strcat swap intostr swap strcat strcat
  then
  Tell
  
                    (* display PRE, and PRE+Mod if different than PRE *)
  "PRE: " ourPlayer @ "@a/stats/pre" getpropstr 2 LPad strcat
  ourPlayer @ "@a/stats/pre_mod" getpropstr atoi dup if
    ourPlayer @ "@a/stats/pre" getpropstr atoi +
    intostr "/" swap strcat strcat
  else
    pop
  then
                                          (* display available points *)
  22 Pad
  "Available Points: " strcat
  ourPlayer @ "@a/avail/main" getpropstr 3 LPad strcat 50 Pad
  ourDataObj @ "@a/sysparms/combat" getpropstr "yes" smatch if
    "Damage:  " strcat
    ourPlayer @ "@a/stats/con" GetModAbility
    ourPlayer @ GetToughnessAdv +
    dup ourPlayer @ "@a/stats/dam" getpropstr atoi - 
    intostr "/" swap strcat swap intostr swap strcat strcat
  then
  Tell " " Tell
  
                (* handle dis-ads separately: only strip 0-val disads *)
  ourPlayer @ "@a/dis-ad/" nextprop dup if
    begin
      dup while
      ourPlayer @ over getpropstr atoi 0 = if
        ourPlayer @ over nextprop swap
        ourPlayer @ swap remove_prop
      else
        ourPlayer @ swap nextprop
      then
    repeat
  then
  pop
                                                    (* display skills *)
  ourPlayer @ "@a/skills/" nextprop dup if
    ourCounter !                       (* iterate through skill props *)
    "SKILLS: "
    begin                                 (* begin skill-listing loop *)
      ourCounter @ not if
        dup strlen 2 - strcut pop Tell " " Tell
        break
      then
      ourCounter @ 10 strcut swap pop strcat
      "\(" strcat
      ourPlayer @ ourCounter @ getpropstr strcat
      "\); " strcat
      ourPlayer @ ourCounter @ nextprop ourCounter !
    repeat                                  (* end skill-listing loop *)
  else
    pop
  then
                                                   (* display spells *)
  0 ourCounter !
  ourPlayer @ contents                             (* apply item mods *)
  begin                                    (* begin item-listing loop *)
    dup while
    dup program? if
      next continue
    then
    dup "@a/spells/" nextprop
    begin                                 (* begin item-checking loop *)
      dup while
      over over getpropstr atoi             ( ... o s i     )
      ourPlayer @                           ( ... o s i p   ) 
      3 pick rot                            ( ... o s p s i )
      over over nextprop swap pop
    repeat                                  (* end item-checking loop *)
    pop next
  repeat                                     (* end item-listing loop *)
  pop
  0 ourCounter !
  ourPlayer @ "@a/spells/" nextprop dup if
    ourCounter !                       (* iterate through spell props *)
    "SPELLS: "
    begin                                 (* begin spell-listing loop *)
      ourCounter @ not if
        dup strlen 2 - strcut pop Tell " " Tell
        break
      then
      ourCounter @ 10 strcut swap pop strcat
      "\(" strcat
      ourPlayer @ ourCounter @ getpropstr strcat
      "\); " strcat
      ourPlayer @ ourCounter @ nextprop ourCounter !
    repeat                                  (* end spell-listing loop *)
  else
    pop
  then
  ourPlayer @ contents                            (* remove item mods *)
  begin                                    (* begin item-listing loop *)
    dup while
    dup program? if
      next continue
    then
    dup "@a/spells/" nextprop
    begin                                 (* begin item-checking loop *)
      dup while
      over over getpropstr atoi             ( ... o s i     )
      ourPlayer @                           ( ... o s i p   ) 
      3 pick rot                            ( ... o s p s i )
      over over nextprop swap pop
    repeat                                  (* end item-checking loop *)
    pop next
  repeat                                     (* end item-listing loop *)
  pop
  
                                         (* display psionic abilities *)
  0 ourCounter !
  ourPlayer @ contents                             (* apply item mods *)
  begin                                    (* begin item-listing loop *)
    dup while
    dup program? if
      next continue
    then
    dup "@a/psiabs/" nextprop
    begin                                 (* begin item-checking loop *)
      dup while
      over over getpropstr atoi             ( ... o s i     )
      ourPlayer @                           ( ... o s i p   ) 
      3 pick rot                            ( ... o s p s i )
      over over nextprop swap pop
    repeat                                  (* end item-checking loop *)
    pop next
  repeat                                     (* end item-listing loop *)
  pop
  0 ourCounter !
  ourPlayer @ "@a/psiabs/" nextprop dup if
    ourCounter !                         (* iterate through psi props *)
    "PSIONICS: "
    begin                                   (* begin psi-listing loop *)
      ourCounter @ not if
        dup strlen 2 - strcut pop Tell " " Tell
        break
      then
      ourCounter @ 10 strcut swap pop strcat
      "\(" strcat
      ourPlayer @ ourCounter @ getpropstr strcat
      "\); " strcat
      ourPlayer @ ourCounter @ nextprop ourCounter !
    repeat                                    (* end psi-listing loop *)
  else
    pop
  then
  ourPlayer @ contents                            (* remove item mods *)
  begin                                    (* begin item-listing loop *)
    dup while
    dup program? if
      next continue
    then
    dup "@a/psiabs/" nextprop
    begin                                 (* begin item-checking loop *)
      dup while
      over over getpropstr atoi             ( ... o s i     )
      ourPlayer @                           ( ... o s i p   ) 
      3 pick rot                            ( ... o s p s i )
      over over nextprop swap pop
    repeat                                  (* end item-checking loop *)
    pop next
  repeat                                     (* end item-listing loop *)
  pop
                              (* display advantages and disadvantages *)
  0 ourCounter !
  0 ourBoolean !
  ourPlayer @ "@a/dis-ad/" nextprop dup if
    ourCounter !
    "ADVANTAGES & DISADVANTAGES: " 
    begin                                (* begin dis-ad-listing loop *)
      ourCounter @ not if
        dup strlen 2 - strcut pop
        break
      then
       
      (* status & wealth have default vals & require special handling *)
      ourCounter @ "{@a/dis-ad/status|@a/dis-ad/wealth}"
      smatch if
        ourPlayer @ ourCounter @ getpropstr "8" smatch if
          ourPlayer @ ourCounter @ nextprop ourCounter !
          continue
        then
      then
      
      ourCounter @ 10 strcut swap pop strcat
      "\(" strcat
      ourPlayer @ ourCounter @ getpropstr strcat
      "\); " strcat
      ourPlayer @ ourCounter @ nextprop ourCounter !
      1 ourBoolean !
    repeat                                 (* end dis-ad-listing loop *)
  else
    pop
  then
  
  ourBoolean @ if
    Tell
  then
  Line72
;
 
: 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?
  
  DoSheet
;
.
c
q
@set asys-sheet=W