package cf;

use Symbol;
use List::Util;

use strict;

our %COMMAND;
our @EVENT;
our %PROP_TYPE;
our %PROP_IDX;

BEGIN {
   @EVENT = map lc, @EVENT;

   *CORE::GLOBAL::warn = sub {
      my $msg = join "", @_;
      $msg .= "\n"
         unless $msg =~ /\n$/;

      print STDERR "cfperl: $msg";
      LOG llevError, "cfperl: $msg";
   };
}

# generate property mutators
sub prop_gen {
   my ($prefix, $class) = @_;

   no strict 'refs';

   for my $prop (keys %PROP_TYPE) {
      $prop =~ /^\Q$prefix\E_(.*$)/ or next;
      my $sub = lc $1;

      my $type = $PROP_TYPE{$prop};
      my $idx  = $PROP_IDX {$prop};

      *{"$class\::get_$sub"} = *{"$class\::$sub"} = sub {
         $_[0]->get_property ($type, $idx)
      };

      *{"$class\::set_$sub"} = sub {
         $_[0]->set_property ($type, $idx, $_[1]);
      };
   }
}

# auto-generate most of the API

prop_gen OBJECT_PROP => "cf::object";
# CFAPI_OBJECT_ANIMATION?
prop_gen PLAYER_PROP => "cf::object::player";

prop_gen MAP_PROP    => "cf::map";
prop_gen ARCH_PROP   => "cf::arch";

# guessed hierarchies

@cf::object::player::ISA = 'cf::object';
@cf::object::map::ISA    = 'cf::object';

my @exts;
my @hook;
my %command;

sub inject_event {
   my ($data) = @_;

   my $cb = $hook[$data->{event_code}]
      or return;

   $_->($data) for values %$cb;

   ()
}

sub inject_command {
   my ($name, $obj, $params) = @_;

   for my $cmd (@{ $command{$name} }) {
      $cmd->[1]->($obj, $params);
   }

   -1
}

sub register_command {
   my ($name, $time, $cb) = @_;

   my $caller = caller;

   push @{ $command{$name} }, [$time, $cb, $caller];
   $COMMAND{"$name\000"} = List::Util::max map $_->[0], @{ $command{$name} };
}

sub load_extension {
   my ($path) = @_;

   $path =~ /([^\/\\]+)\.ext$/ or die "$path";
   my $pkg = $1;
   $pkg =~ s/[^[:word:]]/_/g;
   $pkg = "cf::ext::$pkg";

   warn "loading '$path' into '$pkg'\n";

   open my $fh, "<:utf8", $path
      or die "$path: $!";

   my $source =
      "package $pkg; use strict; use utf8;\n"
      . "#line 1 \"$path\"\n{\n"
      . (do { local $/; <$fh> })
      . "\n};\n1";

   eval $source
      or die "$path: $@";

   push @exts, $pkg;

   no strict 'refs';

#   @{"$pkg\::ISA"} = cf::ext::;

   for my $idx (0 .. $#EVENT) {
      if (my $ref = $pkg->can ("on_$EVENT[$idx]")) {
         warn "registering $EVENT[$idx] hook\n";
         $hook[$idx]{$pkg} = $ref;
      }
   }
}

sub unload_extension {
   my ($pkg) = @_;

   warn "removing extension $pkg\n";

   # remove hooks
   for my $idx (0 .. $#EVENT) {
      delete $hook[$idx]{$pkg};
   }

   # remove commands
   for my $name (keys %command) {
      my @cb = grep $_->[2] ne $pkg, @{ $command{$name} };

      if (@cb) {
         $command{$name} = \@cb;
         $COMMAND{"$name\000"} = List::Util::max map $_->[0], @cb;
      } else {
         delete $command{$name};
         delete $COMMAND{"$name\000"};
      }
   }

   Symbol::delete_package $pkg;
}

sub load_extensions {
   my $LIBDIR = maps_directory "perl";

   for my $ext (<$LIBDIR/*.ext>) {
      load_extension $ext;
   }
}

register_command "perl-reload", 0, sub {
   my ($who, $arg) = @_;

   if ($who->flag (FLAG_WIZ)) {
      warn "reloading...\n";
      unload_extension $_ for @exts;
      @exts = 0;
      load_extensions;
      warn "reloaded\n";
   }
};

load_extensions;

1