@program $lib/rps 1 10000 d i $author Alynna $note We're trying all this stuff again.. $version 1.3 $undef ansi_strcut $undef ansi_strlen $pubdef : ( (C) 2000-2003 Alynna Trypnotk - alynna@animaltracks.net Release terms: GNU GPL v2 http://www.gnu.org/copyleft/gpl.html Just tell me where you got me, where your using me (host/port) and distribute your changes under the same terms as you got them [GNU GPL v2] ) ( Get these: http://tails.animaltracks.net/txt/muf/ ) $include $lib/rp $include $lib/alynna $include $muf/inline $include $muf/cron ( Edit these ) $def INFORM "FMLRP" pretty tellme $def AVATAR #390 $def FORCEWIZ AVATAR $def MUCKNAME "Fools Moon" $def RPSYS "$RPSYSTEM" match $def RPDIR "/@rps/" $def NUMPLAYERS contents 0 swap begin dup ok? not if break then dup player? if dup awake? not if break then swap 1 + swap then next 0 until pop $def MAXVOTES me @ "W" flag? if 256 else me @ "maxvotes" getstatint if me @ "maxvotes" getstatint else 3 then then $def DEBUGMODE prog "?" flag? lvar param lvar target lvar stat lvar value lvar dicestore lvar dicestore4 lvar itype lvar iname lvar section@ : rpinfo-chopper[ str:string -- str:result ] string @ dup "/" instr 1 = if 1 strcut swap pop then dup "/" rinstr over strlen = if dup "/" rinstr 1 - strcut pop then ; : stou[ str:string -- str:result ] string @ "_" " " subst ; : utos[ str:string -- str:result ] string @ " " "_" subst ; : ayb RPSYS { "/" itype @ "/" iname @ "/" } array_make "" array_join ; : smatch_array[ str:string -- str:result ] string @ ", " explode_array "|" array_join "{" swap "}" strcat strcat ; : eTYPE me @ "_prefs/fmlrps/entry-type" getprop dup string? not if pop "" then ; : eNAME me @ "_prefs/fmlrps/entry-name" getprop dup string? not if pop "" then ; : eTARGET "/" etype "/" ename "/" strcat strcat strcat strcat ; $libdef ent : ent[ str:algorithm -- result ] RPSYS algorithm @ getprop dup string? if dup "(@)*" smatch if "" "(@)" subst strip inline then then ; PUBLIC ent $libdef entEx : entEx[ dbref:target str:algorithm -- result ] var tmp RPSYS algorithm @ getprop dup tmp ! string? if dup "(EXEC)*" smatch if { target @ stod " var! target " tmp @ "" "(@)" subst strip }cat inline then then ; PUBLIC entEx $libdef nd2 : nd2[ int:n -- int:result ] n @ 2 ndx ; PUBLIC nd2 $libdef nd4 : nd4[ int:n -- int:result ] n @ 4 ndx ; PUBLIC nd4 $libdef nd6 : nd6[ int:n -- int:result ] n @ 6 ndx ; PUBLIC nd6 $libdef nd8 : nd8[ int:n -- int:result ] n @ 8 ndx ; PUBLIC nd8 $libdef nd10 : nd10[ int:n -- int:result ] n @ 10 ndx ; PUBLIC nd10 $libdef nd12 : nd12[ int:n -- int:result ] n @ 10 ndx ; PUBLIC nd12 : tm[ str:string ] string @ dup "FMLRPS" pretty tellme DEBUGMODE not if pop else FORCEWIZ { "wi : " }cat rot strcat force then ; : th[ str:string ] string @ dup "FMLRPS" pretty tellhere DEBUGMODE not if pop else FORCEWIZ { "wi : " }cat rot strcat force then ; : ansi_strcut ( s i -- s1 s2 ) swap dup strlen ( i s i ) swap dup ( i i s s ) 0 unparse_ansi 1 unparse_ansi 2 unparse_ansi 3 unparse_ansi strlen ( i i s i ) 3 pick swap - rot pop ( i s i ) rot ( s i i ) + ( s i ) strcut ; : ansi_strlen ( s -- i ) 0 unparse_ansi 1 unparse_ansi 2 unparse_ansi 3 unparse_ansi strlen ; $libdef find-prop-in $pubdef find-prop "" find-prop-in $pubdef find-nameprop "/name" strcat "" find-prop-in pop "" "/name" subst $pubdef find-nameprop-in swap "/name" strcat swap find-prop-in pop "" "/name" subst $def find-prop "" find-prop-in $def find-nameprop "/name" strcat "" find-prop-in pop "" "/name" subst $def find-nameprop-in swap "/name" strcat swap find-prop-in pop "" "/name" subst : find-prop-in[ str:search str:section -- s x ] var item var value var value2 RPSYS { section @ "/" search @ }cat getprop if { section @ "/" search @ }cat RPSYS over getprop exit then RPSYS section @ "/" strcat array_get_propdirs foreach value ! pop RPSYS { section @ "/" value @ "/" search @ }cat getprop if { section @ "/" value @ "/" search @ }cat RPSYS over getprop exit then RPSYS { section @ "/" value @ "/" }cat array_get_propdirs foreach value2 ! pop RPSYS { section @ "/" value @ "/" value2 @ "/" search @ }cat getprop if { section @ "/" value @ "/" value2 @ "/" search @ }cat RPSYS over getprop exit then repeat repeat "" 0 ; PUBLIC find-prop-in $libdef find-propdir-in $pubdef find-propdir "" find-propdir-in $def find-propdir "" find-propdir-in : find-propdir-in[ str:search str:section -- s ] var item var value var value2 RPSYS { section @ "/" search @ "/" }cat propdir? if { section @ "/" search @ capitalize }cat exit then RPSYS { section @ "/" }cat array_get_propdirs foreach value ! pop RPSYS { section @ "/" value @ "/" search @ "/" }cat propdir? if { section @ "/" value @ capitalize "/" search @ capitalize }cat exit then RPSYS { section @ "/" value @ "/" }cat array_get_propdirs foreach value2 ! pop RPSYS { section @ "/" value @ "/" value2 @ "/" search @ "/" }cat propdir? if { section @ "/" value @ capitalize "/" value2 @ capitalize "/" search @ capitalize }cat exit then repeat repeat "" ; PUBLIC find-propdir-in $libdef find-stat : find-stat[ dbref:target dbref:search -- s ? ] var item var value var value2 target @ search @ getstat if search @ target @ search @ getstat exit then target @ "/@rp/" array_get_propdirs foreach value ! pop target @ { value @ "/" search @ }cat getstat if { value @ "/" search @ }cat target @ over getstat exit then RPSYS { "/@rp/" value @ "/" }cat array_get_propdirs foreach value2 ! pop target @ { value @ "/" value2 @ "/" search @ }cat getstat if { value @ "/" value2 @ "/" search @ }cat target @ over getstat exit then repeat repeat "" 0 ; PUBLIC find-stat : showindex var count var linestore var item var function var idxperline var itemsize param @ function ! ( dump an index ) { "RPinfo item type: " function @ }cat header tellme -1 count ! "" linestore ! RPSYS function @ array_get_propdirs maxstrlen case 10 <= when 7 11 end 12 <= when 6 13 end 14 <= when 5 15 end 18 <= when 4 19 end 25 <= when 3 26 end default 2 39 end endcase itemsize ! idxperline ! RPSYS function @ array_get_propdirs foreach item ! item @ "_*" smatch not if count @ 1 + count ! linestore @ { RPSYS function @ "/" item @ strcat strcat array_get_propdirs array_count if "^CYAN^" else "^YELLOW^" then item @ tostr capitalize itemsize @ lj "^NORMAL^" }cat strcat linestore ! count @ idxperline @ % idxperline @ -- = if linestore @ tellme "" linestore ! then then repeat count @ idxperline @ % idxperline @ -- < if linestore @ tellme "" linestore ! then { "FMLRPS RPinfo v1.0 by Alynna" }cat footer tellme ; : rpinfo $pubdef actions.rpinfo +rpinfo;+attribute;+race;+ability;+bane;+boon;+quality;+skill;+spellbook;+techniques var item var value var value2 var count var linestore var function var propdirmatch var section var idxperline var itemsize command @ "+rpinfo" smatch if "" section ! else { command @ "" "+" subst }cat section ! then param @ not if section @ not if "/" param ! showindex exit else section @ param ! showindex exit then then "" itype ! "" iname ! param @ section @ find-nameprop-in dup if rpinfo-chopper "/" split iname ! itype ! else pop param @ section @ find-propdir-in dup if rpinfo-chopper param ! showindex exit else "Couldn't find that item." "RPinfo" pretty tellme exit then then { iname @ capitalize " (" itype @ capitalize ")" }cat header tellme ayb "desc" strcat getpropstr wrap74 atellme { "Other information" }cat header tellme ayb array_get_propvals foreach value ! item ! item @ "_*" smatch not item @ "{desc|name}" smatch not and if { "^YELLOW^" item @ capitalize 16 lj "^GREEN^" value @ }cat tellme then repeat ayb array_get_propdirs array_count 0 > if "Subitems" header tellme param @ function ! -1 count ! "" linestore ! ayb array_get_propdirs maxstrlen case 10 <= when 7 11 end 12 <= when 6 13 end 14 <= when 5 15 end 18 <= when 4 19 end 25 <= when 3 26 end default 2 39 end endcase itemsize ! idxperline ! ayb array_get_propdirs foreach item ! item @ "_*" smatch not if count @ 1 + count ! linestore @ { "^GREEN^" item @ tostr capitalize itemsize @ lj "^NORMAL^" }cat strcat linestore ! count @ idxperline @ % idxperline @ -- = if linestore @ tellme "" linestore ! then then repeat count @ idxperline @ % idxperline @ -- < if linestore @ tellme "" linestore ! then then { "FMLRPS RPinfo v1.0 by Alynna" }cat footer tellme ; PUBLIC rpinfo : entry $pubdef actions.entry .type;.name;.desc;.set;.setf;.seti;.setd var item var value command @ tolower case ".type" smatch when me @ "_prefs/fmlrps/entry-type" param @ setprop { "Target:^YELLOW^ " eTARGET "^NORMAL^" }cat "Data" pretty tellhere end ".name" smatch when me @ "_prefs/fmlrps/entry-name" param @ setprop RPSYS eTARGET "name" strcat param @ dup "/" instr if "/" rsplit swap pop then setprop { "Target:^YELLOW^ " eTARGET "^NORMAL^, name prop set" }cat "Data" pretty tellhere end ".desc" smatch when param @ value ! RPSYS eTARGET "desc" strcat value @ setprop { "^GREEN^Property set, ^YELLOW^" eTARGET "desc:^CYAN^" value @ }cat "Data" pretty tellhere end ".set" smatch when param @ " " split value ! item ! RPSYS eTARGET item @ strcat value @ setprop { "^GREEN^Property set, ^YELLOW^" eTARGET item @ ":^CYAN^" value @ }cat "Data" pretty tellhere end ".setf" smatch when param @ " " split value ! item ! RPSYS eTARGET item @ strcat value @ tofloat setprop { "^GREEN^Property set, ^YELLOW^" eTARGET item @ "(float):^CYAN^" value @ }cat "Data" pretty tellhere end ".seti" smatch when param @ " " split value ! item ! RPSYS eTARGET item @ strcat value @ toint setprop { "^GREEN^Property set, ^YELLOW^" eTARGET item @ "(int):^CYAN^" value @ }cat "Data" pretty tellhere end ".setd" smatch when param @ " " split value ! item ! RPSYS eTARGET item @ strcat value @ todbref setprop { "^GREEN^Property set, ^YELLOW^" eTARGET item @ "(dbref):^CYAN^" value @ }cat "Data" pretty tellhere end endcase ; PUBLIC entry $libdef rpstat : rpstat ( s -- x ) var dir var item dir ! RPSYS "/" array_get_propdirs foreach item ! pop RPSYS { "/" item @ "/" dir @ }cat getprop dup if exit else pop then repeat 0 ; PUBLIC rpstat $libdef xpspent : xpspent ( d -- i ) "xpspent" getstat ; PUBLIC xpspent : successlevel ( i/f -- s ) toint dup 3 <= if pop "[L0] Failure" exit then dup 6 <= if pop "[L1] Unskilled" exit then dup 9 <= if pop "[L2] Training" exit then dup 13 <= if pop "[L3] Beginner" exit then dup 17 <= if pop "[L4] Novice" exit then dup 21 <= if pop "[L5] Average" exit then dup 26 <= if pop "[L6] Notable" exit then dup 31 <= if pop "[L7] Above-average" exit then dup 36 <= if pop "[L8] Skilled" exit then dup 42 <= if pop "[L9] Gifted" exit then dup 48 <= if pop "[L10] Reknown" exit then dup 54 <= if pop "[L11] Heroic" exit then dup 61 <= if pop "[L12] Master" exit then dup 68 <= if pop "[L13] Legendary" exit then dup 75 <= if pop "[L14] Unbelievable" exit then dup 99 <= if pop "[L15] Ultimate" exit then 100 > if pop "[L16] Godlike (Please contact staff)" exit then ; PUBLIC successlevel $libdef successlevel : fmt76 ( s -- s ) "|" swap strcat " " strcat 77 \ansi_strcut pop "|" strcat ; PUBLIC fmt76 $libdef fmt76 : level ( i/f -- f ) tofloat (L 0) dup 2.0 < if 2.0 / exit then (L 1) dup 4.0 < if 2.0 - 2.0 / 1.0 + exit then (L 2) dup 8.0 < if 4.0 - 4.0 / 2.0 + exit then (L 3) dup 16.0 < if 8.0 - 8.0 / 3.0 + exit then (L 4) dup 32.0 < if 16.0 - 16.0 / 4.0 + exit then (L 5) dup 64.0 < if 32.0 - 32.0 / 5.0 + exit then (L 6) dup 128.0 < if 64.0 - 64.0 / 6.0 + exit then (L 7) dup 256.0 < if 128.0 - 128.0 / 7.0 + exit then (L 8) dup 512.0 < if 256.0 - 256.0 / 8.0 + exit then (L 9) dup 1024.0 < if 512.0 - 512.0 / 9.0 + exit then (L10) dup 2048.0 < if 1024.0 - 1024.0 / 10.0 + exit then (L11) dup 4096.0 < if 2048.0 - 2048.0 / 11.0 + exit then (L12) dup 8192.0 < if 4096.0 - 4096.0 / 12.0 + exit then (L13) dup 16384.0 < if 8192.0 - 8192.0 / 13.0 + exit then (L14) dup 32768.0 < if 16384.0 - 16384.0 / 14.0 + exit then (L15) dup 65536.0 < if 32768.0 - 32768.0 / 15.0 + exit then (L16) dup 65536.0 >= if pop 16.0 exit then ; PUBLIC level $libdef level : xlevel ( i/f -- f ) tofloat 1023.0 - sqrt ; PUBLIC xlevel $libdef xlevel : level2xp ( i/f -- f ) tofloat (L 0) dup 1.0 < if 0.0 swap dup int - 2.0 * + exit then (L 1) dup 2.0 < if 2.0 swap dup int - 2.0 * + exit then (L 2) dup 3.0 < if 4.0 swap dup int - 4.0 * + exit then (L 3) dup 4.0 < if 8.0 swap dup int - 8.0 * + exit then (L 4) dup 5.0 < if 16.0 swap dup int - 16.0 * + exit then (L 5) dup 6.0 < if 32.0 swap dup int - 32.0 * + exit then (L 6) dup 7.0 < if 64.0 swap dup int - 64.0 * + exit then (L 7) dup 8.0 < if 128.0 swap dup int - 128.0 * + exit then (L 8) dup 9.0 < if 256.0 swap dup int - 256.0 * + exit then (L 9) dup 10.0 < if 512.0 swap dup int - 512.0 * + exit then (L10) dup 11.0 < if 1024.0 swap dup int - 1024.0 * + exit then (L11) dup 12.0 < if 2048.0 swap dup int - 2048.0 * + exit then (L12) dup 13.0 < if 4096.0 swap dup int - 4096.0 * + exit then (L13) dup 14.0 < if 8192.0 swap dup int - 8192.0 * + exit then (L14) dup 15.0 < if 16384.0 swap dup int - 16384.0 * + exit then (L15) dup 16.0 < if 32768.0 swap dup int - 32768.0 * + exit then (L16) dup 16.0 >= if pop 65536.0 exit then ; PUBLIC level2xp $libdef level2xp : maxhp ( d -- i ) var! target target @ "at/phy" getstatint level target @ "at/men" getstatint level + target @ "at/spi" getstatint level + target @ "at/hp" getstatint level + toint 10 + 6 * ; PUBLIC maxhp $libdef maxhp : maxtp ( d -- i ) dup "at/phy" getstatint swap "at/tp" getstatint + level toint 10 + 6 * ; PUBLIC maxtp $libdef maxtp : maxmp ( d -- i ) dup "at/men" getstatint swap "at/mp" getstatint + level toint 10 + 6 * ; PUBLIC maxmp $libdef maxmp : maxess ( d -- i ) dup "at/spi" getstatint swap "at/ess" getstatint + level toint 10 + 6 * ; PUBLIC maxess $libdef maxess : resources ( d -- i ) dup "at/soc" getstatint swap "at/res" getstatint + level toint 10 + 6 * ; PUBLIC resources $libdef resources : trueluck ( d -- i ) dup "at/racialrank" getstatint swap "at/luck" getstatint + ; PUBLIC trueluck $libdef trueluck : racialrank ( d -- i ) dup "at/racialrank" getstatint ; PUBLIC racialrank $libdef racialrank : cost ( d s -- f ) getstatfloat level toint dup 16 = if 0 else 2.0 swap 1.0 + pow then ; PUBLIC cost $libdef cost : rpset $pubdef actions.rpset +rp;+rpi;+rpd;+rps;+rpf;+rpo me @ "W" flag? if param @ "=" explode pop dup match dup ok? not if pop .pmatch dup player? not if pop "Invalid target" "RPset" pretty tellme exit then else swap pop then target ! stat ! value ! command @ "+rp" stringcmp not if target @ stat @ value @ toint dup value ! setstat then command @ "+rpi" stringcmp not if target @ stat @ value @ toint dup value ! setstat then command @ "+rps" stringcmp not if target @ stat @ value @ tostr dup value ! setstat then command @ "+rpf" stringcmp not if target @ stat @ value @ tofloat dup value ! setstat then command @ "+rpd" stringcmp not if target @ stat @ value @ todbref dup value ! setstat then command @ "+rpo" stringcmp not if target @ stat @ value @ todbref dup value ! setstat then { "[rpset] " me @ " set RP stat [" stat @ "] on " target @ " to: " value @ }cat dup tellme prog swap prog "/logs" getpropval 1 + dup prog swap "/logs" swap setprop intostr "/logs/" swap strcat swap setprop else "Must be a W to use." "RPset" pretty tellme AVATAR { "wc " me @ " tried to +rpset without a W bit!" }cat force then ; PUBLIC rpset : qtystr dup -1 = if pop "PERM" exit then tostr ; : xpshow $pubdef actions.xpshow +xp;+status param @ "" stringcmp not if me @ target ! else param @ pmatch target ! then target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Info" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "Info" pretty tellme exit then command @ "*sheet*" smatch not if target @ xpspent pop { "Basic report for " me @ }cat header tellme then { " Lv:[^CYAN^" target @ "xp" getstatint xlevel 2 fchop 6 rj "^NORMAL^] " "XP:[^CYAN^" target @ "xp" getstatint 2 fchop 9 rj "^NORMAL^] " "Unspent:[^CYAN^" target @ "xp" getstatint target @ "xpspent" getstatint - 2 fchop 9 rj "^NORMAL^] " "$:[^YELLOW^" target @ "gp" getstatfloat 2 fchop 10 rj "^NORMAL^] " "Valid:[^GRAY^" target @ "validated?" getstatint if "Yes" else "No " then "^NORMAL^]" }cat fmt76 tellme { " HP:[^GREEN^" target @ "hp" getstatint tostr 3 rj "/" target @ maxhp tostr 3 rj "^NORMAL^] " " MP:[^GREEN^" target @ "mp" getstatint tostr 3 rj "/" target @ maxmp tostr 3 rj "^NORMAL^] " " TP:[^GREEN^" target @ "tp" getstatint tostr 3 rj "/" target @ maxtp tostr 3 rj "^NORMAL^] " " Ess:[^GREEN^" target @ "ess" getstatint tostr 3 rj "/" target @ maxess tostr 3 rj "^NORMAL^] " " Votes:[^GREEN^" target @ "votes" getstatint tostr 2 rj "/25^NORMAL^] " }cat fmt76 tellme command @ "*sheet*" smatch not if { " Sheet last validated by [^GREEN^" target @ "validatedby" getstat "^NORMAL^] on [^CYAN^" target @ "validatedat" getstatint "%X %x" swap timefmt "^NORMAL^] " }cat fmt76 tellme MUCKNAME footer tellme then ; PUBLIC xpshow : sheet $pubdef actions.sheet sheet;+sheet param @ "" stringcmp not if me @ target ! else param @ pmatch target ! then target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Sheet" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "Sheet" pretty tellme exit then target @ name header tellme target @ xpspent pop xpshow ( Attributes ) "Attributes" header tellme "|Attribute------------| CP |Next|Lev.| |Attribute------------| CP |Next|Lev.|" tellme #-2 { RPDIR "at/Physical" strcat target @ "at/Physical" getstat RPDIR "at/Mental" strcat target @ "at/Mental" getstat RPDIR "at/Spiritual" strcat target @ "at/Spiritual" getstat RPDIR "at/Social" strcat target @ "at/Social" getstat }dict foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop target @ { rpdir "at/" }cat nextprop "" stringcmp if #-2 target @ { RPDIR "at/" }cat array_get_propvals foreach value ! stat ! stat @ "" { RPDIR "at/" }cat subst "{physical|mental|spiritual|social}" smatch if continue then stat @ "{physical|mental|spiritual|social}" smatch if continue then { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Skills ) target @ { rpdir "sk/" }cat nextprop "" stringcmp if "Abilities / Spells / Knowledges" header tellme "|Skill----------------| CP |Next|Lev.| |Skill----------------| CP |Next|Lev.|" tellme #-2 target @ { RPDIR "sk/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Abilities ) target @ { rpdir "ab/" }cat nextprop "" stringcmp if "Abilities / Spells / Knowledges" header tellme "|Ability--------------| CP |Next|Lev.| |Ability--------------| CP |Next|Lev.|" tellme #-2 target @ { RPDIR "ab/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Spells ) target @ { rpdir "sp/" }cat nextprop "" stringcmp if "Spells" header tellme "|Spell----------------| CP |Next|Lev.| |Spell----------------| CP |Next|Lev.|" tellme #-2 target @ { RPDIR "sp/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Techniques ) target @ { rpdir "te/" }cat nextprop "" stringcmp if "Techniques" header tellme "|Techniques-----------| CP |Next|Lev.| |Techniques-----------| CP |Next|Lev.|" tellme #-2 target @ { RPDIR "te/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Psionics ) target @ { rpdir "ps/" }cat nextprop "" stringcmp if "Psionics" header tellme "|Psionics-------------| CP |Next|Lev.| |Psionics-------------| CP |Next|Lev.|" tellme #-2 target @ { RPDIR "ps/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 21 lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ level int 1 + level2xp value @ - toint intostr 4 rj (XP to next level) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Qualities ) target @ { RPDIR "qu/" }cat nextprop "" stringcmp if "Qualities" header tellme "|Qualities-----------------|Rank|Ess.| |Qualities-----------------|Rank|Ess.|" tellme #-2 target @ { RPDIR "qu/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 26 capitalize lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Boons ) target @ { RPDIR "bo/" }cat nextprop "" stringcmp if "Boons" header tellme "|Boons---------------------|Rank|Val.| |Boons---------------------|Rank|Val.|" tellme #-2 target @ { RPDIR "bo/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 26 capitalize lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Banes ) target @ { RPDIR "ba/" }cat nextprop "" stringcmp if "Banes" header tellme "|Banes---------------------|Rank|Val.| |Banes---------------------|Rank|Val.|" tellme #-2 target @ { RPDIR "ba/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 26 capitalize lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Equipment ) target @ { RPDIR "eq/" }cat nextprop "" stringcmp if "Equipment" header tellme "|Equipment-----------------|Rank|Roll| |Qualities-----------------|Rank|Roll|" tellme #-2 target @ { RPDIR "eq/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 26 capitalize lj (ability) "|" value @ tostr 4 rj (XP in that pool) "|" value @ toint level 1 fchop 4 rj "|" (current level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Materials ) target @ { RPDIR "ma/" }cat nextprop "" stringcmp if "Materials / Items" header tellme "|Materials----------------------|Qty.| |Materials----------------------|Qty.|" tellme #-2 target @ { RPDIR "ma/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop capitalize 31 lj (ability) "|" value @ qtystr 4 rj "|" (XP in that pool) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then { MUCKNAME }cat footer tellme ; PUBLIC sheet : init $pubdef actions.init +init;+chargen param @ "RESET" strcmp not if AVATAR { "@set *" me @ "=" RPDIR ":" }cat force AVATAR { "wc " me @ " reset their sheet using " command @ " " param @ "!" }cat force "Thy sheet hath been cleared." INFORM RPSYS "/System/Chargen/" me @ RPDIR 1 copyprops pop "" param ! sheet "You may start buying skills with +buy." INFORM else { "To reset your sheet, use " command @ " RESET" }cat INFORM then ; PUBLIC init : buy $pubdef actions.buy +buy/primary;+buy/skill;+buy/ability;+buy/spell;+buy/quality;+buy/boon;+buy/bane;+buy/equip;+buy/material var spent var total var unspent var xp var stattype command @ case "+buy/attr" smatch when "at" stattype ! end "+buy/skill" smatch when "sk" stattype ! end "+buy/ability" smatch when "ab" stattype ! end "+buy/spell" smatch when "sp" stattype ! end "+buy/tech" smatch when "te" stattype ! end "+buy/quality" smatch when "qu" stattype ! end "+buy/boon" smatch when "bo" stattype ! end "+buy/bane" smatch when "ba" stattype ! end "+buy/equip" smatch when "eq" stattype ! end "+buy/material" smatch when "ma" stattype ! end default pop { "Something's screwed up!" }cat tellme exit end endcase param @ "=" explode 2 = not if "+buy/ =" "Buy" pretty tellme exit else stat ! toint value ! me @ "xp" getstatint total ! me @ "xpspent" getstatint spent ! total @ spent @ - unspent ! me @ stattype @ stat @ strcat getstatint xp ! value @ unspent @ > if { "You dont have enough XP to put in that pool. Value:[" value @ "] Unspent:[" unspent @ "] Needed:[" value @ unspent @ - "]" }cat "Buy" pretty tellme exit then me @ "validated?" getstatint if "You cannot remove XP from a pool while validated." "Buy" pretty tellme exit else value @ 0 xp @ - < if { "You dont have enough XP in that pool to take out. Value:[" value @ "] In pool:[" xp @ "] Over by:[" 0 xp @ - value @ - "]" }cat "Buy" pretty tellme exit then then me @ stattype @ stat @ strcat xp @ value @ + setstat me @ xpspent pop me @ "xpspent" getstatint spent ! me @ stattype @ stat @ strcat getstatint xp ! total @ spent @ - unspent ! { stattype @ "/" stat @ " was adjusted by " value @ "xp. Current:[" xp @ "] Level:[" xp @ level 2 fchop "] XP left:[" unspent @ "]" }cat "Buy" pretty tellme then ; PUBLIC buy : prove $pubdef actions.prove prove;+prove var result var result-prop me @ param @ find-stat result ! result-prop ! result @ if { me @ " has a stat ^YELLOW^" result-prop @ "^NORMAL^ with a value of ^GREEN^" result @ "^NORMAL^." }cat th else { me @ " does ^RED^not^NORMAL^ have a stat called " param @ }cat th then ; PUBLIC prove : roll $pubdef actions.roll roll;+roll var value var item var ndie var stats var curstat var fullstat var statval var curnum var curdie var curtot var grandt var modifier var foreigns 0 ndie ! 0 modifier ! 0 foreigns ! param @ not if { command @ " ++..." }cat tm exit then ( Seperate stats ) param @ "+" explode_array stats ! ( Anything not ndx ) stats @ foreach curstat ! curstat @ "*[0-9]d[0-9]*" smatch not if ( Add nd10 stats together ) pop me @ curstat @ find-stat swap pop toint ndie @ + ndie ! ( Pure integers get added to modifier ) curstat @ toint if curstat @ toint modifier @ + modifier ! then ( Until done ) then repeat ( Limit to 0-12 die ) ndie @ 0 12 limit ndie ! ( Begin rolling string ) { me @ " rolls " ( List the stats we'll be using ) { stats @ foreach curstat ! pop me @ curstat @ find-stat swap pop statval ! { "^YELLOW^" curstat @ "^NORMAL^(^GREEN^" statval @ "^NORMAL^)" }cat repeat }array "+" array_join ndie @ if ( How many 1d10's we get to roll ) " = ^YELLOW^" ndie @ "d10^NORMAL^" ( Roll the 1d10's ) ndie @ nd10 curtot ! curdie ! "(^CYAN^" curdie @ " " array_join "^NORMAL^ = ^GREEN^" curtot @ "^NORMAL^)" ( add it to the grand total ) curtot @ grandt ! then ( roll the foreigns ) stats @ foreach curstat ! pop curstat @ "*[0-9]d[0-9]*" smatch if { "^NORMAL^ + ^YELLOW^" curstat @ "^NORMAL^(^CYAN^" curstat @ "d" split toint curdie ! toint curnum ! curnum @ 0 32 limit curdie @ 0 65536 limit ndx curtot ! curdie ! curdie @ " " array_join "^NORMAL^ = ^GREEN^" curtot @ "^NORMAL^)" }cat ( add the foreigns to the grand totals ) curtot @ grandt @ + grandt ! ( Until done ) then repeat ( add the modifier ) modifier @ if " + ^GREEN^" modifier @ "^NORMAL^" modifier @ grandt @ + grandt ! then ( display result ) " = ^YELLOW^" grandt @ "^NORMAL^" ( Make a string then write it. ) }cat th ; PUBLIC roll : spend $pubdef actions.spend +pay;+give;use;+hp;+ess command @ "+pay" stringcmp not if param @ "=" explode 2 = not if "+pay =" "$" pretty tellme exit else pmatch target ! tofloat value ! target @ #-1 dbcmp if { "Target " param @ " not found." }cat "$" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "$" pretty tellme exit then value @ 0 < if "You cannot give someone negative cash." "$" pretty tellme exit then me @ "gp" getstatfloat value @ >= if me @ "gp" getstatfloat value @ - me @ swap "gp" swap setstat target @ "gp" getstatfloat value @ + target @ swap "gp" swap setstat { me @ " gives $" value @ 2 fchop " to " target @ "." }cat "$" pretty tellhere { me @ " gives $" value @ 2 fchop " to " target @ "." }cat "$" pretty target @ swap ansi_notify else { "You dont have enough money! Value:[" value @ "]." }cat "$" pretty tellme then then then command @ "+give" stringcmp not if param @ "=" explode 3 = not if "+give ==" "Give" pretty tellme exit else pmatch target ! stat ! toint value ! target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Give" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "Give" pretty tellme exit then value @ 0 < if "You cannot give someone a negative amount of an item." "Give" pretty tellme exit then me @ "ma/" stat @ strcat getstatint value @ >= if me @ "ma/" stat @ strcat getstatint value @ - me @ swap "ma/" stat @ strcat swap setstat target @ "ma/" stat @ strcat getstatint value @ + target @ swap "ma/" stat @ strcat swap setstat { me @ " gives " value @ " " stat @ "(s) to " target @ "." }cat "Give" pretty tellhere else { "You dont have enough " stat @ " to give! Value:[" value @ "]." }cat "Give" pretty tellme then then then command @ "+use" stringcmp not if param @ stat ! 1 value ! me @ "ma/" stat @ strcat getstatint dup value @ >= swap -1 = or if me @ "ma/" stat @ strcat getstatint dup -1 = not if value @ - me @ swap "ma/" stat @ strcat swap setstat then { me @ " uses an item: [^CYAN^" stat @ "^NORMAL^]." }cat "Use" pretty tellhere else { "You dont have any ^CYAN^" stat @ "^NORMAL^ to use!" }cat "Use" pretty tellme then then command @ "+hp" stringcmp not if param @ "=" explode 1 = not if "+hp " "HP" pretty tellme exit else toint value ! value @ 0 < if me @ "hp" getstatint value @ - me @ swap "hp" swap setstat { me @ " has healed themselves. Value:[" value @ "] HP:[" me @ "hp" getstatint "]" }cat "HP" pretty tellhere AVATAR { "wc " me @ " has healed themselves. Value:[" value @ "] HP:[" me @ "hp" getstatint "]" }cat force then me @ "hp" getstatint value @ >= if me @ "hp" getstatint value @ - me @ swap "hp" swap setstat { me @ " adjustes their Health Points by [" value @ "]." }cat "HP" pretty tellhere else me @ "hp" getstatint value @ - me @ swap "hp" swap setstat { me @ " has adjusted their HP below zero, and is in KO status. Value:[" value @ "] HP:[" me @ "hp" getstatint "]" }cat "HP" pretty tellhere AVATAR { "wc " me @ " has adjusted their HP below zero, and is in KO status. Value:[" value @ "] HP:[" me @ "hp" getstatint "]" }cat force then then then command @ "+ess" stringcmp not if param @ "=" explode 1 = not if "+ess " "Essence" pretty tellme exit else toint value ! value @ 0 < if me @ "ess" getstatint value @ - me @ swap "ess" swap setstat { me @ " has healed themselves. Value:[" value @ "] Ess:[" me @ "ess" getstatint "]" }cat "Essence" pretty tellhere AVATAR { "wc " me @ " has gained essence. Value:[" value @ "] Ess:[" me @ "hp" getstatint "]" }cat force then me @ "Ess" getstatint value @ >= if me @ "Ess" getstatint value @ - me @ swap "Ess" swap setstat { me @ " adjustes their Essence by [" value @ "]." }cat "Essence" pretty tellhere else me @ "Ess" getstatint value @ - me @ swap "Ess" swap setstat { me @ " has adjusted their HP below zero, and is in KO status. Value:[" value @ "] Ess:[" me @ "ess" getstatint "]" }cat "Essence" pretty tellhere AVATAR { "wc " me @ " has adjusted their Essence below zero. Value:[" value @ "] Ess:[" me @ "ess" getstatint "]" }cat force then then then ; PUBLIC spend : validate $pubdef actions.validate +validate;+invalidate me @ "W" flag? not if "Only staff may validate players." "Validate" pretty tellme exit then param @ "" stringcmp not if me @ target ! else param @ pmatch target ! then target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Validate" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "Validate" pretty tellme exit then command @ "+validate" stringcmp not if target @ "validated?" 1 setstat target @ "validatedby" me @ setstat target @ "validatedat" systime setstat target @ { me @ " has validated your sheet. RP on!" }cat "RPStaff" pretty ansi_notify AVATAR { "wc " me @ " has validated " target @ "'s sheet." }cat force { "You have validated " target @ "'s sheet." }cat INFORM then command @ "+invalidate" stringcmp not if target @ "validated?" 0 setstat AVATAR { "wc " me @ " has invalidated " target @ "'s sheet." }cat force { "You have unvalidated " target @ "'s sheet." }cat INFORM then ; PUBLIC validate : vote $pubdef actions.vote +vote;+vote/all var temp command @ "+vote" stringcmp not if param @ "=" explode temp ! temp @ 1 < temp @ 5 > or if "+vote =<1..5>" "vote" pretty tellme exit else temp @ 1 = if pmatch target ! 1 value ! else pmatch target ! toint value ! then target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Vote" pretty tellme exit then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "Vote" pretty tellme exit then target @ me @ dbcmp if { "You cannot vote for yourself, foo!" }cat "Vote" pretty tellme exit then value @ 1 < if 1 value ! then value @ MAXVOTES > if MAXVOTES value ! then me @ "W" flag? me @ "votes" getstatint value @ >= or if me @ "W" flag? not if me @ "votes" getstatint value @ - me @ "votes" rot setstat then target @ "xp" getstatint value @ + target @ "xp" rot setstat { "You vote for " target @ " with " value @ 1 = if value @ " vote" else value @ " votes" then "." }cat "Vote" pretty tellme target @ { "You gained " value @ "xp from votes by " me @ "." }cat "Vote" pretty ansi_notify else { "You dont have enough votes! Target:[" target @ "] Value:[" value @ "]." }cat "Vote" pretty tellme then then then command @ "+vote/all" stringcmp not if me @ location contents_array foreach target ! pop target @ player? if target @ awake? if target @ "validated?" getstatint if target @ idletime 900 <= if target @ me @ dbcmp not if 1 value ! me @ "votes" getstatint value @ >= if me @ "votes" getstatint value @ - me @ "votes" rot setstat target @ "xp" getstatint value @ + target @ "xp" rot setstat { "You vote for " target @ " with " value @ 1 = if value @ " vote" else value @ " votes" then "." }cat "Vote" pretty tellme target @ { "You gained " value @ "xp from votes by " me @ "." }cat "Vote" pretty ansi_notify else { "You dont have enough votes! Target:[" target @ "] Value:[" value @ "]." }cat "Vote" pretty tellme then then then then then then repeat then ; PUBLIC vote : coststr ( f -- s ) dup 0.001 = if pop "FREE " exit then dup -0.001 = if pop "FREE*" exit then dup -0.001 < if 2 fchop "*" strcat exit then 2 fchop " " strcat ; : store $pubdef actions.store +store;+store/buy;+store/sell;+store/trash var stat var value var icost var item var qty var target me @ location target ! command @ case "+store" stringcmp not when "^YELLOW^+--------------------------------+--------+--------+^NORMAL^" tellme "^YELLOW^|^NORMAL^Items available ^YELLOW^|^NORMAL^ Buy$ ^YELLOW^|^NORMAL^ Sell $ ^YELLOW^|^NORMAL^" tellme "^YELLOW^+--------------------------------+--------+--------+^NORMAL^" tellme target @ { RPDIR "ma/" }cat array_get_propvals foreach value ! stat ! { "^YELLOW^|^NORMAL^" stat @ 32 lj "^YELLOW^|^NORMAL^" value @ coststr 8 rj "^YELLOW^|^NORMAL^" value @ 2 / coststr 8 rj "^YELLOW^|^NORMAL^" }cat tellme repeat "^YELLOW^+--------------------------------+--------+--------+^NORMAL^" tellme end "+store/buy" stringcmp not when param @ "=" explode case 2 = when item ! toint qty ! end 1 = when item ! 1 qty ! end default "+store/buy [=]" "$" pretty tellme exit end endcase me @ target ! qty @ 1 < if "You cannot buy zero or negative amount of an item." "$" pretty tellme exit then me @ location "ma/" item @ strcat getstatfloat icost ! icost @ 0 = if { "Item [" item @ "] not available in the store." }cat "$" pretty tellme exit then ( Handle free items ) icost @ -0.001 = if me @ "ma/" item @ strcat -1 setstat { me @ " got item [^YELLOW^" item @ "^NORMAL^] for ^GREEN^FREE^NORMAL^ for unlimited use." }cat "$" pretty tellhere exit then icost @ 0.001 = if me @ "ma/" item @ strcat getstatint 1 + me @ "ma/" item @ strcat rot setstat { me @ " got item [^YELLOW^" item @ "^NORMAL^] for ^GREEN^FREE^NORMAL^." }cat "$" pretty tellhere exit then ( Handle items that manipulate money ) icost @ 0 < if ( Pay for unlimited use ) 0 icost @ - icost ! me @ "gp" getstatfloat icost @ >= if me @ "gp" getstatfloat icost @ - me @ swap "gp" swap setstat me @ "ma/" item @ strcat -1 setstat { me @ " buys [^YELLOW^" item @ "^NORMAL^] for ^GREEN^$" icost @ qty @ * 2 fchop "^NORMAL^ for unlimited uses" }cat "$" pretty tellhere else { "You dont have enough money! Cost: [$" icost @ qty @ * 2 fchop "]." }cat "$" pretty tellme then else ( pay per use ) me @ "gp" getstatfloat icost @ qty @ * >= if me @ "gp" getstatfloat icost @ qty @ * - me @ swap "gp" swap setstat me @ "ma/" item @ strcat getstatint qty @ + me @ "ma/" item @ strcat rot setstat { me @ " buys " qty @ " [^YELLOW^" item @ "^NORMAL^](s) for ^GREEN^$" icost @ qty @ * 2 fchop "^NORMAL^." }cat "$" pretty tellhere else { "You dont have enough money! Cost: [$" icost @ qty @ * 2 fchop "]." }cat "$" pretty tellme then then end "+store/sell" stringcmp not when param @ "=" explode case 2 = when item ! toint qty ! end 1 = when item ! 1 qty ! end default "+store/sell [=]" "$" pretty tellme exit end endcase me @ target ! qty @ 1 < if "You cannot sell zero or negative amount of an item." "$" pretty tellme exit then me @ location "ma/" item @ strcat getstatfloat icost ! icost @ 0 = if { "Item [" item @ "] not sellable in the store." }cat "$" pretty tellme exit then me @ "ma/" item @ strcat getstatint if ( Handle free items ) icost @ 0.001 <= if me @ "ma/" item @ strcat 0 setstat { me @ " trashes item [^YELLOW^" item @ "^NORMAL^]. (Sold for FREE)." }cat "$" pretty tellme exit then ( Handle items that manipulate money ) me @ "ma/" item @ strcat getstatint qty @ >= if me @ "gp" getstatfloat icost @ qty @ * 2 / + me @ swap "gp" swap setstat me @ "ma/" item @ strcat getstatint qty @ - me @ "ma/" item @ strcat rot setstat { me @ " sells " qty @ " [^YELLOW^" item @ "^NORMAL^](s) for ^GREEN^$" icost @ qty @ * 2 / 2 fchop "^NORMAL^." }cat "$" pretty tellhere else { "You dont have enough of these!" }cat "$" pretty tellme then then end "+store/trash" stringcmp not when param @ item ! me @ "ma/" item @ strcat getstatint 0 = if "None of that item to trash." "$" pretty tellme else me @ "ma/" item @ strcat 0 setstat { "Item(s) " item @ " trashed." }cat "$" pretty tellme then end default "Invalid command." "Store" pretty tellme end endcase ; PUBLIC store : buyrace $pubdef actions/buyrace +buy/race ; PUBLIC buyrace : install { prog "_defs" array_get_propvals foreach swap "actions.*" smatch not if pop then repeat }array var! actions { prog name " v" prog "_version" getprop " by " prog "_author" getprop }cat header tellme prog "_note" getprop "DESCRIPTION" pretty tellme "$lib/rp $lib/alynna BOY LINK_OK AUTOSTART" "REQUIRES" pretty tellme prog "_defs" array_get_propvals array_keys array_make " " array_join "DEFINES" pretty tellme #0 prog name "/install" strcat rmatch dup var! act getlink prog dbcmp not if #0 { prog name "/install;" actions @ ";" array_join }cat newexit prog setlink else act @ { prog name "/install;" actions @ ";" array_join }cat setname then actions @ " " array_join "ACTIONS" pretty tellme MUCKNAME footer tellme ; : sysheart $pubdef actions.sysheart +sysheart var target var gained background DEBUG if AVATAR "wc World Heart activated." force then begin online_array foreach target ! pop target @ "validated?" getstatint if target @ "lifecycle" getstatint 1 + target @ "lifecycle" rot setstat ( Regain HP ) target @ "hp" getstatint target @ maxhp < if target @ "a/Regeneration" getstatint level 1 + toint gained ! target @ "hp" getstatint gained @ + dup target @ maxhp > if pop target @ maxhp then target @ "hp" rot setstat target @ { "You gained " gained @ "hp, from natural regeneration." }cat "WorldHeart" pretty ansi_notify then target @ "votes" getstatint 1 + dup 25 > if pop 25 then target @ "votes" rot setstat ( Earn Refresh points and gain more XP ) target @ idletime 900 < if ( Only score points if not idle ) target @ "~status" getstatstr "OOC" stringcmp if ( And not OOC ) target @ "refreshpoints" getstatint target @ location NUMPLAYERS + target @ "refreshpoints" rot setstat target @ "refreshpoints" getstatint 9 > if target @ { "You gained 10 or more refreshpoints, awarding 1 XP." }cat "WorldHeart" pretty ansi_notify target @ "xp" getstatint 1 + target @ "xp" rot setstat target @ "refreshpoints" getstatint 10 - target @ "refreshpoints" rot setstat then then then target @ "lifecycle" getstatint 4 % not if ( every 4 beats - 1 hour ) ( get GP ) target @ "a/resources" getstatint level tofloat 5 * gained ! target @ "gp" getstatfloat gained @ + target @ "gp" rot setstat target @ { "You gained $" gained @ 2 fchop ", from your IC job." }cat "WorldHeart" pretty ansi_notify then then repeat AVATAR "wc :'s heart beats." force 900 sleep repeat ; PUBLIC sysheart : main var function var action param ! ( Install: First time use setup ) command @ { prog name "/install" }cat smatch if install exit then ( Called from sysheart ) command @ "Queued Event." stringcmp not if sysheart exit then ( Anything else we check a define for ) prog "_defs" array_get_propvals foreach action ! function ! function @ "actions.*" smatch not if continue then command @ { "{" action @ "|" ";" subst "}" }cat smatch if prog function @ "" "actions." subst call exit then repeat "ERROR IN RPSYSTEM: FALLTHROUGH!" tm ; . c q @program $lib/rp 1 1000 d i ( LibRPS.muf.so.1.0 -- Alynna Trypnotk ) $pubdef : $def RPSYSTEM "$rpsystem" match $def RPBASE "/@rps/" $include $lib/alynna $include $lib/rps $libdef envstat : envstat[ dbref:target str:prop -- d ? ] ( finds a stat up the environment, returns the first object it finds it on ) target @ prop @ RPBASE swap strcat envprop ( return the object ) ; PUBLIC envstat $libdef envstatobj : envstatobj[ dbref:target str:prop -- d ] ( finds a stat up the environment, returns the first object it finds it on ) target @ prop @ envstat pop ; PUBLIC envstatobj $libdef envstatval : envstatval[ dbref:target str:prop -- ? ] ( finds a stat up the environment, returns the first stat it finds ) target @ prop @ envstat swap pop ; PUBLIC envstatval $libdef getstat : getstat[ dbref:target str:prop -- d ? ] ( this getstat function is set up to support virtual stats ) ( first of all, if the prop exists, its assumed to be ) ( overriden, even if it is a virtual stat) target @ prop @ 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 $libdef setstat : setstat[ dbref:target str:prop value -- ] target @ RPBASE prop @ strcat value @ setprop ; PUBLIC setstat $libdef getstatint : getstatint[ dbref:target str:prop -- i ] target @ prop @ getstat dup not if pop 0 else toint then ; PUBLIC getstatint $libdef getstatref : getstatref[ dbref:target str:prop -- i ] target @ prop @ getstat dup not if pop #-1 else todbref then ; PUBLIC getstatref $libdef getstatfloat : getstatfloat[ dbref:target str:prop -- f ] target @ prop @ getstat dup not if pop 0.0 else tofloat then ; PUBLIC getstatfloat $libdef getstatstr : getstatstr[ dbref:target str:prop -- s ] target @ prop @ getstat dup not if pop "" else tostr then ; PUBLIC getstatstr $libdef 1dx : 1dx[ int:diesides -- int:result ] ( outputs 1dx ) diesides @ random swap % 1 + ; PUBLIC 1dx $libdef ndx : ndx[ int:n int:x -- a i ] var die { }array die ! 0 1 n @ 1 for pop random x @ % 1 + dup die @ array_appenditem die ! + repeat die @ swap ; PUBLIC ndx $libdef ldie : ldie ( i -- i ) case 1 = when 20 end 2 = when 12 end 3 = when 10 end 4 = when 8 end 5 = when 6 end 6 = when 4 end default 0 end endcase ; PUBLIC ldie $libdef makedots : makedots ( i i -- s } Chars long, Position of dot ) "" -3 rotate 0 begin ( s chars dot count ) 3 pick over = not while over over 1 + = if "*^BBLACK^" else "-" then 5 rotate swap strcat -4 rotate 1 + repeat pop pop pop "^BGREEN^^WHITE^" swap strcat "^NORMAL^" strcat ; PUBLIC makedots $libdef makedie : makedie ( i -- s ) dup 1 < if pop "20" 0 then dup 1 = if pop "20" 0 then dup 2 = if pop "12" 0 then dup 3 = if pop "10" 0 then dup 4 = if pop "8" 0 then dup 5 = if pop "6" 0 then dup 5 > if pop "4" 0 then pop "1d" swap strcat ; PUBLIC makedie . c q FMLRPS-YerfXAlpha2.muf/install