package MGlobals;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
  PLAYER_PROTO
  ROOM_PROTO
  DEF_LOADROOM

  LVL_IMMORTAL

  @ROOMFLAGS
  %ROOMFLAGS

  @EXITFLAGS
  %EXITFLAGS

  @OBJECTFLAGS
  %OBJECTFLAGS

  @TERRAINS
  %TERRAINS
  @TERRAIN_MOVE

  @POSITIONS
  @POS_MOVES
  POS_DEAD
  POS_MWOUND
  POS_INCAP
  POS_STUN
  POS_SLEEP
  POS_REST
  POS_SIT
  POS_FIGHT
  POS_STAND
  POS_FLOAT

  @HEALTHS

  %EXIT_OPP
  %EXIT_ENTER
  %EXIT_LEAVE
  %EXIT_SORT

  @GENDER_NOM
  @GENDER_OBJ
  @GENDER_POSS

  @TRIG_TYPES
  %TRIG_TYPES

  parse_flags
  sprint_flags
  syslog
  split_file_ref
  dice

);

### Flag tables and tests ##########################################################################################

@ROOMFLAGS = qw(
  DARK
  DEATH
  !NPC
  INDOORS
  PEACEFUL
  SOUNDPROOF
  !TRACK
  !MAGIC
  TUNNEL
  GODROOM  
); { my $i = 0; %ROOMFLAGS = map {$_, $i++} @ROOMFLAGS; }

@EXITFLAGS = qw(
  DOOR
  CLOSEABLE
  PICKPROOF
  MINOR
  CLOSED
  LOCKED
); { my $i = 0; %EXITFLAGS = map {$_, $i++} @EXITFLAGS; }
# MINOR means that, if closed, the door will not show up in look/exits.

@OBJECTFLAGS = qw(
  ALIVE
  WATERTIGHT
  CLOSEABLE
  PICKPROOF
  CLOSED
  LOCKED
  CONT_VIS
); { my $i = 0; %OBJECTFLAGS = map {$_, $i++} @OBJECTFLAGS; }
# ALIVE means "regenerates hp, fights back, etc" not visual appearance.
# WATERTIGHT means it can contain liquids.
# CONT_VIS means contents are obviously visible
#   (and that contained objects can see outside the container).

sub _makeflags {
  my ($letter, $flags) = @_;

  my $i = 0;
  foreach (@$flags) {
    (my $fln = "${letter}F_$_") =~ s/!/NO/;
    push @EXPORT, $fln;
    my $bit = 1 << $i;
    eval "sub $fln (;\$) {\$_[0] ? \$_[0] & $bit : $bit}";
    die $@ if $@;
    $i++;
  }
}

_makeflags('O', \@OBJECTFLAGS);
_makeflags('E', \@EXITFLAGS);
_makeflags('R', \@ROOMFLAGS);

# print map " ¥ $_\n", @EXPORT;

### Misc constants ##########################################################################################

use constant PLAYER_PROTO => '/core/pcproto';
use constant ROOM_PROTO => '/core/roomproto';
use constant DEF_LOADROOM => '/test/center';

use constant LVL_IMMORTAL => 31;


@TERRAINS = qw(
  indoors
  city
  field
  forest
  hills
  mountains
  water_swim
  water_noswim
  underwater
  midair
); { my $i = 0; %TERRAINS = map {$_, $i++} @TERRAINS; }

@TERRAIN_MOVE = qw(
  .8
  1
  1.2
  1.6
  2.5
  5
  1.5
  1.3
  2
  .5
);

@POSITIONS = (
  "is lying here, dead.", # 0
  "is lying here, mortally wounded.",
  "is lying here, incapacitated.",
  "is lying here, stunned.",
  "is sleeping here.",    # 4
  "is resting here.",
  "is sitting here.",
  "is here, fighting.",   # 7
  "is standing here.",    # 8
  "is floating here.",    # 9
);

sub POS_DEAD   () {0}
sub POS_MWOUND () {1}
sub POS_INCAP  () {2}
sub POS_STUN   () {3}

sub POS_SLEEP  () {4}
sub POS_REST   () {5}
sub POS_SIT    () {6}
sub POS_FIGHT  () {7}
sub POS_STAND  () {8}
sub POS_FLOAT  () {9}

@HEALTHS = (
  "is bleeding awfully from big wounds.",
  "is in awful condition.",
  "looks pretty hurt.",
  "has some big nasty wounds and scratches.",
  "has quite a few wounds.",
  "has some small wounds and bruises.",
  "has a few scratches.",
  "is in excellent condition.",
);


%EXIT_OPP = qw(
  north south
  west east
  up down
  northwest southeast
  southwest northeast
);
@EXIT_OPP{values %EXIT_OPP} = keys %EXIT_OPP;

%EXIT_ENTER = (
  up => ' has arrived from above.',
  down => ' has arrived from below.',
  '' => ' has arrived.',
);

%EXIT_LEAVE = (
);

%EXIT_SORT = qw(
  north 1
  northeast 2
  east 3
  southeast 4
  south 5
  southwest 6
  west 7
  northwest 8
  up 9
  down 10
);

@GENDER_NOM  = qw(it  he  she);
@GENDER_OBJ  = qw(it  him her);
@GENDER_POSS = qw(its his her);


@TRIG_TYPES = grep !/^#/, qw(
  Global
  Random
  Command
  Load
  Destruction
  ZoneReset

  Speech
  Greet
  Entry
  Fight

  Get
  Drop
  Put
  Enter
  
  
); 
{ my $i = 0; %TRIG_TYPES = map {$_, $i++} @TRIG_TYPES; }

### Utility functions ##########################################################################################

sub parse_flags {
  my ($str, $flagset) = @_;

  return 0 unless $str;
  my $bits = 0;
  foreach (split /\s+/, $str) {
    next if $str eq '-';
    defined $flagset->{$_} or syslog("unknown flag $_") and next;
    $bits |= 1 << $flagset->{$_};
  }
  $bits;
}

sub sprint_flags {
  my ($bitsx, $flagset) = @_;

  my $bits = $bitsx + 0;
  my $str = '';
  for (my $i = 0; $i < @$flagset; $i++) {
    next unless $bits & (1 << $i);
    $str .= ' ' . $flagset->[$i];
  }
  $str || ' -';
}

{
  use IO::File;
  my $log_main =   IO::File->new(":logs:syslog",       '>') or die $!;
  my $log_report = IO::File->new(":logs:user_reports", '>>') or die $!;
  my $log_edit =   IO::File->new(":logs:edits",        '>>') or die $!;
  my $log_error =  IO::File->new(":logs:errors",       '>>') or die $!;

  sub syslog ($) {
    my ($str) = @_;
  
    foreach (values %MConnection::Connections) {
      my $obj = $_->object;
      next if !$obj or $obj->level < 31;
      $obj->send("&fg[[ $str ]]&n");
    }
    local $_ = scalar(localtime) . ": $str\n";
    print STDOUT      $_;
    print $log_main   $_;
    print $log_report $_ if $str =~ /^(BUG|IDEA|TYPO):/;
    print $log_edit   $_ if $str =~ /^EDIT/;
    print $log_error  $_ if $str =~ /^ERROR/;
  }
  syslog "--- Log starts ---";
}

use File::Spec;
use Cwd;

sub split_file_ref {
  my ($str, $ptype) = @_;

  my ($type, $path) = $str =~ /^(?:(\w+):)?([\w\/]+)$/;
  $type ||= $ptype || '';
  $path =~ s#/+$##;
  $path =~ s#/{2,}#/#g;
  my ($file) = $path =~ m#([^/]+)$#;
  my $filepath;
  if ($type) {
    my @dirs = split(m|/|, $path);
    shift @dirs unless $dirs[0];
    ($filepath) = File::Spec->catfile(cwd(), 'world', @dirs, "$file.$type") =~ /^(.*)$/;
  }
  return (lc $type, lc $path, lc $filepath);
}

sub dice ($$) {
  my ($num, $sides) = @_;
  
  my $tot;
  while ($num--) {
    $tot += int(rand($sides)) + 1;
  }
  $tot;
}    

1;
