package MScheduler;
use strict;

# There are a few ugly bits in this code. This is mainly because I'm interested
# in speed, not cleanliness. --KPR

use MCoreTools;

use vars qw(
  @ISA
  @Events
  %Events
  %EventsOwned
  $Running
  $Pre_Run
);

use MInitializable;
@ISA = qw(MInitializable);

use constant MONITOR => 1;

use constant TIME_OFFSET => IS_MACOS ? 2082844801 : 0; # Mac OS measures from 1904, not 1970; this is the difference in seconds

sub realclock {
  # ought to use Time::HiRes here
  # note that this is not guaranteed to be a value suitable for passing to localtime(),
  # but see below.
  return time() + TIME_OFFSET;
}

sub clock_localtime {
  localtime($_[1] - TIME_OFFSET);
}

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

sub _initialize {
  $Pre_Run = 1;
}

sub run {
  _load_events();
  $Running = 1;
  $Pre_Run = 0;
  mudlog "Startup complete.";
  
  eval {
    while (!$::Quit) {
      MIOManager->block(
        @Events ? do {my $t = $Events[0]{time} - realclock(); $t < 0 ? 0 : $t}
                : undef
      );
        
      # NOTE: processing I/O may have added an event, so we can't
      # cache $Events[0]{time}.

      if (@Events and ($Events[0]{time} - realclock()) <= 0) {
        _run_top_event();
        mon_clean();
      }
    }
  };
  mudlog ($@ ? "ERROR/CORE: exception in main loop: $@"
             : "Exiting main loop.");
  $Running = 0;
}


sub running {$Running}

sub add_event {
  my ($class, $evob) = @_;
  
  $evob or cluck("No object passed to MScheduler->add_event"), return;

  $Running or $Pre_Run or cluck("MScheduler: can't add event after scheduler shutdown"), return;

  my $evrec = {
    owner => _owner_id($evob->owner),
    event => $evob,
    'time' => $evob->time,
    name => $evob->name,
  };
  _insert_event($evrec);
  1;
}

sub add_events {my $self = shift; for (@_) { $self->add_event($_) } }

sub remove_event {
  my ($class, $event) = @_;
  
  my $evrec = $Events{$event} or return;
  delete $Events{$event};
  delete $EventsOwned{$evrec->{owner}}{$event} if $evrec->{owner};
  
  %$evrec = (dead => 1, time => $evrec->{time});
}

sub remove_owned {
  my ($class, $owner) = @_;
  my $oid = _owner_id($owner);
  
  foreach (keys %{$EventsOwned{$oid}}) {
    $class->remove_event($_);
  }
  delete $EventsOwned{$oid};
}

sub sync {
  return unless $Running;
  my $evdata = MFreezer::freeze([map {my$e=$_->{'event'}; !$e || $e->no_store ? () : $e} @Events]);
  my $fh = IO::File->new(rfile("$::Config{db_path}/events"), '>', DATA_PERMS)
    or do {warn "Couldn't write events to disk: $!"; $::Quit = 'fatal error'; return};
  binmode $fh; # why not $fh->binmode?
  $fh->print($evdata);
  $fh->close;
}

sub _run_top_event {
  my $evrec = $Events[0];
  my $event = $evrec->{'event'};
  
  # remove event from queue and lookup hashes
  shift @Events;
  return if $evrec->{dead};
  delete $Events{$event};
  delete $EventsOwned{$evrec->{owner}}{$event} if $evrec->{owner};
  
  # run event
  mon_push("Event: ".$event->name);

  #{
    my $trans = MTransaction->open();

    eval {$event->run()};
    
    if ($@) {
      my $at = $@;
      $trans->close;
      mudlog "ERROR/SCHEDULER: death while executing event $evrec->{name} (".$event->description."): $at";
    } else {
      $trans->commit;
      # if threads are used, here we need code to retry the event later if it fails
      $trans->close;
    }
  #}

  mon_pop();
}

sub _owner_id {
  my $owner = $_[0];
  !defined $owner ? undef :
  ($owner->isa('MObject') || $owner->isa('MObjectRef')) ? "#".$owner->id
  : $owner->isa('MConnection') ? "CON:".$owner->id : "$owner";
}

sub _load_events {
  mudlog "Loading events...";
  my $p = "$::Config{db_path}/events";
  $@ = '';
  if (-e rfile($p)) {
    my $data = eval {MFreezer::thaw_from_file($p)} or die "Could not load events file:\n$@";
    __PACKAGE__->add_events(@$data);
  } else {
    mudlog "ERROR/SCHEDULER: Warning: No events file found.";
  }
}

sub _insert_event {
  my ($evrec) = @_;

  my $event = $evrec->{event};
  $Events{$event} = $evrec;
  $EventsOwned{_owner_id($event->owner)}{$event} = $evrec if $event->owner;
  
  my $etime = $evrec->{'time'};
  
  # find the place to insert the event in the queue
  my $insert_pos = &{sub{
    return 0 if     !@Events or $etime <= $Events[ 0]{'time'}; # case of goes into head of queue or empty queue
    return scalar @Events if    $etime >= $Events[-1]{'time'}; # case of goes into tail of queue
    
    # none of the simple cases worked out, do a binary search
    
    # establish the initial range
    my ($lower, $upper) = (0, $#Events);
    
    # this should always be true
    while ($lower < $upper) {
      # if the range has two elements, the new item goes between them
      return $upper if $upper == $lower + 1;
      
      # compute midpoint of range
      my $middle = int(($upper - $lower) / 2 + $lower);
      
      # then check which side of range we should search
      my $midtime = $Events[$middle]{'time'};
      if ($etime > $midtime) {
        $lower = $middle;
      } elsif ($etime < $midtime) {
        $upper = $middle;
      } else {
        # equal to the middle, we can insert it right after there
        return $middle + 1;
      }
    }
    mudlog "ERROR/CORE: dainbramage: scheduler queue not sorted";
    $::Quit = 'internal scheduler error';
    return 0;
  }};
  splice @Events, $insert_pos, 0, $evrec;
}

sub report {
  my $clock = realclock();
  return map {
    my $evrec = $_;
    +{
      name => ($evrec->{'name'} || ($evrec->{'event'} ? scalar $evrec->{'event'}->description : '<unknown>')),
      runs_in => $evrec->{'time'} - $clock,
      map(($_, $evrec->{$_}), qw(time dead owner))
    };
  } @Events;
}

BEGIN { eval(IS_MACOS ? <<'ET_MAC' : <<'ET_OTHER'); die $@ if $@; }
### Mac OS monitor handling ###############################################

# This stuff ought to be in some other file.

use Mac::Events ();

use vars qw($MonWin $MonPort $MonCount $MonWid);

use Mac::Windows;
use Mac::QuickDraw;

use constant WINV => 16;

if (MONITOR) {
  local ($DB::single, $DB::trace) = (0, 0);
  $MonWid ||= 210;
  $MonCount ||= 0;
  $MonWin and $MonWin->dispose;
  $MonWin = MacColorWindow->new(
    Rect->new(20, 40, 230, 40+WINV),
    "mpMUD", 1, floatGrowProc, 1
  );
  $MonWin->sethook(drawgrowicon => sub {1});
  $MonWin->sethook(goaway => sub {my($my,$pt) = @_; $::Quit = 'monitor click' if TrackGoAway($my->{port}, $pt); 1;});
  $MonWin->sethook(grow => sub {
    my($my,$pt) = @_;
    if (my($w,$h) = GrowWindow($my->{port}, $pt, Rect->new(30, WINV, 1024, WINV * 10))) {
      $my->invalgrowarea;
      SizeWindow($my->{port}, $MonWid = $w, $h);
      $my->invalgrowarea;
      $my->layout;
    }
    1;
  });
  SetPort $MonPort = $MonWin->window;
  TextSize(9);
  $MonWin->drawgrowicon;
}

sub mon_push {
  return unless MONITOR and $MonWin and $MonWin->window;
  local ($DB::single, $DB::trace) = (0, 0);
  $MonCount++; mon_size();
  SetPort($MonPort);
  MoveTo(3, WINV * $MonCount - 5);
  DrawString($_[0]);
}

sub mon_set {
  return unless MONITOR and $MonWin and $MonWin->window;
  local ($DB::single, $DB::trace) = (0, 0);
  SetPort($MonPort);
  MoveTo(3, WINV * ($MonCount+1) - 5);
  EraseRect(Rect->new(0, WINV * $MonCount, $MonWid, WINV * ($MonCount+1)));
  DrawString($_[0]);
}

sub mon_pop {
  $MonCount--; mon_size();
  SetPort($MonPort);
  EraseRect(Rect->new(0, WINV * $MonCount, $MonWid, WINV * ($MonCount+1)));
}

sub mon_clean {
  $MonCount = 0; mon_size();
}

sub mon_size {
  SizeWindow($MonPort, $MonWid, WINV * ($MonCount+1));
}

END {$MonWin->dispose if $MonWin;}
ET_MAC
### "Other" monitor handling ###############################################

sub mon_push {}
sub mon_pop {}
sub mon_clean {}

ET_OTHER

1;
