package MScheduler;
use strict;

use MCoreTools;
use Carp;

use vars qw(
  @Tasks $CurTask
  $iter $lastick
  $Running
  $Pre_Run
  $Performance
);

use constant MONITOR => 1;

use constant TIME_SCALE => 12; # number of mud-seconds per real-second.
use constant TIME_OFFSET => 5000000000; # FIXME: ought to be time after DB erase
use constant TIME_MAC_DIFF => 2082844801; # Mac OS measures from 1904, not 1970; this is the difference in seconds

BEGIN { eval($^O eq 'MacOS' ? <<'ET_MAC' : <<'ET_OTHER'); die $@ if $@; }
use Mac::Events ();
use constant MACEVENTS => 1;
use vars qw($TimeBase $MonWin);
                        
$TimeBase ||= time() + TIME_MAC_DIFF - TIME_OFFSET - Mac::Events::TickCount();
sub mudclock {
  return ($TimeBase + Mac::Events::TickCount()/60) * TIME_SCALE;
}

if (MONITOR) {
  $MonWin and $MonWin->dispose;
  use Mac::Windows;
  use Mac::QuickDraw;
  $MonWin = MacWindow->new(
    Rect->new(20, 40, 250, 70),
    "Monitor", 1, noGrowDocProc, 1
  );
  $MonWin->sethook(drawgrowicon => sub {1});
}

sub mon_set {
  return unless MONITOR and $MonWin and $MonWin->window;
  my ($str) = @_;
  SetPort(my $w = $MonWin->window);
  EraseRect($w->portRect);
  MoveTo(1, 20);
  DrawString($str);
}

END {$MonWin->dispose if $MonWin}
ET_MAC
use constant MACEVENTS => 0;
sub mudclock {
  return (time() - TIME_OFFSET) * TIME_SCALE; # FIXME: really ought to use Time::HiRes
}
sub mon_set {}
ET_OTHER

BEGIN {
  return if $Running;
  $iter = $lastick = 0;
  $Pre_Run = 1;
}

################################

sub run {
  $Running = 1;
  $Pre_Run = 0;
  mudlog "Startup complete.";
  
  eval {
    while (!$::Quit) {
      $iter++;
      mon_set('');
      Mac::Events::WaitNextEvent(1) if MACEVENTS;

      my $runs_in = $Tasks[0]{'time'} - mudclock();
      if ($runs_in <= 0) {
        mon_set("Executing $Tasks[0]{'name'}");
        local $CurTask = shift @Tasks;
        _run_hook($CurTask, 'hook');
      }
      mon_set('Polling');
      MConnection->poll(min($runs_in/TIME_SCALE, (MACEVENTS ? 1/60 : 1/20)));

      if ($iter > 1000) {
        $Performance = $lastick == time() ? -1 : ($iter / (time() - $lastick));
        $iter = 0;
        $lastick = time();
      }
    }
  };
  if ($@) {
    mudlog "ERROR/CORE: death in main loop: $@";
  }
  mudlog "Exiting main loop.";

  $Running = 0;
  for (my $i = 0; $i < @Tasks; $i++) {
    _run_hook($Tasks[$i], 'abort');
  }
}


sub running {$Running}

sub add_task {
  my ($class, %params) = @_;
  
  $Running or $Pre_Run or croak "MScheduler: can't add event after scheduler shutdown";
  my $task = {
    owner => $params{owner} ? (ref $params{owner} ? $params{owner}->id : $params{owner}) : undef,
    hook => $params{hook},
    'time' => ($params{'time'} || 0) + mudclock(),
    name => $params{name},
    abort => $params{abort},
  };
  MScheduler->_insert_task($task);
}

sub remove_task {
  my ($class, $name) = @_;
  for (my $i = 0; $i < @Tasks; $i++) {
    next if $Tasks[$i]{name} ne $name;
    _run_hook($Tasks[$i], 'abort');
    splice @Tasks, $i, 1;
    last;
  }
}  

sub remove_owned {
  my ($class, $owner, %opts) = @_;
  $owner = $owner->id if ref $owner;
  for (my $i = 0; $i < @Tasks; $i++) {
    next unless $Tasks[$i]{owner} and $Tasks[$i]{owner} == $owner 
      and (!$opts{match} or $opts{match}->($Tasks[$i]{name}));
    _run_hook($Tasks[$i], 'abort');
    splice @Tasks, $i--, 1; # $i decremented to match array shifting
  }
}

sub task_owner {
  my ($class, $name) = @_;
  for (my $i = 0; $i < @Tasks; $i++) {
    next if $Tasks[$i]{name} ne $name;
    return $Tasks[$i]{owner};
  }
  return;
}

sub reset_me {
  my ($class, $newtime) = @_;
  $CurTask or confess "MScheduler::reset_me called outside of task hook";
  $CurTask->{'time'} += $newtime;
  MScheduler->_insert_task($CurTask);
}

sub reset_me_from_now {
  my ($class, $newtime) = @_;
  $CurTask or confess "MScheduler::reset_me_from_now called outside of task hook";
  $CurTask->{'time'} = mudclock() + $newtime;
  MScheduler->_insert_task($CurTask);
}

sub _run_hook {
  my ($tstruct, $key) = @_;
  $tstruct->{$key} or return 0;
  eval {$tstruct->{$key}->( owner => $tstruct->{owner} )};
  if ($@) {
    (my $lt = $@) =~ s#\n# / #g;
    mudlog qq~ERROR/SCHEDULER: death while running $key of task $tstruct->{name}: $lt~;
  }
  1;
}

sub _insert_task {
  my ($class, $task) = @_;

  my $insert_pos = &{sub{
    return 0 unless @Tasks;
    return 0 if $task->{'time'} <= $Tasks[0]{'time'};
    return $#Tasks + 1 if $Tasks[-1]{'time'} <= $task->{'time'};
    my ($lower, $upper) = (0, $#Tasks);
    while ($lower < $upper) {
      return $upper if $upper == $lower + 1;
      my $middle = int(($upper - $lower) / 2 + $lower);
      # print "upper: $upper middle: $middle lower: $lower\n";
      if ($task->{'time'} > $Tasks[$middle]{'time'}) {
        $lower = $middle;
      } elsif ($task->{'time'} < $Tasks[$middle]{'time'}) {
        $upper = $middle;
      } else {
        return $middle + 1;
      }
    }
    die "dainbramage: binary search on scheduler list failed";
  }};
  splice @Tasks, $insert_pos, 0, $task;
}

sub report {
  my ($class) = @_;
  my @rep;

  push @rep, 'Now: ' . format_time(mudclock()) . ", Time scale: " . TIME_SCALE . ":1";
  push @rep, sprintf("%-55s %15s %-6s", qw(Name Runs-In Owner));

  push @rep, '-' x 55 . ' ' . '-' x 15 . ' ' . '-' x 6;
  
  foreach (@Tasks) {
    my $runs_in = $_->{'time'} - mudclock();
    push @rep, sprintf("%-55s %15s %-6s", $_->{name}, ($runs_in <= 0 ? 'Now' : format_time($runs_in)), $_->{owner} || 'n/a');
  }
  return @rep;
}

sub performance {$Performance}

1;
