Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- with Ada.Text_IO;
- use Ada.Text_IO;
- procedure Traffic is
- type Lamp is (Piros,PirosSarga,Zold,Sarga);
- type Pstring is access String;
- protected Crossroad is
- entry Cross(D : Duration);
- procedure Wake_Up;
- end Crossroad;
- task type Signal;
- task body Signal is
- begin
- Crossroad.Wake_Up;
- end Signal;
- type PSignal is access Signal;
- protected Lamps is
- function Color return Lamp;
- procedure Switch;
- private
- ActColor : Lamp := Piros;
- LSignal : PSignal;
- end Lamps;
- protected body Lamps is
- function Color return Lamp is
- begin
- return ActColor;
- end Color;
- procedure Switch is
- begin
- LSignal := new Signal;
- if ActColor = Sarga then
- ActColor := Piros;
- Put_Line(Lamp'Image(ActColor));
- else
- ActColor := Lamp'Succ(ActColor);
- Put_Line(Lamp'Image(ActColor));
- end if;
- end Switch;
- end Lamps;
- task Controller is
- entry Stop;
- end Controller;
- task body Controller is
- Stopped : Boolean := False;
- begin
- while not Stopped loop
- select
- accept Stop;
- Stopped := True;
- else
- Lamps.Switch;
- delay 3.0;
- Lamps.Switch;
- delay 1.0;
- Lamps.Switch;
- delay 3.0;
- Lamps.Switch;
- delay 2.0;
- end select;
- end loop;
- end Controller;
- protected body Crossroad is
- entry Cross(D : Duration) when Lamps.Color = Zold is
- begin
- delay D;
- end Cross;
- procedure Wake_Up is
- begin
- null;
- end Wake_Up;
- end Crossroad;
- task type Vehicle(N : Pstring);
- task body Vehicle is
- Passed_Over : Boolean := False;
- begin
- Put_Line(N.all & " Car Is Waiting At The Lamp");
- select
- Crossroad.Cross(1.0);
- else
- Crossroad.Cross(3.0);
- end select;
- Put_Line(N.all & " Car Passed Over");
- end Vehicle;
- type PVehicle is access Vehicle;
- type VehicleAr is array (1..30) of PVehicle;
- Vehicles : VehicleAr;
- P : Pstring;
- begin
- for I in 1..30 loop
- P := new String'(Integer'Image(I));
- delay 0.5;
- Vehicles(I) := new Vehicle(P);
- end loop;
- Skip_Line;
- Controller.Stop;
- end Traffic;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement