@program #539
1 1000 d
i
$def .tell .ansi_tell
$include $muf/rp/boxutils
$include $lib/gary'smufutils-strings
$include $lib/gary'smufutils-lists
$include $lib/gary'smufutils-misc
$include $lib/rp (Nuku's base utils)
$include $muf/scrp/registry
lvar Target
$def RPS "$RPSYSTEM" match
$def REG "$muf/scrp/registry" match
$def pcheck #1249 "have-package?" call
: checkSilent
  0
;
: SCtell (s -- )
  (Oooh! So .. almost pointless, does a '.tell', but tags on the SC prompt first)
  (Looks up the required tag name from the called)
  "~&13-[~&16-SCRP~&03-:~&17-" caller dup "%N" getpropstr dup "" stringcmp not if pop name else swap pop then strcat "~&13-]~&06-" strcat swap strcat
  .tell 
; PUBLIC SCtell
: .announce ( s -- )
  (Tells a string to a room)
  target @ ok? not if me @ target ! then
  checkSilent not if
    target @ begin location dup room? until swap 0 swap ansi_notify_exclude
   else
    pop 
  then
; public .announce
: .spamannounce (s --)
  (Like .announce. But only tells if needed)
  target @ ok? not if me @ target ! then
  checkSilent not if
    target @ location
    contents
    begin
      (Message Object)
      dup ok? if
        dup "_prefs/light?" getpropstr "y" instring not if
          over over swap ansi_notify
        then
      then
    next dup #-1 dbcmp until pop
    pop
   else
    pop 
  then
; PUBLIC .spamannounce
: staff?? (d -- i)
var target target !
  (Returns true if d is staff)
  target @ mlevel 4 > 
  target @ "@/rpstaffer?" getpropstr "Y" instr 
  target @ owner staff?
  OR OR if 1 else 0 then
; PUBLIC staff??
: PC? (d -- i)
  (Returns true if object is a PC)
  dup "finish" getstat (Is it stat built?)
  over player? (Is it a player object?)
  rot "NPC?" getstatstr "0" stringcmp not (Is it not an NPC?)
  AND AND
; PUBLIC PC?
: getRegistryItem (s s -- s)
  "ss" checkargs
  (Gets an item relating to a prop, say 'strength' 'type' would return 'attribute')
  "$muf/rp/registry" match
  "@registry/byItem/" 4 rotate strcat "/" strcat
  (Wanted RegistryObject RootProp)
  over over 5 pick strcat getpropstr
  dup "" stringcmp not not if swap pop swap pop swap pop exit else pop then (Return this value)
  (Now check for the byType, incase this is a type and not an item)
  over over "byType" "byItem" subst 5 pick strcat getpropstr
  dup "" stringcmp not not if swap pop swap pop swap pop exit else pop then (Return this value)
  (Need to check byType class)
  3 pick "items" instring if pop pop pop "" exit then (Sub-items aren't inherited!)
  over over "type" strcat getpropstr
  swap pop
  "@registry/byType/" swap strcat "/" strcat rot strcat getpropstr
; PUBLIC getRegistryItem
: getStoredAs (s -- s)
  "S" checkargs
  (Returns type of value stored as. IE STR, INT. Returns a null string on unknown)
  "StoreAs"
  getRegistryItem
; PUBLIC getStoredAs
: getType (s -- s)
  "S" checkargs
  (Returns type. This can be things like 'attribute' for 'muscle'.)
  "type"
  getRegistryItem
; PUBLIC getType
: nextItem (s s -- s) (ItemType LastItem -- NextItem)
  (Takes a type, such as 'attribute', then returns the next item that uses this.)
  (It should be passed "" as LastItem to start off)
  (It'll return "" when there are no more types left)
  (First let's make a property in the @registry/byItem/<item> format)
  "@registry/byItem/" swap strcat
  (Now get the registry object)
  "$muf/rp/registry" match swap
  (ItemType RegObject LastItem)
  begin over swap nextprop over over "/type" strcat getpropstr 4 pick stringcmp not not while
    dup "" stringcmp not if (Ran out!)
      pop pop pop "" exit
    then
  repeat dup "/" rinstring strcut swap pop 
  swap pop swap pop
; PUBLIC nextItem
: StatType (s -- s)
  (OLD. Converted to GetType)
  getType
; PUBLIC statType
: getfullStat (d s -- )
  (Handles talent and skill trees)
  dup statType
  (d s s)
  dup "talent" stringcmp not if "special/" rot strcat swap then
  pop
  getStatInt
; PUBLIC getFullStat
 
: performCheck (d s i -- Object StringToCheck SilentCheck) 
  3 pick target !
  over "player=" 5 pick intostr strcat "$muf/rp2/formulaparser" match "parse_start" call
  (Object Formula TellYN Result)
  (Get 5d5!)
  0 ""
  6 begin 1 - dup 0 > while
    random 5 % 1 +
    (Total Dice Left Last)
    4 rotate over + -4 rotate (Add to total)
    rot swap intostr element_list_add
    swap
  repeat pop
  (Object Formula TellYN Result Total DiceStr)
  4 pick if
    6 pick name "^WHITE^[^CYAN^Official^WHITE^]^PURPLE^" swap strcat "^NORMAL^" strcat " ^WHITE^rolls '" strcat 6 pick strcat "' and " strcat
    4 pick 4 pick + 20 - 0 > if "^GREEN^succeeds^WHITE^" else "^RED^fails^WHITE^" then strcat
    " with a margin of ^CYAN^" strcat 4 pick 4 pick + 20 - intostr strcat
    3 pick 10 < if "^WHITE^[^GREEN^Crit. Fail^WHITE^]" strcat then
    3 pick 20 > if "^WHITE^[^GREEN^Crit. Succ^WHITE^]" strcat then
    "." strcat
    .announce
    (Optional lines!)
    "          ^WHITE^Dice " OPENITEM strcat over "|" english_list strcat CLOSEITEM strcat "(^YELLOW^" strcat 3 pick intostr strcat "^WHITE^) + Stat. Result " strcat OPENITEM strcat 4 pick intostr strcat CLOSEITEM strcat " = ^YELLOW^" strcat 4 pick 4 pick + intostr strcat " ^WHITE^against 20." strcat
    .spamannounce
  then
  pop + swap pop swap pop swap pop
; PUBLIC performCheck
: getMaxHP (d -- i)
  dup "stamina" getstatint
  over "Jnote" "tough" findboxitem if 3 * 2 / then
  12 +
  over "special/raise-hp" getstat + 
  over "special/lower-hp" getstat -
  swap pop 6 * 5 /
; PUBLIC getMaxHP
: getJobRequirements (s -- s)
  (Returns the requirements for a job)
  RPS swap "/jobs/" swap strcat "/requirement" strcat getpropstr "|" ":" subst
; PUBLIC getJobRequirements
: isJob? (s -- i)
  (Returns true if string is a valid job)
  RPS swap "/jobs/" swap strcat "/Profession" strcat getpropstr "" stringcmp not not
; PUBLIC isJob?
lvar job 
lvar target
: jobAllowed? (d s -- i )
.debug-off
  (Returns true if d can have this job)
  over target ! dup dup job ! isJob? not if pop pop 0 exit then (Can't have a job that doesn't exist!)
  1 swap
  getJobRequirements dup "" stringcmp not if (None!) pop pop pop 1 exit then
  "|" explode
  begin
    (Object AllowedSoFar I1..In I)
    swap 
    "/" explode pop
    (Object AllowedSoFar I1..In-1 I level job)
    swap atoi swap
    3 pick 4 + pick 
    swap getstatint 
    swap >= not if
      (Not allowed!)
      dup 1 + rotate pop 0
      over 1 + -1 * rotate
    then
  1 - dup not until pop
  swap pop
  RPS "Jobs/" job @ strcat "/tier" strcat getpropstr atoi
  target @ "Jobs/" 
  RPS "Jobs/" job @ strcat "/Profession" strcat getpropstr
  strcat getstatint - 1 = if 1 else 0 then and
  .debug-off
; PUBLIC jobAllowed?
: getJobJP (d s -- i )
  (Returns the JP level the person has in that job)
  dup isJob? not if pop pop 0 exit then (Can't have a job that doesn't exist!)
  "jobs/" swap strcat getstatint
; PUBLIC getJobJP
: getJobSpentJP (d s -- i )
  "jobs/" swap strcat "spent" strcat getstat
; PUBLIC getJobSpentJP
: getJobLevel (d s -- i )
  (Returns the level the person has in that job)
  dup job ! over target !
  dup isJob? not if pop pop 0 exit then (Can't have a job that doesn't exist!)
  over over
  getstat
  3 pick 3 pick jobAllowed? 4 rotate 4 rotate getJobJP or if pop target @ job @ getJobJP ( 1 + ) dup float? if int then exit then
  dup float? if int then
; PUBLIC getjoblevel
: getJobs (d -- )
      "Jobs/Fighter" element_list_Add
      "Jobs/Rogue" element_list_Add
      "Jobs/Acolyte" element_list_Add
      "Jobs/Fighter" element_list_Add
      "Jobs/Fighter" element_list_Add
; PUBLIC getJobs
.
c
q