with Ada.Exceptions;
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Virtual_Times; use Virtual_Times; -- for type Time
with Events;
with Error_Log; use Error_Log;  -- for file Log
package body Simulator is

   Now : Time;
   Stopping_Time : Time;
   Event_Queue : Events.Queues.Object;

   Every_Clock_Event : Events.Class_Ref;
   --  a clumsy hook on which to hang an event that
   --  need to be done every time the clock advances

   function Current_Time return Time is
   begin
      return Now;
   end Current_Time;

   procedure Schedule_Event (E : in out Events.Object'Class) is
   begin
      pragma Assert (E.Event_Time >= Now);
      pragma Assert (E.Event_Time < Time'Last);
      pragma Assert (not E.Enqueued);
      Event_Queue.Add (E'Unchecked_Access);
      E.Enqueued := True;
   end Schedule_Event;

   procedure Set_Every_Clock_Event (E : in out Events.Object'Class) is
      use Events;
   begin
      pragma Assert (Every_Clock_Event = null);
      Every_Clock_Event := E'Unchecked_Access;
   end Set_Every_Clock_Event;

   procedure Cancel_Event (E : in out Events.Object'Class) is
   begin
      pragma Assert (E.Event_Time >= Now);
      pragma Assert (E.Event_Time < Time'Last);
      pragma Assert (E.Enqueued);
      Event_Queue.Delete (E'Unchecked_Access);
      E.Event_Time := Time'Last;
      E.Enqueued := False;
   end Cancel_Event;

   procedure Show_Event_Queue (F : File_Type; Long : Boolean := False) is
      procedure Show_Event (E : Events.Class_Ref) is
      begin
         Put (F, " ["); Put (F, E.Name); Put (F, "]");
         if Long then New_Line (F);
         end if;
      end Show_Event;
      procedure Show_All is new Events.Queues.For_All (Show_Event);
   begin
      if Long then
         Put_Line (F, "event_queue: ");
      end if;
      Show_All (Event_Queue);
      if not Long then New_Line (F);
      end if;
   end Show_Event_Queue;

   procedure Stop is
   begin
      Stopping_Time := Now;
   end Stop;

   procedure Run (Latest_Stop_Time : Time) is
      E : Events.Class_Ref;
      use Ada.Text_IO;
      use Ada.Integer_Text_IO;
      use Events.Queues;
      use Events;
   begin
      Now := 0;
      Stopping_Time := Latest_Stop_Time;
      -- Queue simulation
      loop
         --  process events that occur at the same virtual time
         while not Event_Queue.Is_Empty and then
           Front_Of (Event_Queue).Event_Time = Now loop
            --  remove next event from queue
            E := Event_Queue.Front_Of;
            Event_Queue.Pop;
            E.Enqueued := False;
            if Debug_Level > 0 then
               pragma Debug (Put_Line
                             (Log, "        ,__________"
                               & Time'Image (Now)
                               & "_________"));
               pragma Debug (Put (Log, Name (E.all)));
               if Debug_Level > 1 then
                  pragma Debug (Show_Event_Queue (Log, Long => False));
                  null;
               else
                  pragma Debug (New_Line (Log));
                  null;
               end if;
            end if;
            E.Handler;
         end loop;
         if Every_Clock_Event /= null then
            Every_Clock_Event.Handler;
         end if;
         if Event_Queue.Is_Empty then
            pragma Debug (Debug (1, "simulator exited for empty event queue"));
            exit;
         end if;
         Now := Event_Queue.Front_Of.Event_Time;
         if Now > Stopping_Time then
            pragma Debug (Debug (1, "simulator exited for time past" &
                           Time'Image (Stopping_Time)));
            if Debug_Level > 1 then
               Show_Event_Queue (Log);
            end if;
            exit;
         end if;
      end loop;
   exception
      when Simulation_Done =>
         Clear (Event_Queue);
      when X : others =>
         Put (Log, "exception " & Ada.Exceptions.Exception_Name (X));
         Put (Log, " in Simulator.Run at ");
         Put_Line (Log, Ada.Exceptions.Exception_Message (X));
         Put (Log, "last event: ");
         Put (Log, Name (E.all)); New_Line (Log);
         Clear (Event_Queue);
         raise;
   end Run;

end Simulator;