# The mailing list, which we spoof
$mailing_list = 'rw-pbem@mellers1.psych.berkeley.edu';

%npcs = ('freud', 'alan', 'moz', 'pala', 'toyoda', 'gregory');

# List of players and their languages:
%players = ('alan', 'all',
	'shaka', 'zulu bantu swahili english',
	'charles', 'german latin greek',
	'josephine', 'english french',
	'jeanne', 'french',
	'louis', 'french english',
	'benjamin', 'french english spanish italian latin',
	'shaw','english french latin greek arabic',
	'ehrich', 'english french german russian',
	'robbie', 'english french latin gaelic',
	'jean', 'french spanish italian greek turkish arabic',
	'sly', 'english'
);


# Players and email addresses
%emails = ('alan', 'alan',
	'shaka', 'shaka',
	'charles', 'charles',
	'josephine', 'josephine',
	'jeanne', 'jeanne',
	'louis', 'louis',
	'benjamin', 'benjamin',
	'shaw', 'shaw',
	'ehrich', 'ehrich',
	'robbie', 'robbie',
	'jean', 'jean',
	'sly', 'sly',
);

%aliases = (
#	'nightingale','florence',
	'charlemagne', 'charles',
#	'gould', 'glenn',
#	'cleo', 'cleopatra',
	'josie', 'josephine',
	'jo', 'josephine',
#	'patton', 'george',
#	'shelley', 'maria',
#	'mary', 'maria',
	'ross', 'shaw',
	'lawrence', 'shaw',
#	'tjar', 't.r.',
	'ben', 'benjamin',
	'houdini', 'ehrich',
	'eric', 'ehrich',
	'sid', 'sly',
	'test', 'test',
);

%groups = (
	'land', 'louis,alan,benjamin,josephine,shaw',
	'shaka', 'alan',
	'river', 'shaka,sly,jeanne,charles,ehrich,alan,jean,robbie',
#	'duo', 'jean,robbie,alan',
);

@players = keys %emails;

foreach (@players) {
  $names{$_}++;
}

# Can $who understand writing for/in $what?
sub speaks {
  local($who,$what) = @_;
  local(@testlangs,$tlang);
  # Speaker always hears themself
  return 1 if ($speaker && $speaker =~ /$who/i);
  # Downcase things.
  $who =~ tr/A-Z/a-z/;
  $what =~ tr/A-Z/a-z/;
  $what = &expandlang($what);
  # Handle messages to a specific player
  if ($what =~ /$who(,|\>|$)/i) {
    return ($what =~ /!/) ? 0 : 1;
  }
  # Handle languages
  return 1 if ($players{$who} eq "all");
  return 1 if ($what =~ /all/i);
  @testlangs = split(/\s+/,$players{$who}); 
  if ($what =~ /!/) {
   # Return 1 if player can't speak that language
   foreach $tlang (@testlangs) {
     return 0 if ($what =~ /$tlang/i);
   }
   return 1;
  } else {
   foreach $tlang (@testlangs) {
     return 1 if ($what =~ /$tlang/i);
   }
   return 0;
  }
} 

sub expandlang {
  local($what) = $_[0];
  # $what might be an alias for a group, in which case it's surrounded
  # by <>'s, like <ashore>. Expand alias here.
  $what =~ tr/A-Z/a-z/;
  1 while $what =~ s/\<(.*?)\>/$groups{$1}/;
  return $what;
}

sub getlang {
# Return the primary language for a speaker
  local($langs) = $players{$_[0]};
  local(@langs) = split(/\s+/,$lang);
  return $lang[0];
}

sub reallang {
# Return 1 if this is a single language, 0 if it's something else
  local($l) = $_[0];
  return 0 if $l =~ /[,!<]/;
  return 0 if $l =~ /all/i;
  return 1;
}


#
# turnify: Given a player name, whether or not we're producing html,
#          and Turn source (in an array),
#          return (in an array) the customized Turn for that player
#
sub turnify {
    my $player = shift;
    my $html = shift;
    my @turn = @_;
    my $lang = 'all';
    my @out = ();
    my $inbracket;
  INPUTLINE:
    for (@turn) {
	s#\*(\w+)\*#<B>$1</B>#g if $html;
	s#/(\w+)/#<I>$1</I>#g if $html;
	if (/^\<(.*)\>/) {
	    $lang = $1;
	    next INPUTLINE;
	}
	$inbracket = 1 if (/^\[/);
	if ($inbracket) {
	    $inbracket = 0 if (/\]$/);
	    next INPUTLINE if $html;
	    push(@out,$_);
	} else {
	    push(@out,$_) if (&speaks($player,$lang));
	}
    }
  return @out;
}


1;