----------------------------------------------------------------------
-- metro  - illustrates use of requeue
--
-- problem: model circular metro line with 1 train and stations where
--          passengers enter/leave
--
-- structure: passengers & train = task, stations = protected objects
-- requeue is used to 1. delay passengers for trip to their destination,
--                                2. guide train through phases
--                                   (passengers alight/board) at stations
-- cf: Burns/Wellings ch.8.6 (does not use 2.)
--
-- !!! start protocol ( cf.main ) necessary for initialisation !!!
-- !!! program does NOT terminate (just stops producing output) !!!
----------------------------------------------------------------------

with Stringpack, Ada.Numerics.Discrete_Random; use Stringpack;
procedure Metro is

   Number_Of_Stations : constant Natural := 5;
   subtype Station_Range is Integer range 1..Number_Of_Stations;

   package Random_Destination is new Ada.Numerics.Discrete_Random(Station_Range);
   use Random_Destination;
   G : Generator;

   Number_Of_Clients : constant Natural := 100; -- small town
   Capacity : Integer  := 50;  -- (relatively) big train

   How_Often : constant Natural := 4;  -- traced rounds in sample run

   --------------------------------------------------------------trace

   type Trace_Type is record
      Train_At_Station : Boolean := False;
      Clients_At_Station : Natural := 0; -- initially there or alighted
      Passenger_Count : Natural := 0;  -- in train on leaving station
   end record;
   Station_Trace : array(Station_Range) of Trace_Type;      --global!!

   procedure Trace is
   begin
      Outbuffer := Varnull;
      for I in Station_Range  loop
	 Outbuffer := Outbuffer & Cvis(Station_Trace(I).Clients_At_Station,3);
	 if Station_Trace(I).Train_At_Station
	 then Outbuffer := Outbuffer &
	   " |" & Cvis(Station_Trace(I).Passenger_Count,2) &"> ";
	 else Outbuffer := Outbuffer & "      ";
	 end if;
      end loop;
      Print;
   end Trace;

   -------------------------------------------------------------------

   protected type Stations  is ---------------------------------------
      procedure Start(Id : Station_Range);
      entry Train_Comes_In(On_Board : in out Natural);
      entry Board_The_Train(Where : Station_Range);
   private
      My_Id : Station_Range;                        -- must be set initially!!!
      entry Alight_At_Destination;           -- private entry to requeue client
                                              -- private entry to requeue train
      entry Passengers_Board(On_Board : in out Natural);
                                              -- private entry to requeue train
      entry Close_Doors(On_Board : in out Natural);
      Passenger_Count : Natural := 0;                    -- # Passagiere in Zug
      Boarding, Alighting : Boolean := False;            --  Phase
   end Stations;

   Station : array(Station_Range) of Stations;

   protected body Stations is

      procedure Start(Id : Station_Range) is
      begin My_Id := Id; end Start;

      entry Board_The_Train(Where : Station_Range)
      when Boarding and then Passenger_Count < Capacity is
      begin
	 Passenger_Count := Passenger_Count + 1;                  -- fuelle Zug
	 Station_Trace(My_Id).Clients_At_Station :=
	   Station_Trace(My_Id).Clients_At_Station - 1;   -- trace
	 requeue Station(Where).Alight_At_Destination;        -- Ziel der Reise
      end Board_The_Train;

      entry Train_Comes_In(On_Board : in out Natural)
      when True is                           -- requeue nur in entry erlaubt!!!
      begin
         Station_Trace(My_Id).Train_At_Station := True; -- trace
         Passenger_Count := On_Board;
         Alighting := True;
         requeue Passengers_Board;
      end Train_Comes_In;

      entry Alight_At_Destination when Alighting is
      begin
	 Passenger_Count := Passenger_Count - 1;   -- leave train
	 Station_Trace(My_Id).Clients_At_Station :=
	   Station_Trace(My_Id).Clients_At_Station + 1;  -- trace
      end Alight_At_Destination;

      entry Passengers_Board(On_Board : in out Natural)
      when Alight_At_Destination'Count = 0 is
      begin
	 Alighting := False;
	 Boarding := True;
	 requeue Close_Doors;
      end Passengers_Board;

      entry Close_Doors(On_Board : in out Natural)
      when  Boarding and (Board_The_Train'Count = 0 or Passenger_Count = Capacity) is
      begin
	 Boarding := False;
	 On_Board := Passenger_Count;  -- out Parameter von train_comes!!
	 Station_Trace(My_Id).Passenger_Count := Passenger_Count;  --trace
	 Trace;
	 Station_Trace(My_Id).Train_At_Station := False; -- trace
      end Close_Doors;

   end Stations; -----------------------------------------------------

   task type Clients is   --------------------------------------------
      entry Start;
   end Clients;

   task body Clients is
      From, To : Station_Range;
   begin
      accept Start;
      From := Random(G);
      Station_Trace(From).Clients_At_Station :=
	Station_Trace(From).Clients_At_Station + 1;  -- trace
      loop  -- infinite loop !!!!
	 To := Random(G);
	 Station(From).Board_The_Train(To);
	 From := To;
      end loop;
   end Clients;

   Client : array(1..Number_Of_Clients ) of Clients;  ----------------

   task Train is   ---------------------------------------------------
      entry Start;
   end Train;

   task body Train is
      Nr_Passengers : Natural := 0;
   begin
      accept Start;
      for I in 1..How_Often loop  --sample run
	 for J in Station_Range loop
	    Station(J).Train_Comes_In(Nr_Passengers);
	 end loop;
      end loop;
   end Train;


begin  -----------------------------------------------------------main

   for I in Station_Range loop Station(I).Start(I); end loop;
   for I in 1..Number_Of_Clients loop Client(I).Start; end loop;
   Train.Start;

end Metro;  ----------------------------------------------------------