@program BasicRPsystem.1.3.MUF 1 10000 d i $undef ansi_strcut $undef ansi_strlen ( The DOS of RP systems ) ( (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 ( Edit these ) $def INFORM "BRP" pretty tellme $def AVATAR #94 $def MUCKNAME "DarkChronicles" $def RPDIR "/@rps/" ( Comment these out to taste ) ( $def PLAYER_PETS 1 ) $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 lvar param lvar target lvar stat lvar value lvar dicestore lvar dicestore4 : 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 ; : xpspent ( d -- i ) var target var xpspentf var stat var value target ! 0 xpspentf ! target @ { RPDIR "a/" }cat array_get_propvals foreach value ! stat ! value @ xpspentf @ + xpspentf ! repeat target @ { RPDIR "e/" }cat array_get_propvals foreach value ! stat ! value @ xpspentf @ + xpspentf ! repeat target @ "xpspent" xpspentf @ setstat xpspentf @ ; PUBLIC xpspent : nd6 ( i/f -- i ) var temp temp ! "" dicestore ! 0 begin temp @ while random 6 % 1 + dup tostr dicestore @ swap strcat " " strcat dicestore ! + temp @ 1 - temp ! repeat dicestore @ strip dicestore ! ; PUBLIC nd6 : nd4 ( i/f -- i ) var temp temp ! "" dicestore4 ! 0 begin temp @ while random 4 % 1 + dup tostr dicestore4 @ swap strcat " " strcat dicestore4 ! + temp @ 1 - temp ! repeat dicestore4 @ strip dicestore4 ! ; PUBLIC nd4 : 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 : fmt76 ( s -- s ) "|" swap strcat " " strcat 77 ansi_strcut pop "|" strcat ; PUBLIC 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 : 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 : maxhp ( d -- i ) "a/raise-hp" getstatint level toint 10 + 6 * ; PUBLIC maxhp : cost ( d s -- f ) getstatfloat level toint dup 16 = if 0 else 2.0 swap 1.0 + pow then ; PUBLIC cost : init 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 me @ "xp" 512 setstat me @ "hp" 60 setstat me @ "gp" 100 setstat me @ "votes" 25 setstat "At chargen: 25 votes, 512xp, 100gp, 60hp to start, you may start buying skills with +buy." INFORM else { "To reset your sheet, use " command @ " RESET" }cat INFORM then ; : rpset 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 ; : qtystr dup -1 = if pop "PERM" exit then tostr ; : 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 { " HP:[^GREEN^" target @ "hp" getstatint tostr 3 rj "/" target @ maxhp tostr 3 rj "^NORMAL^] " "XP:[^CYAN^" target @ "xp" getstatint tostr 6 rj "^NORMAL^] " "Unspent:[^CYAN^" target @ "xp" getstatint target @ "xpspent" getstatint - tostr 6 rj "^NORMAL^] " "$:[$^YELLOW^" target @ "gp" getstatfloat 2 fchop 12 rj "^NORMAL^] " "Valid:[^GRAY^" target @ "validated?" getstatint if "Yes" else "No " then "^NORMAL^]" }cat fmt76 tellme { " Votes:[^GREEN^" target @ "votes" getstatint tostr 2 rj "/25^NORMAL^] " "Points:[^CYAN^" target @ "refreshpoints" getstatint tostr 1 rj "^NORMAL^] " "Level:[^CYAN^" target @ "xp" getstatint 512 - level 2 fchop 8 rj "^NORMAL^] " "Resources:[^YELLOW^" target @ "a/resources" getstatint level int tostr 2 rj "^NORMAL^] " "Regen:[^GRAY^" target @ "a/regeneration" getstatint level int tostr 2 rj "^NORMAL^]" }cat fmt76 tellme ( abilities ) target @ { rpdir "a/" }cat nextprop "" stringcmp if "Abilities / Spells / Knowledges" header tellme "|Ability--------------| XP |Next|Lev.| |Ability--------------| XP |Next|Lev.|" tellme #-2 target @ { RPDIR "a/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 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 $ifdef PLAYER_PETS ( Pets ) target @ { RPDIR "p/" }cat nextprop "" stringcmp if "Pets" header tellme "|Name--------------|S-Species---|Lev.| |Name--------------|S-Species---|Lev.|" tellme #-2 target @ { RPDIR "p/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 18 lj (Name) "|" value @ "/sex" getprop 1 lj (Sex) " " value @ "/species" getprop 10 lj (Species) "|" value @ "xp" getstatint level int intostr 4 rj "|" (Pokemon level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then ( Owners ) target @ { RPDIR "q/" }cat nextprop "" stringcmp if "Owners" header tellme "|Name--------------|S-Species---|Lev.| |Name--------------|S-Species---|Lev.|" tellme #-2 target @ { RPDIR "q/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 18 lj (Name) "|" value @ "/sex" getprop 1 lj (Sex) " " value @ "/species" getprop 10 lj (Species) "|" value @ "xp" getstatint level int intostr 4 rj "|" (Pokemon level) }cat over string? not if " " strcat else strcat tellme then repeat dup string? if " |" strcat tellme then pop then $endif ( Equipment ) target @ { RPDIR "e/" }cat nextprop "" stringcmp if "Equipment / Armor / Weapons" header tellme "|Equipment-----------------| XP |Lev.| |Equipment-----------------| XP |Lev.|" tellme #-2 target @ { RPDIR "e/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 26 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 "m/" }cat nextprop "" stringcmp if "Materials / Items" header tellme "|Materials----------------------|Qty.| |Materials----------------------|Qty.|" tellme #-2 target @ { RPDIR "m/" }cat array_get_propvals foreach value ! stat ! { "|" stat @ dup "/" rinstr strcut swap pop 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 ; : xpshow 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 target @ xpspent pop { "Basic report for " me @ }cat header tellme { " HP:[^GREEN^" target @ "hp" getstatint tostr 3 rj "/" target @ maxhp tostr 3 rj "^NORMAL^] " "XP:[^CYAN^" target @ "xp" getstatint tostr 6 rj "^NORMAL^] " "Unspent:[^CYAN^" target @ "xp" getstatint target @ "xpspent" getstatint - tostr 6 rj "^NORMAL^] " "$:[^YELLOW^$" target @ "gp" getstatfloat 2 fchop 12 rj "^NORMAL^] " "Valid:[^GRAY^" target @ "validated?" getstatint if "Yes" else "No " then "^NORMAL^]" }cat fmt76 tellme { " Votes:[^GREEN^" target @ "votes" getstatint tostr 2 rj "/25^NORMAL^] " "Points:[^CYAN^" target @ "refreshpoints" getstatint tostr 1 rj "^NORMAL^] " "Level:[^CYAN^" target @ "xp" getstatint 512 - level 2 fchop 5 rj "^NORMAL^] " "Resources:[^YELLOW^" target @ "a/resources" getstatint level int tostr 2 rj "^NORMAL^] " "Regen:[^GRAY^" target @ "a/regeneration" getstatint level int tostr 2 rj "^NORMAL^]" }cat fmt76 tellme { " 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 ; : buy var spent var total var unspent var xp command @ "+buy" stringcmp not if me @ "validated?" getstatint if "You can only +buy skills like this while unvalidated. Please use +learn." "Buy" pretty tellme exit else 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 @ "a/" 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 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 me @ "a/" stat @ strcat xp @ value @ + setstat me @ xpspent pop me @ "xpspent" getstatint spent ! me @ "a/" stat @ strcat getstatint xp ! total @ spent @ - unspent ! { stat @ " was adjusted by " value @ "xp. Current:[" xp @ "] Level:[" xp @ level 2 fchop "] XP left:[" unspent @ "]" }cat "Buy" pretty tellme then then then command @ "+buyequip" stringcmp not if me @ "validated?" getstatint if "You can only +buyequip while unvalidated. Please use +learn." "BuyEquip" pretty tellme exit else 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 @ "e/" stat @ strcat getstatint xp ! value @ unspent @ > if { "You dont have enough XP to put into that equipment. Value:[" value @ "] Unspent:[" unspent @ "] Needed:[" value @ unspent @ - "]" }cat "BuyEquip" pretty tellme exit then value @ 0 xp @ - < if { "You dont have enough XP in that equipment to take out. Value:[" value @ "] In pool:[" xp @ "] Over by:[" 0 xp @ - value @ - "]" }cat "BuyEquip" pretty tellme exit then me @ "e/" stat @ strcat xp @ value @ + setstat me @ xpspent pop me @ "xpspent" getstatint spent ! me @ "e/" stat @ strcat getstatint xp ! total @ spent @ - unspent ! { stat @ " was adjusted by " value @ "xp. Current:[" xp @ "] Level:[" xp @ level 2 fchop "] XP left:[" unspent @ "]" }cat "BuyEquip" pretty tellme then then then ; : train var spent var total var unspent var xp me @ "validated?" getstatint not if "You can only +learn skills while validated. Please use +buy." "Learn" pretty tellme exit else param @ "=" explode 2 = not if "+learn =" "Learn" pretty tellme exit else stat ! toint value ! me @ "xp" getstatint total ! me @ "xpspent" getstatint spent ! total @ spent @ - unspent ! me @ "a/" 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 "Learn" pretty tellme exit then value @ 0 < if { "You cannot take XP out of a pool while validated. Value:[" value @ "]" }cat "Learn" pretty tellme exit then me @ "a/" stat @ strcat xp @ value @ + setstat me @ xpspent pop me @ "xpspent" getstatint spent ! me @ "a/" stat @ strcat getstatint xp ! total @ spent @ - unspent ! { stat @ " was increased by " value @ "xp. Current:[" xp @ "] Level:[" xp @ level 2 fchop "] XP left:[" unspent @ "]" }cat "Learned" pretty tellme then then ; : roll var params var equip param @ "=" explode params ! params @ 1 = if param ! me @ "a/" param @ strcat getstatint level toint 1 + nd6 stat ! { me @ " rolled [^GREEN^" param @ "^NORMAL^]: (" dicestore @ ") = ^CYAN^" stat @ " (" stat @ successlevel ")" }cat "Roll" pretty tellhere then params @ 2 = if param ! equip ! me @ "a/" param @ strcat getstatint level toint 1 + nd6 stat ! me @ "e/" equip @ strcat getstatint dup 0 = if pop { me @ " rolled [^GREEN^" param @ "^NORMAL^]: (" dicestore @ ") = ^CYAN^" stat @ " (" stat @ successlevel ")" }cat "Roll" pretty tellhere else level toint dup me @ "a/" param @ strcat getstatint level toint > if pop me @ "a/" param @ strcat getstatint level toint then nd4 value ! { me @ " rolled [^GREEN^" param @ "^NORMAL^] with [^GREEN^" equip @ "^NORMAL^]: (" dicestore @ " + " dicestore4 @ ") = ^CYAN^" stat @ value @ + " (" stat @ value @ + successlevel ")" }cat "Roll" pretty tellhere then then ; : spend 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 @ "m/" stat @ strcat getstatint value @ >= if me @ "m/" stat @ strcat getstatint value @ - me @ swap "m/" stat @ strcat swap setstat target @ "m/" stat @ strcat getstatint value @ + target @ swap "m/" 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 @ "m/" stat @ strcat getstatint dup value @ >= swap -1 = or if me @ "m/" stat @ strcat getstatint dup -1 = not if value @ - me @ swap "m/" 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 @ "+spendhp" stringcmp not if param @ "=" explode 1 = not if "+spendhp " "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 "GP" 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 "GP" 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 "GP" 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 ; : validate 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 ; : vote var temp command @ "+vote" stringcmp not if param @ "=" explode temp ! temp @ 1 < temp @ 2 > or if "+vote =<1..3>" "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 @ "+voteall" 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 ; : 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 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 "m/" }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 "m/" 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 @ "m/" 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 @ "m/" item @ strcat getstatint 1 + me @ "m/" 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 @ "m/" 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 @ "m/" item @ strcat getstatint qty @ + me @ "m/" 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 "m/" item @ strcat getstatfloat icost ! icost @ 0 = if { "Item [" item @ "] not sellable in the store." }cat "$" pretty tellme exit then me @ "m/" item @ strcat getstatint if ( Handle free items ) icost @ 0.001 <= if me @ "m/" item @ strcat 0 setstat { me @ " trashes item [^YELLOW^" item @ "^NORMAL^]. (Sold for FREE)." }cat "$" pretty tellme exit then ( Handle items that manipulate money ) me @ "m/" item @ strcat getstatint qty @ >= if me @ "gp" getstatfloat icost @ qty @ * 2 / + me @ swap "gp" swap setstat me @ "m/" item @ strcat getstatint qty @ - me @ "m/" 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 @ "m/" item @ strcat getstatint 0 = if "None of that item to trash." "$" pretty tellme else me @ "m/" item @ strcat 0 setstat { "Item(s) " item @ " trashed." }cat "$" pretty tellme then end default "Invalid command." "Store" pretty tellme end endcase ; : install "BASICRPSystem v1.0" header tellhere "The DOS of RP systems." "DESCRIPTION" pretty tellhere "$lib/rp $lib/alynna BOY LINK_OK AUTOSTART" "REQUIRES" pretty tellhere "fmt76 cost level level2xp maxhp nd6 nd4 successlevel idletime bdsm" "INCLUDES" pretty tellhere "+init;+chargen +sheet;sheet +buy;buyequip +train;+learn +roll;+check" "INSTALLS" pretty tellhere "+pay;+spendhp;+give;+use +validate;+invalidate +rp;+rpi;+rps;+rpf;+rpd" "INSTALLS" pretty tellhere "+vote;+voteall +xp;+votes;+points +sl +owner;+disown;+trade;+leave" "INSTALLS" pretty tellhere "+store;+store/buy;+store/sell;+store/trash" "INSTALLS" pretty tellhere "fmt76 cost level level2xp" "TESTABLE" pretty tellhere MUCKNAME footer tellhere ; : sysheart var target var gained background AVATAR "wc World Heart activated." force 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 ; $ifdef PLAYER_PETS : pp ( -- ) var source var target var tmp param @ "" stringcmp not if { "Commands: " "+owner (Pets) Set this person as your owner" "+leave (Pets) Leave the specified owner" "+disown (Owners) Disown the specified person" "+trade = (Owners) Give person1 to person2" } array_make atellme exit then command @ "+trade" smatch if param @ "=" explode tmp ! tmp @ 2 = not if { "Format: " command @ " =" }cat "Trade" pretty tellme exit then source ! target ! source @ tmp ! tmp @ pmatch source ! source @ #-1 dbcmp if tmp @ match source ! source @ #-1 dbcmp if { "Source " tmp @ " not found." }cat "Trade" pretty tellme exit then then source @ #-2 dbcmp if { "Target " tmp @ " matched more than once, be more specific." }cat "Trade" pretty tellme exit then target @ tmp ! tmp @ pmatch target ! target @ #-1 dbcmp if tmp @ match target ! target @ #-1 dbcmp if { "Target " param @ " not found." }cat "Trade" pretty tellme exit then then target @ #-2 dbcmp if { "Target " tmp @ " matched more than once, be more specific." }cat "Trade" pretty tellme exit then me @ { "p/" source @ name }cat getstat not if { "Gee, you dont own " source @ "!" }cat "Trade" pretty tellme exit then target @ "p/" source @ name strcat source @ setstat source @ "q/" target @ name strcat target @ setstat source @ "q/" me @ name strcat 0 setstat me @ "p/" source @ name strcat 0 setstat { me @ " just traded " source @ " to " target @ "." }cat "Trade" pretty tellhere exit then param @ pmatch target ! target @ #-1 dbcmp if param @ match target ! target @ #-1 dbcmp if { "Target " param @ " not found." }cat "OwnerCode" pretty tellme exit then then target @ #-2 dbcmp if { "Target " param @ " matched more than once, be more specific." }cat "OwnerCode" pretty tellme exit then command @ "+owner" smatch if target @ "p/" me @ name strcat me @ setstat me @ "q/" target @ name strcat target @ setstat { target @ " now owns you." }cat "Owner" pretty tellme target @ { me @ " just let you own them." }cat "Owner" pretty ansi_notify then command @ "+leave" smatch if target @ "p/" me @ name strcat 0 setstat me @ "q/" target @ name strcat 0 setstat { "You just left " target @ "!" }cat "Leave" pretty tellme target @ { me @ " just left you!" }cat "Leave" pretty ansi_notify then command @ "+disown" smatch if target @ "q/" me @ name strcat 0 setstat me @ "p/" target @ name strcat 0 setstat { "You just disowned " target @ "!" }cat "Disown" pretty tellme target @ { me @ " just disowned you!" }cat "Disown" pretty ansi_notify then ; PUBLIC pp $endif : main param ! ( Sysheart: Initialize the system heart ) command @ "{+sysheart}" smatch if sysheart exit then command @ "Queued Event." stringcmp not if sysheart exit then ( Install: First time use setup ) command @ "+BASICRPSystem/install" smatch if install exit then ( Init: Clear an invalidated sheet, and set it up for chargen ) command @ "{+init|+chargen}" smatch if init exit then ( Sheet: Display my sheet, or someone elses sheet ) command @ "{+sheet|sheet}" smatch if sheet exit then ( Buy: Adjust skills while chargenning or invalidated ) command @ "{+buy|+buyequip}" smatch if buy exit then ( Train: Adjust skills while validated ) command @ "{+train|+learn}" smatch if train exit then ( Roll: Roll one of the abilities you have ) command @ "{+roll|+check}" smatch if roll exit then ( Spend: Give GP or spend HP ) command @ "{+pay|+spendhp|+give|+use}" smatch if spend exit then ( Validate: (Staff only) Mark a sheet valid or invalid ) command @ "{+validate|+invalidate}" smatch if validate exit then ( RPSet: (Staff only) Set an RPStat manually ) command @ "{+rp|+rpi|+rps|+rpf|+rpd|+rpo}" smatch if rpset exit then ( Vote: Give a player 1-3 xp ) command @ "{+vote|+voteall}" smatch if vote exit then ( Store: Buy/Sell items in a store ) command @ "{+store|+store/buy|+store/sell|+store/trash}" smatch if store exit then ( XPShow: Show sheet summary ) command @ "{+xp|+votes|+points}" smatch if xpshow exit then $ifdef PLAYER_PETS ( PLAYER_PETS: Own or disown people ) command @ "{+owner|+disown|+leave|+trade}" smatch if pp exit then $endif ( testing section ) command @ "+rps/cost" smatch if { me @ param @ cost }cat "COST" pretty tellme exit then command @ "+rps/fmt76" smatch if { param @ .debug-on fmt76 .debug-off }cat tellme exit then command @ "+rps/level" smatch if { param @ tofloat level }cat tellme exit then command @ "+rps/level2xp" smatch if { param @ tofloat level2xp }cat tellme exit then command @ "+rps/idletime" smatch if { param @ pmatch idletime }cat tellme exit then command @ "+sl" smatch if { param @ toint successlevel }cat "Success Level" pretty tellme exit then ; . c q @program $lib/rp 1 10000 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