sub update{
my $time=$lastupdate;
until($time>time) {
#do events, checking from last update time to current time, incase it
#took more than a seconds for the update. still do updates in order.
if (defined($do{$time})){
while (@{$do{$time}}){
&{$do{$time}[0]{sub}}(@{$do{$time}[0]{args}});
shift @{$do{$time}};
}
}
$time++;
}
if (time-$mediumupdate>30){
$mediumupdate=time;
&mediumupdate;
}
if (time-$longupdate>300){
$longupdate=time;
&longupdate;
}
foreach $a (keys %outbuffer) {
#feed monsters their incoming data for scripts and general AI.
# in other words run the sub defined for the monster with each line of text he saw.
if (defined($user{$a}{monster})){
#split based on prompt
my @incoming=split(/\r\n\[\[34m: \[\[0m/,"$outbuffer{$a}");
delete $outbuffer{$a};
local $client=$a;
if (defined(&{$monster[$user{$a}{monster}]{script}})){
foreach $incoming (@incoming){
&{$monster[$user{$a}{"monster"}]{script}}($incoming);
}
handle($client);
delete($ready{$client});
}
}
}
foreach $a (keys %user){
#basic user updating info. decrease round stun, and check if dead body should decay
if ($user{$a}{round}){
$user{$a}{round}--;
if ($user{$a}{round}<=0) {
$outbuffer{$a}.="go\r\n$prompt";
}
}
if ($user{$a}{stun}){
$user{$a}{stun}--;
}
if ($user{$a}{balance}<100){
$user{$a}{balance}++;
}else{
$user{$a}{balance}=100;
}
if($user{$a}{dead}){
if (time-$user{$a}{dead}>300){
if (defined($user{$a}{monster})){
#monster is dead
say("the dead body of $user{$a}{name} decays into nothingness.",$user{$a}{room});
monsterdecay($a);
next;
}
else {
playerdecay($a);
#player is dead
next;
}
}
}
#incrementing EXP here
foreach $b (keys %{$user{$a}{exp}}){
#each overall type of exp, survival, weapons armor etc.
foreach $c (keys %{$user{$a}{exp}{$b}}){
#each specific type, light edge, medium edge etc.
#This is just some basic error checking, if it got this far but no data in pool
#give 1 xp point to avoid errors.
if ($c=~/total/) {
next;
}
unless (defined($user{$a}{exp}{$b}{$c}{pool})){
addexp("$c","$b",1,$a);
}
if ($user{$a}{exp}{$b}{$c}{pool}>0){
my $increase=0;
if ($user{$a}{exp}{$b}{$c}{pool}>($user{$a}{disc}*600)){
#mind locked
$increase=int($user{$a}{wis});
}
elsif ($user{$a}{exp}{$b}{$c}{pool}>600){
#not locked, normal learning
$increase=$user{$a}{wis}+(int(($user{$a}{exp}{$b}{$c}{pool}-600)/600)*3);
}
else {
#slow learning, pool is almost empty.
$increase=int($user{$a}{wis}/5);
}
if ($user{$a}{exp}{$b}{$c}{pool}>=$increase){
#move XP from pool to actual knowledge.
$user{$a}{exp}{$b}{$c}{pool}-=$increase;
$user{$a}{exp}{$b}{$c}{expcur}+=$increase*5;
}
else {
#pool is now emptied
$user{$a}{exp}{$b}{$c}{expcur}+=$user{$a}{exp}{$b}{$c}{pool}*10;
$user{$a}{exp}{$b}{$c}{pool}=0;
}
my $ranks=0;
while ($user{$a}{exp}{$b}{$c}{expcur}>=$user{$a}{exp}{$b}{$c}{expneeded}){
#while incase more than 1 rank gained.
$user{$a}{cppool}+=$user{$a}{exp}{$b}{$c}{ranks}+1;
while ($user{$a}{cppool}>50){
$user{$a}{cppool}-=50;
$user{$a}{cp}++;
} $user{$a}{exp}{$b}{$c}{expcur}=$user{$a}{exp}{$b}{$c}{expcur}-$user{$a}{exp}{$b}{$c}{expneeded};
$user{$a}{exp}{$b}{$c}{ranks}+=1;
$ranks++; $user{$a}{exp}{$b}{$c}{expneeded}=(($user{$a}{exp}{$b}{$c}{ranks}+1)**2)*100;
}
if ($ranks==1){
$outbuffer{$a}.="\r\nYou earn a rank of \u$c \u$b\r\n$prompt";
}
elsif ($ranks>1){
$outbuffer{$a}.="\r\nYou earn $ranks ranks of $c\r\n$prompt";
}
}
}
}
}
}
sub mediumupdate {
foreach $a (keys %user){
unless (defined ($user{$a}{vitality})){
#probably is logging in, or is immortal. or something just broke
next;
}
#handle health. heal and bleed.
$user{$a}{vitality}+=$user{$a}{con};
if ($user{$a}{vitality}>$user{$a}{vitalitymax}){
$user{$a}{vitality}=$user{$a}{vitalitymax}
}
foreach $b (keys %{$user{$a}{health}}){
#Each body part.
if (defined($user{$a}{health}{$b}{requires})){
#If it's not still conected to the body then it can't bleed.
my $c=$user{$a}{health}{"$b"}{requires};
if ($user{$a}{health}{"$c"}{hp}<=0){
next;
}
}
if ($user{$a}{health}{"$b"}{bleeding}){
$user{$a}{vitality}-=$user{$a}{health}{"$b"}{bleeding}
}
if ($user{$a}{health}{$b}{intbleeding}){
$user{$a}{vitality}-=$user{$a}{health}{$b}{intbleeding}
}
}
if ($user{$a}{vitality}<=0 and (!$user{$a}{dead})){
died($a);
}
}
}
sub longupdate {
foreach $node (@node){
#nodes handle monster spawning, ensuring a given area doesn't get flooded. and
#allows the same monster to be in several areas at once.
$a=rand(10);
if (${$node}{max}>${$node}{maxused}){
if ($a<${$node}{prob}){
${$node}{maxused}++;
my $d=int(rand(@{${$node}{monsters}}));
createmonster(${$node}{monsters}[$d],${$node}{room},$node);
}
}
}
foreach $a ($select->handles){
#inactivety check.
#only checking actual people, monsters can't be inactive after all.
unless (defined($user{$a})){
#don't ask me why but there is one in here thats not a person. so we skip it.
next;
}
unless (defined($user{$a}{name})){
next;
}
if (defined($last{$a}) and (time-$last{$a}>500)){
$outbuffer{$a}.="You have been inactive for too long.\r\n$prompt";
}
if (defined($last{$a}) and (time-$last{$a}>800)){
&delete($a);
next;
}
}
}
sub createmonster {
$mon=shift;
$room=shift;
$node=shift;
unless(defined($monster[$mon])){
return;
}
local $client="monster".$monstertotal++;
#load a player file to get the monster's information, body, items, etc.
unless (loadplayerold($monster[$mon]{name}, $client, "monsters")){
print "Error\r\n";
return;
}
#choose a random adjective for the monster from valid choices
my $z=int(rand(@{$monster[$mon]{adjectives}}));
#set som basic info for the monster.
$user{$client}{monster}=$mon;
$user{$client}{node}=$node;
$user{$client}{room}=$room;
$user{$client}{desc}=$monster[$mon]{desc};
$outbuffer{$client}.="Welcome to the world.\n";
$user{$client}{name}=$monster[$mon]{adjectives}[$z]." $monster[$mon]{name}";
$user{$client}{pre}=$monster[$mon]{pre};
$room[$user{$client}{room}]{in}{$client}=$user{$client}{name};
#announce to people in the room that a new monster has spawned.
if (defined($monster[$mon]{birthline})){
my $a=$monster[$mon]{birthline};
$a=~s/\[(.*?)\]/$user{$client}{$1}/isg;
say("$a");
}
else {
say("$user{$client}{name} suddenly spawns before your eyes.");
}
my $time=time;
#if theres a script to run at birth for this monster, run it.
$type{$client}="normal";
if (defined($monster[$mon]{scriptbirth})){
&{$monster[$mon]{scriptbirth}};
}
}
sub addexp {
#add exp to pool. exp will become skill slowly but surely.
my $skill=shift;
my $skilltype=shift;
my $amount=shift;
my $client=(shift or $client);
unless ($skilltype and $amount and $skill){
#we got invalid data can't add exp to what doesn't exist.
print "aaaah!!!\n";
return;
}
unless ($user{$client}){
print "error with adding exp, no user{client}\n\n";
return;
}
unless (defined($user{$client}{exp}{$skilltype})){
$user{$client}{exp}{$skilltype}={total=>0};
}
unless(defined($user{$client}{exp}{$skilltype}{$skill})){
#skill doesn't exist yet so we create it.
$user{$client}{exp}{$skilltype}{$skill}={pool=>0,ranks=>0,expcur=>0,expneeded=>100};
}
my $maxpool=$user{$client}{disc}*600;
if ($user{$client}{exp}{$skilltype}{$skill}{pool}>=$maxpool){
#is already locked, learning penalty impossed
$outbuffer{$client}.="Your head aches from absorbing $skill and you learn very little\r\n$prompt";
$user{$client}{exp}{$skilltype}{$skill}{pool}+=$amount/100;
return 0;
}
$user{$client}{exp}{$skilltype}{$skill}{pool}+=$amount;
if ($user{$client}{exp}{$skilltype}{$skill}{pool}>=$maxpool){
#just became locked, no penalty this time but a warning.
$outbuffer{$client}.="Your head begins to hurt from absorbing $skill and you learn very little\r\n$prompt";
}
}
sub died {
#user or monster has died.
my $dead=shift;
my $line=(shift or "$user{$dead}{name} falls dead");
my $desc=(shift or "the dead body of $user{$dead}{name} lies here");
say2("$line",$user{$dead}{room},"You fall to the ground dead",$dead);
$user{$dead}{dead}=time;
$user{$dead}{position}="lying";
$user{$dead}{roomdesc}="$desc";
#this limits commands the char can use until he's ressurected.
$type{$dead}="dead";
foreach $a (keys %{$user{$dead}{exp}}){
foreach $b (keys %{$user{$dead}{exp}{$a}}){
$user{$dead}{exp}{$a}{$b}{pool}=0;
}
}
}
sub say {
#sends message to everyone in room.
$message=shift;
unless ($message=~/\r\n\Q$prompt\E$/){
$message.="\r\n$prompt";
}
my $room=(shift or $user{$client}{room});
foreach $a (keys %{$room[$room]{in}}){
$outbuffer{$a}.="$message";
}
}
sub say2 {
#sends $message to everyone one in $room except $ignore, who gets $message2
my $message=shift;
my $room=shift;
my $message2=shift;
my $ignore=shift;
foreach $a (keys %{$room[$room]{in}}){
if ($a eq "$ignore"){
if ($message2){
#we might just be keeping $ignore out of the loop.
$outbuffer{$a}.="$message2\r\n$prompt";
}
}
else {
$outbuffer{$a}.="$message\r\n$prompt";
}
}
}
sub look{
#look around room, the command look is lookcommand.
#basic desc
if (defined($user{$client}{brief})){
$outbuffer{$client}.="$room[$user{$client}{room}]{shortdesc}\r\n";
}
else{
$outbuffer{$client}.="$room[$user{$client}{room}]{longdesc}\r\n";
}
local $b=0;
#players and monsters in room
foreach $a (keys %{$room[$user{$client}{room}]{in}}){
if (defined($user{$a}{hiding}) and $user{$a}{hiding} eq "yes"){
next;
}
unless ($room[$user{$client}{room}]{in}{$a} eq "$user{$client}{name}"){
unless($b==1){
$b=1;
if ($user{$a}{roomdesc}){
#if they have a special desc to be displayed.
$outbuffer{$client}.= "Also here is : $user{$a}{roomdesc}";
}
else {
#otherwise use their name
$outbuffer{$client}.= "Also here is : $user{$a}{pre}$room[$user{$client}{room}]{in}{$a}";
}
}
else {
if ($user{$a}{roomdesc}){
$outbuffer{$client}.=", $user{$a}{roomdesc}";
}
else {
$outbuffer{$client}.= ", $room[$user{$client}{room}]{in}{$a}";
}
}
}
}
if ($b){
$outbuffer{$client}.="\r\n";
}
local $b=0;
#now do items.
foreach $a (keys %{$room[$user{$client}{room}]{items}}){
unless (defined($item{$a})){
next;
}
if (defined($item{$a}{noshow})){
next;
}
unless($b==1){
$b=1;
if ($item{$a}{roomdesc}){
$outbuffer{$client}.= "Lying here is : $item{$a}{roomdesc}";
}
else {
$outbuffer{$client}.= "Lying here is : $item{$a}{name}";
}
}
else {
if ($item{$a}{roomdesc}){
$outbuffer{$client}.=", $item{$a}{roomdesc}";
}
else {
$outbuffer{$client}.= ", $item{$a}{name}";
}
}
}
if ($b){
$outbuffer{$client}.="\r\n";
}
#then we have exits.
$outbuffer{$client}.= "Obvious exits: $room[$user{$client}{room}]{exits}{obvious}";
$outbuffer{$client}.= "\r\n$prompt";
}
sub move {
#moves a persom to $dest from whereever they are. displays $message to the leaving room and $message2 to the entering room.
my $dest=shift;
my $message=shift;
my $message2=shift;
my $force=shift;
unless($client){
my $client=shift;
}
if(roundcheck() and !$force){
#can't move if stunned or RT
return;
}
if ($user{$client}{position} and $user{$client}{position} ne "stand" and !$force){
$outbuffer{$client}.="You'll have to stand to do that\r\n$prompt";
return;
}
#remove from first room, unhide if hiding, send messages while in niether room, then add to second room and look around.
removefromroom($client);
$user{$client}{hiding}=undef;
say("$message",$user{$client}{room});
say("$message2",$dest);
addtoroom($dest,$client);
look();
}
sub removefromroom {
#remove a person from the room he is currently in.
my $e=shift;
delete($room[$user{$e}{room}]{in}{$e});
}
sub addtoroom {
#add $person to $room.
my $room=shift;
my $person=shift;
$user{$person}{room}=$room;
$room[$room]{in}{$client}=$user{$client}{name};
}
sub additemtoroom {
my $room=shift;
my $item=shift;
$room[$room]{items}{$item}=$item{$item}{name};
}
sub removeitemfromroom {
my $room=shift;
my $item=shift;
delete $room[$room]{items}{$item};
return 1;
}
sub makeitem {
my $item=shift;
#make a new item from the template $item.
unless ($itemtemplate{$item}){
print "tried to create bad item $item\r\n";
return 0;
}
$itemtotal++;
$item{$itemtotal}=$itemtemplate{$item};
&savemuddata;
return $itemtotal;
}
sub delete {
#hang up on a user.
$a=shift;
save($a);
say("$user{$a}{name} has left the universe.",$user{$a}{room});
removefromroom($a);
delete $inbuffer{$a};
delete $outbuffer{$a};
delete $ready{$a};
delete $user{$a};
delete $last{$a};
delete $type{$a};
$select ->remove($a);
unless (close($a)){
print "error $!\n";
}
}
sub locateitemfloor {
my $room=shift;
my $item=shift;
my $skip=shift;
chomp ($item);
foreach $a (keys %{$room[$room]{items}}){
if ($item{$a}{name}=~/$item/i){
if ($skip){
$skip--;
}
else {
return $a;
}
}
}
return 0;
}
sub locateitem{
$room=shift;
$item=shift;
if ($a=locateitemfloor($room,$item)){
return $a;
}
return 0;
}
sub monsterdecay {
#monster has died, now must leave us once and for all.
$a=shift;
removefromroom($a);
#restore power to the node that is no longer mantaining the monster.
${$user{$a}{node}}{maxused}--;
delete $user{$a};
delete $outbuffer{$a};
delete $inbuffer{$a};
delete $ready{$a};
delete $type{$a};
if (defined($user{$a})){
print "nope, it's not going boom\n";
die;
}
}
sub playerdecay {
#this is actually player ressurection. will deal with Player deaths later.
$a=shift;
say2("$user{$a}{name} is magicaly reborn!", $user{$a}{room}, "The gods smile upon you and you are returned to life!", $a);
$type{$a}="normal";
$user{$a}{vitality}=$user{$a}{vitalitymax};
$user{$a}{roomdesc}="$user{$a}{name} is lying around";
removefromroom($client);
addtoroom(1, $client);
foreach $b (keys %{$user{$a}{health}}){
$user{$a}{health}{$b}{hp}=$user{$a}{health}{$b}{maxhp};
$user{$a}{health}{$b}{inthp}=$user{$a}{health}{$b}{maxinthp};
$user{$a}{health}{$b}{bleeding}=0;
$user{$a}{health}{$b}{intbleeding}=0;
$user{$a}{health}{$b}{scar}=0;
$user{$a}{health}{$b}{intscar}=0;
}
delete $user{$a}{dead};
}
sub descend {
#internal sub used for save.
my $str=shift;
my $key=shift;
if (ref($str) eq "HASH"){
#is a refrence need to descend
$string.="<$key>\n";
foreach $a (keys %{$str}){
descend(${$str}{$a},$a);
}
$string.="</$key>\n";
}
elsif (ref($str) eq "ARRAY"){
return;
}
else {
#is a plain value, save it.
$string.="<$key>$str</$key>\n";
}
}
sub save {
#save command to save a player
my $client=(shift or $client);
if (&saveplayer($client)){
$outbuffer{$client}.="You have been saved\r\n$prompt";
}
else {
$outbuffer{$client}.="You have NOT been saved, something went wrong\r\n";
}
}
sub saveplayer {
#does the actual saving of players
my $client=(shift or $client);
my $string;
$string=Dumper($user{$client});
unless (open (PLAYER, ">players/$user{$client}{name}")){
$outbuffer{$client}.=" $! ";
return 0;
}
print PLAYER $string;
close PLAYER;
foreach $a (%{$user{$client}{health}}){
foreach $b (%{$user{$client}{health}{$a}{wear}}) {
if ($user{$client}{health}{$a}{wear}{$b}){
#save items.
&saverealitem($user{$client}{health}{$a}{wear}{$b});
}
}
if ($user{$client}{health}{$a}{hold}){
&saverealitem($user{$client}{health}{$a}{hold});
}
}
return 1;
}
sub saveplayerold {
#obsolete. ignore
my $client=(shift or $client);
local $string;
foreach $a (keys %{$user{$client}}){
if ($a eq "eng"){
next;
}
descend($user{$client}{$a},$a);
}
unless (open (PLAYER, ">players/$user{$client}{name}")){
$outbuffer{$client}.="$!";
return 0;
}
print PLAYER $string;
close PLAYER;
foreach $a (%{$user{$client}{health}}){
foreach $b (%{$user{$client}{health}{$a}{wear}}) {
if ($user{$client}{health}{$a}{wear}{$b}){
#save items.
&saverealitem($user{$client}{health}{$a}{wear}{$b});
}
}
if ($user{$client}{health}{$a}{hold}){
&saverealitem($user{$client}{health}{$a}{hold});
}
}
return 1;
}
return 1;