@program $lib/rp
1 1000 d
i
( LibRPS.muf.so.1.0 -- Alynna Trypnotk )    
$def RPSYSTEM "$rpsystem" match    
$def RPBASE "/@rp/"      
$include $lib/alynna
lvar tmp
: rpstat ( s -- ? )    
( returns an RPsys stat )    
RPSYSTEM swap getprop    
; PUBLIC rpstat    
   
: envstat ( d s -- d ? )
( finds a stat up the environment, returns the first object it finds it on )
 "ds" checkargs    
  RPBASE swap strcat envprop ( return the object )    
; PUBLIC envstat
: envstatobj ( d s -- d )
( finds a stat up the environment, returns the first object it finds it on )
envstat pop
; PUBLIC envstatobj
: envstatval ( d s -- ? )
( finds a stat up the environment, returns the first stat it finds )
envstat swap pop
; PUBLIC envstatval
: getstat ( d s -- ? )    
( this getstat function is set up to support virtual stats )    
 "ds" checkargs    
( first of all, if the prop exists, its assumed to be )    
( overriden, even if it is a virtual stat)    
 over over RPBASE swap strcat prop? if             ( does the prop exist )    
  RPBASE swap strcat getprop    ( return the value )    
 else
  pop pop 0
 then      
; PUBLIC getstat      
: findstat ( d s -- d ? )
( searches the player, then the environment, then the RPsystem itself, for a valid stat )
( returns the first one it finds and the object it was found on )
over over getstat dup wassup? not if    ( check the object and do a virtstat check )
 pop over over envstat swap pop dup
 wassup? not if      ( check the environment )
  pop swap pop rpstat dup wassup? not if    ( check the RP system )
   pop #-1 ""                           ( didnt find a blasted thing )
  else                                  ( found something [rpsystem], return with the stack OK )
                                        ( get rid of the original d s )
  RPSYSTEM swap                         ( return with RPSYSTEM ? )
  then
 else                                   
  4 rotate 2 popn                       ( get rid of the original d s, rest of result ok )
 then
else
swap pop                                ( get rid of original s, keep the d, return new ? )
then
; PUBLIC findstat
: findstatobj ( d s -- d )
( searches the player, then the room, then the RPsystem itself, for a valid stat )
( returns the first object it finds it on )
findstat pop
; PUBLIC findstatobj
: findstatval ( d s -- ? )
( searches the player, then the environment, then the RPsystem itself, for a valid stat )
( returns the first one it finds and the object it was found on )
findstat swap pop
; PUBLIC findstatval
lvar target   
lvar user   
: setstat ( d s -- )    
 "ds?" checkargs      
 swap RPBASE swap strcat swap setprop      
; PUBLIC setstat      
       
: getstatint ( d s -- i )    
 "ds" checkargs      
 getstat      
 dup string? if atoi then      
 dup dbref? if int then      
 dup lock? if "DIED: LOCK stored in rpsystem propdir" abort then      
; PUBLIC getstatint      
   
: getstatstr ( d s -- s )      
 "ds" checkargs      
 getstat      
 dup int? if intostr then      
 dup dbref? if int intostr "#" swap strcat then      
 dup lock? if prettylock then      
; PUBLIC getstatstr      
: reset ( d -- )    
 "d" checkargs      
 dup caller "W2" flag? if      
  RPBASE remove_prop      
 else      
  caller name " not allowed to reset props. it's not W2 set." strcat abort      
 then      
; PUBLIC reset      
       
: 1dx ( i -- i )    
( outputs 1dx )    
random swap % 1 +
; PUBLIC 1dx    
: rpmatch ( i s -- s )    
swap intostr "/" swap strcat strcat "/" swap strcat RPSYSTEM swap getpropstr    
; PUBLIC rpmatch    
lvar luSS
lvar luS
lvar luD
: lookupstat ( d s s -- d s )
( find a stat on an object, return it fully resolved )
luss ! lus ! lud !
lud @ "/" lus @ strcat getstat wassup? if lud @ "/" lus @ strcat exit then
lud @ str "skill/" lus @ "/" luss @ cat getstat wassup? if lud @ str "skill/" lus @ "/" luss @ cat exit then
lud @ str "ability/" lus @ "/" luss @ cat getstat wassup? if lud @ str "ability/" lus @ "/" luss @ cat exit then
lud @ str "boon/" lus @ "/" luss @ cat getstat wassup? if lud @ str "boon/" lus @ "/" luss @ cat exit then
lud @ str "bane/" lus @ "/" luss @ cat getstat wassup? if lud @ str "bane/" lus @ "/" luss @ cat exit then
lud @ str "quality/" lus @ "/" luss @ cat getstat wassup? if lud @ str "quality/" lus @ "/" luss @ cat exit then
lud @ str "vulnerability/" lus @ "/" luss @ cat getstat wassup? if lud @ str "vulnerability/" lus @ "/" luss @ cat exit then
lud @ str "kata/" lus @ "/" luss @ cat getstat wassup? if lud @ str "kata/" lus @ "/" luss @ cat exit then
lud @ str "spellbook/" lus @ "/" luss @ cat getstat wassup? if lud @ str "spellbook/" lus @ "/" luss @ cat exit then
""
; PUBLIC lookupstat
 
: ldie ( i -- i )
( level 1 is 1d20, level 2 is 1d12, level 3 is 1d10, level 4 is 1d8, level 5 is 1d6, and level 6 is 1d4 )
dup 1 = if pop 20 exit then
dup 2 = if pop 12 exit then
dup 3 = if pop 10 exit then
dup 4 = if pop  8 exit then
dup 5 = if pop  6 exit then
dup 6 = if pop  4 exit then
pop 0 
; PUBLIC ldie
 
: lroll ( i -- i )
( level 1 is 1d20, level 2 is 1d12, level 3 is 1d10, level 4 is 1d8, level 5 is 1d6, and level 6 is 1d4 )
ldie 1dx
; PUBLIC lroll
.
c
q