#!/usr/bin/perl -X
#the Northlands a perl based mud. Please enjoy and share this great software with
#anyone who wants it.
#Copyright (C) 2000 Peter Smith creator@operamail.com
#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#GNU General Public License for more details.
#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
$|=1;
#use a whole bloody bunch of modules and pull in the other files.
use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;
use Term::ANSIColor;
use Data::Dumper;
use Time::HiRes ("usleep");
require ("commands.pm");
require ("init.pm");
require("update.pm");
require("roomcommands.pm");
require("monster.pm");
require("combat.pm");
require("ooc.pm");
#use strict;
#I gave up on keeping strict happy, the mud works. If someone wants to make it
#strict compliant go ahead
use vars qw(@node @elements $monstertotal $room $longupdate %inbuffer %outbuffer %ready $prompt %type @room %item %command $maxpool);
$SIG{HUP}="ignore";
srand;
#$last=time;
#set port and open the socket. port comes from command line or defaults to 4005
$port=($ARGV[0] or 4005);
$server=IO::Socket::INET->new(LocalPort =>$port, Listen=> 10, Reuse=>1) or die "Can't make server socket: $@\n";
$prompt=color("blue").": ".color("reset")." ";
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
#this should be in a config file somewhere... controls monster spawning.
#monsters is an array of monster #s and room is the room to spawn into
$node[0]={monsters=>[0],prob=>10,room=>1,max=>10,maxused=>0};
nonblock($server);
$select= IO::Select->new($server);
@elements=("Earth", "Air", "Water", "Fire", "Life");
$longupdate=0;
$lastupdate=time;
$monstertotal=0;
#various init stuff here, load map, items, monsters, etc
loadattacks();
loaddesc();
loaditems();
loadmuddata();
loadrealitems();
loadmonster();
loadroom();
loadcommands();
while (1){
#main loop
my $client;
my $rv;
my $data;
if (-e "killmud"){
#close down time, should do a save of all players first.
#but we aren't yet
&shutdown;
print "Closing down\n";
exit;
}
#check for new information
foreach $client ($select->can_read(0)) {
$last{$client}=time;
if ($client == $server) {
#new connection
$client= $server->accept();
$select->add($client);
nonblock($client);
$outbuffer{$client}.="Welcome to the Northlands\r\n";
$outbuffer{$client}.="Please tell me who you are:";
$type{$client}="login";
}else {
#get data
$data='';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);
unless (defined($rv) && length $data) {
#hang up
&delete($client);
next;
}
$inbuffer{$client}.=$data;
while($inbuffer{$client} =~s/(.*\n)//) {
push( @{$ready{$client}}, $1);}
}
}
foreach $client ( keys %ready) {
#full line of text has come from someone. run handle on it.
handle($client);
}
foreach $client ($select->can_write(1)) {
next unless exists $outbuffer{$client};
#crazy word wrapping stuff here. meddle at your own risk
my @b;
while ($outbuffer{$client}=~s/(.*?\r\n)//s){
push (@b, $1);
}
#split into lines
push(@b,$outbuffer{$client});
my $line;
foreach $a (@b){
my $length=0;
my @c;
#split into words
while ($a=~s/(.*?\s)//s){
push (@c, $1);
}
push (@c, $a);
my $maxlength=($user{$client}{screenwidth} or 75);
foreach $d (@c){
if ($length+length($d)>$maxlength) {
if (length($d)>$maxlength) {
$line.= "$d"."\r\n";
$length=0;
}
else {
$line.="\r\n"."$d";
$length=length $d;
}
}
else {
$length+=length($d);
$line.="$d";
}
}
}
unless ($line=~/\r\n\Q$prompt\E$/s){
$line.="\r\n$prompt";
}
$outbuffer{$client}=$line;
$rv=$client->send($outbuffer{$client}, 0);
unless (defined($rv)){
warn "I was told I could write but I can't";
next;}
if (($rv == length $outbuffer{$client}) || ($!== POSIX::EWOULDBLOCK)){
substr($outbuffer{$client}, 0,$rv)="";
delete $outbuffer{$client} unless length $outbuffer{$client};
}
else{
warn "hello. $! $outbuffer{$client} \r\n$rv\r\n";
&delete($client);
next;}
}
if (time-$lastupdate>1){
update();
$lastupdate++;
}
else{
#very short sleep. to keep from putting CPU to 100%
usleep(0.0001);}
}
sub handle {
local $client= shift;
main: foreach $request (@{$ready{$client}}) {
#handle incoming data from user $client.
#start with some simple clean up
$request=~s/[\a|\r|\n]//g;
$request=~s/\s*$//i;
#$request=lc($request);
if ($request eq "."){
$request=$lastrequest{$client};
}
if ($request){
$lastrequest{$client}="$request";
}
$request=~s/^'/say /i;
#'
local @input=split(/ /,$request);
$input[0]=lc($input[0]);
if ($request){
#check for room commands first, since they can over rule others
if ($user{$client}{room}){
if (defined($room[$user{$client}{room}]{commands}{$input[0]})){
unless (defined(&{$commandtype{$type{$client}}{$input[0]}})){
$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
warn("$commandtype{$type{$client}}{$input[0]} doesn't exist");
next;
}
&{$commandtype{$type{$client}}{$input[0]}};
next;
}
}
#if it's an input type, that is just grabbing what the user types then we go here.
if (defined($commandtype{$type{$client}}{input})){
unless (defined(&{$commandtype{$type{$client}}{input}})){
$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
next;
}
&{$commandtype{$type{$client}}{input}};
next;
}
#check current command set for valid commands
if (defined($commands{$type{$client}}{$input[0]})){
unless (defined(&{$commands{$type{$client}}{$input[0]}})){
$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
next;
}
&{$commands{$type{$client}}{$input[0]}};
}
#check basic command set for valid commands
elsif ($user{$client}{god} and defined($commands{builder}{$input[0]})){
unless (defined(&{$commands{builder}{$input[0]}})){
$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
next;
}
&{$commands{builder}{$input[0]}};
}
elsif(defined($commands{basic}{$input[0]})){
unless (defined(&{$commands{basic}{$input[0]}})){
$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
next;
}
&{$commands{basic}{$input[0]}};
}
else {
#invalid command
$outbuffer{$client}.="$commandtype{$type{$client}}{failed}\r\n$prompt";
}
}
else{
#user just hit enter
$outbuffer{$client}.="\r\n$prompt";
}
}
delete $ready{$client};
}
sub nonblock {
my $socket= shift;
my $flags;
$flags= fcntl($socket, F_GETFL, 0) or die "can't get flags for socket $!\n";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "can't make socket nonblocking";
}
sub roundcheck {
if ($user{$client}{stun}){
$outbuffer{$client}.="You are stunned.\r\n$prompt";
return 1;
}
if ($user{$client}{round}){
$outbuffer{$client}.="Please wait $user{$client}{round} more seconds.\r\n$prompt";
return 1;
}
}
sub shutdown {
foreach $a (keys %user){
if ($user{$a}{monster}){
next;
}
saveplayer($a);
removefromroom($a);
}
&save_room;
}