2 with Ada
.Text_IO
; use Ada
.Text_IO
;
3 with Ada
.Calendar
; use Ada
.Calendar
;
4 with Ada
.Containers
.Vectors
;
6 with Ada
.Numerics
.Generic_Elementary_Functions
;
10 with Simulator
.Controller
;
11 with Simulator
.Car
; use Simulator
.Car
;
12 with Simulator
.Statistics
; use Simulator
.Statistics
;
13 with Simulator
.TrackGui
; use Simulator
.TrackGui
;
14 with Simulator
.TrackData
; use Simulator
.TrackData
;
18 with Schema
.Schema_Readers
, Schema
.Validators
, Input_Sources
.File
;
19 use Schema
.Schema_Readers
, Schema
.Validators
, Input_Sources
.File
;
20 with Schema
.Schema_Grammar
; use Schema
.Schema_Grammar
;
23 with Schema
.Readers
; use Schema
.Readers
;
24 with Schema
.Dom_Readers
; use Schema
.Dom_Readers
;
26 --with DOM.Readers; use DOM.Readers;
27 with DOM
.Core
; use DOM
.Core
;
28 with DOM
.Core
.Documents
; use DOM
.Core
.Documents
;
29 with DOM
.Core
.Nodes
; use DOM
.Core
.Nodes
;
30 with DOM
.Core
.Attrs
; use DOM
.Core
.Attrs
;
32 with Ada
.Numerics
.Float_Random
;
33 use Ada
.Numerics
.Float_Random
;
34 with Ada
.Exceptions
; use Ada
.Exceptions
;
37 package body Simulator
.Track
is
38 type Intermediate_Count_T
is new Positive range 1 .. 1_000
;
39 package IntVector
is new Ada
.Containers
.Vectors
(Element_Type
=> Integer, Index_Type
=> Intermediate_Count_T
);
40 package Float_Functions
is new Ada
.Numerics
.Generic_Elementary_Functions
(Float);
45 MaxMultiplicity
: Positive := 3;
46 -- n_registered : Natural :=0;
47 BoxSpeedLimit
: Float := 22.2; -- m/s
48 PitStopSector
: Positive;
49 Intermediate
: IntVector
.Vector
;
50 TrackStarted
: Boolean := False;
52 type PitStopRequest_T
is array (CarId_T
) of Boolean ;
54 type PitStopRecord_T
is record
59 type PitStopData_T
is array (CarId_T
) of PitStopRecord_T
;
60 PitStopData
: PitStopData_T
;
61 PitStopRequest
: PitStopRequest_T
;
62 type RetireRequest_T
is array (CarId_T
) of Boolean ;
63 RetireRequest
: PitStopRequest_T
;
65 procedure CalculateDriveTime
(my_properties
: CarProperties_T
; my_length
: Natural; my_level
: Integer; weather
: Weather_T
; isbox
: Boolean; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float; finish
: out Duration) is
66 Vmax
: Float := 100.0;
67 difficulty
: Integer := my_level
;
68 -- dati per calcolo velocità e accelerazione
70 Smax
: Float:= Float(my_length
);
72 V0
: Float := my_speed
;
76 if (difficulty
< 0) then
77 difficulty
:= - difficulty
;
79 a
:= a
- a
*0.8* ( 0.3 * (1.0 - Float(my_properties
.CarPerformance
) / 100.0) + 0.10 * Float(my_properties
.TiresConsumption
) + 0.4*( (Float(difficulty
) / Float(MaxLevel
))) + 0.20 * ( Float(my_properties
.CarFuel
)/ Float(MaxFuel
)));
80 if (weather
= Wet
) then
81 -- se piove diminuiso l'accelerazione massima di 1/3;
83 if (my_properties
.Tires
= Slick
) then
84 -- se piove e monto le gomme da asciutto diminuisco l'accelerazione di un ulteriore terzo
88 -- Il tracciato è asciutto
89 if (my_properties
.Tires
= Rain
) then
90 -- monto le gomme da bagnato
95 Vmax
:= Vmax
* Float( Float(1 + MaxLevel
- difficulty
)/ Float(1 + MaxLevel
));
97 Vmax
:= Float(BoxSpeedLimit
);
101 -- Parte in moto uniformemente accelerato
102 S
:= ((Vmax
*Vmax
) - (V0
*V0
))/(2.0*a
);
105 -- pezzo in moto uniformemente accelerato
108 -- pezzo in moto rettilineo uniforme
109 t
:= t
+ ((Smax
- S
) / Vmax
);
112 -- percorro tutto il tratto accelerando
113 Vfinal
:= Float_Functions
.Sqrt
((V0
*V0
) + (2.0*a
*Smax
));
114 t
:= (Vfinal
- V0
) / a
;
117 --arrivo a velocità troppo alta. Freno in maniera istantanea e percorro il tratto
118 --a velocità costante
122 -- Vfinal è la velocità di uscita dal tratto, t il tempo impiegato
123 -- in ogni caso, aggiorno il consumo
124 my_consumption
:= Float(my_length
) / 180000.0;
125 my_consumption
:= my_consumption
*( 1.0 + 0.2* (Float(my_properties
.CarPerformance
) / 100.0) + 0.3* Float(my_properties
.CarFuel
)/ Float(MaxFuel
) );
126 my_fuel
:= - Float(my_length
) / 2040.0;
127 my_fuel
:= my_fuel
*( 1.0 + 0.3* ( Float(my_properties
.CarPerformance
) / 100.0) + 0.2* Float(my_properties
.CarFuel
)/ Float(MaxFuel
) );
129 if ( (Float( PitStopData
(my_properties
.CarId
).CarFuel
) / 12.0) < 5.5) then
133 t
:= t
+ Float(Float(PitStopData
(my_properties
.CarId
).CarFuel
) / 12.0);
135 my_consumption
:= Float(- my_properties
.TiresConsumption
);
136 my_fuel
:= Float(PitStopData
(my_properties
.CarId
).CarFuel
);
141 finish
:= Duration(t
);
143 end CalculateDriveTime
;
145 protected type Semaphore
is
148 procedure Signal
(start
: Boolean; car
: out Boolean); -- V
150 Started
: Boolean := false;
151 Used
: Boolean := False;
153 type Semaphore_Ref
is access Semaphore
;
154 protected body Semaphore
is
155 entry Wait
when True is
160 entry Internal
when Started
= True is
164 procedure Signal
(start
: Boolean; car
: out Boolean) is
174 protected type Lane_T
(my_length
: Natural; my_level
: Integer;my_weather
: Weather_T
; my_isbox
: Boolean) is
175 entry Demand
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float);
177 Weather
: Weather_T
:=my_weather
;
178 IsBox
: Boolean := my_isbox
;
179 exit_time
: Time
:= Clock
;
180 exit_speed
: Float := 0.0;
181 Level
: Integer := my_level
;
182 Length
: Natural := my_length
;
186 entered
: Integer :=0;
187 open
: Boolean := False;
189 type Corsie_T
is array (Positive range <>) of access Lane_T
;
190 type Corsie_Array_T
is array (Positive range <>) of access Corsie_T
;
191 Corsie
: access Corsie_Array_T
;
192 type PitLane_T
is array(CarId_T
) of Semaphore_Ref
;
193 PitLane
: access PitLane_T
:= new PitLane_T
;
195 type LaneCounter_T
is array (Positive range<>) of Natural;
196 type CarLane_T
is array (CarId_T
) of Positive;
198 type ExitRecord
is record
200 CarTime
: Time
:= Clock
;
201 Arrived
: Boolean := False;
203 type ExitArray_T
is array (Integer range <>) of ExitRecord
;
205 protected type Sector
(my_sector_id
: Natural; my_multiplicity
: Natural; my_length
: Natural; my_level
: Integer; my_isbox
: Boolean ) is
206 --sceglie la corsia da percorrere, cioè quella con meno traffico, calcola il tempo di percorrenza e effettua la requeue su di essa
207 entry Enter
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float);
208 entry Release
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float);
209 entry BookExit
(my_properties
: CarProperties_T
; my_time
: Time
);
212 entry ExitLane
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float);
213 ExitArray
: ExitArray_T
(1 .. MaxId
);
214 ExitCount
: Natural := 0;
215 LaneCounter
: LaneCounter_T
(1 .. my_multiplicity
) ;
217 Free
: Natural := MaxId
;
218 MaxCars
: Natural := MaxId
;
219 Sector_Id
: Natural :=my_sector_id
;
220 Length
: Natural := my_length
;
221 Multiplicity
: Natural := my_multiplicity
;
222 Level
: Integer := my_level
;
223 IsBox
: Boolean := my_isbox
;
225 Changed
: Boolean := False;
228 entered
: Integer :=0;
229 open
: Boolean := False;
232 type Sector_Array_T
is array (Positive range <>) of access Sector
;
234 Sectors
: access Sector_Array_T
;
236 BoxSector
: access Sector
;
238 procedure CheckSurpass
(Sector_Id
: Natural; CarId
: CarId_T
) is
240 Print
("Controllo i sorpassi nel settore"& Sector_Id
'Img);
241 if (Sector_Id
/= 1) then
242 if ( (not ExitOrder
(Sector_Id
- 1).Is_Empty
) ) then
243 if (ExitOrder
(Sector_Id
- 1).First_Element
/= CarId
) then
244 Print
("Errore : L'auto ha superato tra l'uscita di un settore e l'entrata nel settore "& Sector_Id
'Img);
246 -- cancello il primo elemento
247 ExitOrder
(Sector_Id
- 1).Delete_First
;
250 if ( (not ExitOrder
(Sectors
'Length).Is_Empty
)) then
251 if( ExitOrder
(Sectors
'Length ).First_Element
/= CarId
) then
252 Print
("Errore : L'auto ha superato tra l'uscita di un settore e l'entrata nel settore "& Sector_Id
'Img);
254 -- cancello il primo elemento
255 ExitOrder
(Sectors
'Length).Delete_First
;
261 protected body Sector
is
262 entry BookExit
(my_properties
: CarProperties_T
; my_time
: Time
) when True is
264 if (ExitCount
<= 0) then
265 ExitArray
(1) := (my_properties
.CarId
, my_time
, False);
266 ExitCount
:= ExitCount
+ 1;
268 for Index
in reverse 0 .. ExitCount
loop
270 for I
in reverse (Index
+ 1) .. ExitCount
loop
271 ExitArray
(I
+1) := ExitArray
(I
);
273 ExitArray
(Index
+ 1) := (my_properties
.CarId
, my_time
, False);
274 ExitCount
:= ExitCount
+ 1;
276 else if(ExitArray
(Index
).CarTime
< my_time
) then
277 for I
in reverse (Index
+ 1) .. ExitCount
loop
278 ExitArray
(I
+1) := ExitArray
(I
);
280 ExitArray
(Index
+ 1) := (my_properties
.CarId
, my_time
, False);
281 ExitCount
:= ExitCount
+ 1;
289 entry Enter
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float) when Free
> 0 is
292 --Prima auto a entrare nel tracciato azzera i campi dato
293 if (MaxCars
= Free
) then
294 for Index
in 1 .. Multiplicity
loop
295 LaneCounter
(Index
) := 0;
298 -- decido la corsia da percorrere. Trovo quella meno trafficata
301 for Index
in 1.. Multiplicity
loop
302 if (LaneCounter
(Index
) < LaneCounter
(n_lane
)) then
305 -- n_lane è l'id del lane meno trafficato
307 LaneCounter
(n_lane
) := LaneCounter
(n_lane
) + 1;
309 CarLane
(my_properties
.CarId
) := n_lane
;
311 pragma Debug
(CheckSurpass
(Sector_Id
, my_properties
.CarId
));
313 Print
("Auto "&my_properties
.CarId
'Img&" percorre Settore: "&Sector_Id
'Img&", Tratto:"&n_lane
'Img&".");
314 if (IsBox
= False) then
315 requeue Corsie
(Sector_Id
)(n_lane
).Demand
with abort;
317 requeue Corsie
(Sectors
'Length + 1)(n_lane
).Demand
with abort;
321 entry Release
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float) when Free
< MaxCars
is
324 t
: Integer := Sector_Id
;
326 if (ExitCount
= 0) then
327 Put_Line
("Bug del software: invocata Relase senza aver invocato BookExit");
329 if (ExitArray
(1).CarId
= my_properties
.CarId
) then
330 for Index
in 2 .. ExitCount
loop
331 ExitArray
(Index
-1) := ExitArray
(Index
);
333 LaneCounter
(CarLane
(my_properties
.CarId
)) := LaneCounter
(CarLane
(my_properties
.CarId
)) -1;
335 ExitCount
:= ExitCount
-1;
336 if (ExitCount
> 0) then
337 if(ExitArray
(1).Arrived
= True) then
345 for Index
in 1 .. ExitCount
loop
346 if (ExitArray
(Index
).CarId
= my_properties
.CarId
) then
347 ExitArray
(Index
).Arrived
:= True;
348 Print
("DEBUG: Auto "&my_properties
.CarId
'Img&" ha superato dove non doveva..accodo in ExitLane");
355 ExitOrder
(Sector_Id
).Append
(my_properties
.CarId
);
356 -- calcolo il prossimo settore
357 if (Sector_Id
= Sectors
'Length) then
360 next_sect
:= Sector_Id
+1;
364 if (PitStopRequest
(my_properties
.CarId
) = true and then next_sect
= PitStopSector
) then
366 PitStopRequest
(my_properties
.CarId
) := False;
367 requeue BoxSector
.Enter
;
370 requeue Sectors
(next_sect
).Enter
;
374 entry ExitLane
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float) when Changed
= True is
377 if (ExitArray
(1).CarId
= my_properties
.CarId
) then
378 for Index
in 2 .. ExitCount
loop
379 ExitArray
(Index
-1) := ExitArray
(Index
);
381 LaneCounter
(CarLane
(my_properties
.CarId
)) := LaneCounter
(CarLane
(my_properties
.CarId
)) -1;
383 ExitCount
:= ExitCount
-1;
384 ExitOrder
(Sector_Id
).Append
(my_properties
.CarId
);
385 if (ExitArray
(1).Arrived
= True) then
390 -- calcolo il prossimo settore
391 if (Sector_Id
= Sectors
'Length) then
394 next_sect
:= Sector_Id
+1;
398 if (PitStopRequest
(my_properties
.CarId
) = true and then next_sect
= PitStopSector
) then
400 requeue BoxSector
.Enter
;
403 requeue Sectors
(next_sect
).Enter
;
412 protected body Lane_T
is
413 entry Demand
(my_properties
: in CarProperties_T
; sector
: in out Integer; my_time
: in out Time
; my_duration
: out Duration; my_fuel
: out Float; my_consumption
: out Float; my_speed
: in out Float) when True is
417 -- TEST: modifica codice per usare solo i tempi calcolati
420 CalculateDriveTime
(my_properties
, my_length
,my_level
,Weather
,IsBox
,my_fuel
, my_consumption
,my_speed
, t
);
422 my_time
:= my_time
+ t
;--start + t;
424 if (my_time
> exit_time
) then
425 exit_time
:= my_time
;
426 exit_speed
:= my_speed
;
427 elsif (my_time
< exit_time
) then
428 -- se l'auto è dietro, esce al tempo dell'auto che precede e al più alla sua stessa velocità
429 my_time
:= exit_time
;
430 if (my_speed
> exit_speed
) then
431 my_speed
:= exit_speed
;
434 my_duration
:= t
;--my_time - start;
438 -- inserisce la macchina nel circuito, fornisce in ingresso le
439 -- caratteristiche iniziali dell'auto. Quando questo metodo termina vuol
440 -- dire che la macchina ha finito la gara (conclusa o per ritiro)
441 procedure PutOnPitLane
(my_CarProperties
: CarProperties_T
) is
442 my_sect
: Integer :=0;
445 my_consumption
: Float;
446 my_duration
: Duration;
447 CarProperties
: CarProperties_T
:= my_CarProperties
;
448 Speed
: Float := 0.0;
452 old_lap
: Integer :=0;
453 old_sect
: Integer := 0;
455 old_speed
: Float := 0.0;
458 Put_Line
("DEBUG: chiamata putonpilane");
459 Print
("Car " & CarId_T
'Image(CarProperties
.CarId
) & " registered");
460 --Auto si mette nelle linee di partenza. Quando tornerà da questa chiamata, la corsa per l'auto sarà iniziata
461 PitLane
(CarProperties
.CarId
).Wait
;
465 Put_Line
("Auto "&CarProperties
.CarId
'Img&" partita");
466 Simulator
.Controller
.GetRace
.UpdateStatistics
(CarProperties
.CarId
,CarProperties
.Name
, 0,1, (my_time
- Time_Of
(2009,9,21)), 0.0, 1);
468 -- mi prenoto sull'ultimo settore
469 Sectors
(Sectors
'Last).Enter
(CarProperties
, my_sect
, my_time
, my_duration
, my_fuel
, my_consumption
, Speed
);
470 Sectors
(Sectors
'Last).BookExit
(CarProperties
, old_time
);
472 -- Partenza: ogni auto parte e notifica l0avvenuta partenza a quella in posizione successiva
475 success
: Boolean := False;
477 while ( i
<= Integer(CarId_T
'Last) and then success
= False) loop
478 PitLane
(CarId_T
(i
)).Signal
(True, success
);
479 Put_Line
("Mando segnale all'auto "&i
'Img&" con responso "&success
'Img);
483 Sectors
(Sectors
'Last).Release
(CarProperties
, my_sect
, my_time
, my_duration
, my_fuel
, my_consumption
, Speed
);
485 Put_Line
("DEBUG: Auto "&CarProperties
.CarId
'Img&" è partita e passata dal via.");
486 --inizio la corsa iterando tra i vari Sector
487 while (RetireRequest
(CarProperties
.CarId
) = False) loop
489 if (my_sect
= 1) then
493 if (my_sect
/= 0) then
494 Sectors
(my_sect
).BookExit
(CarProperties
, my_time
);
496 BoxSector
.BookExit
(CarProperties
, my_time
);
499 -- aggiorno dati auto
500 temp
:= Float(CarProperties
.CarFuel
) + my_fuel
;
501 if (temp
< Float(CarFuel_T
'First)) then
502 CarProperties
.CarFuel
:= 0.0;
503 elsif (temp
> Float(CarFuel_T
'Last)) then
504 CarProperties
.CarFuel
:= CarFuel_T
'Last;
505 else CarProperties
.CarFuel
:= CarFuel_T
(temp
);
507 temp
:= Float(CarProperties
.TiresConsumption
) + my_consumption
;
508 if (temp
< Float(TiresConsumption_T
'First)) then
509 CarProperties
.TiresConsumption
:=TiresConsumption_T
'First ;
510 elsif (temp
> Float(TiresConsumption_T
'Last)) then
511 CarProperties
.TiresConsumption
:= TiresConsumption_T
'Last;
512 else CarProperties
.TiresConsumption
:= TiresConsumption_T
(temp
);
514 -- aggiorno l'auto remota
515 Simulator
.Controller
.GetCar
(CarProperties
.CarId
).UpdateProperties
(CarId
=> CarProperties
.CarId
,
516 Tires
=> CarProperties
.Tires
,
517 TiresConsumption
=> CarProperties
.TiresConsumption
,
518 CarFuel
=> CarProperties
.CarFuel
,
519 CarPerformance
=> CarProperties
.CarPerformance
,
523 SectorDuration
=> my_time
- old_time
);-- my_duration);
525 -- controllo se è un intermedio
526 if (my_sect
/= 0 and then Intermediate
.Find_Index
(Item
=> my_sect
, Index
=> Intermediate_Count_T
'First) /= No_Index
) then
527 inter
:= Integer(Intermediate
.Find_Index
(Item
=> my_sect
, Index
=> Intermediate_Count_T
'First));
528 elsif ( my_sect
= 0 and then Intermediate
.Find_Index
(Item
=> PitStopSector
, Index
=> Intermediate_Count_T
'First) /= No_Index
) then
529 inter
:= Integer(Intermediate
.Find_Index
(Item
=> PitStopSector
, Index
=> Intermediate_Count_T
'First));
538 -- se sto percorrendo i box, notifico la cosa alla gara, che deve saperlo prima che l auto termini di percorrerli
539 if (my_sect
= 0) then
540 Simulator
.Controller
.GetRace
.UpdateCarStatus
(CarProperties
.CarId
, old_lap
, CarStatus_T
(Box
));
546 if (my_sect
/= 0) then
547 Sectors
(my_sect
).Release
(CarProperties
, my_sect
, my_time
, my_duration
, my_fuel
, my_consumption
, Speed
);
549 BoxSector
.Release
(CarProperties
, my_sect
, my_time
, my_duration
, my_fuel
, my_consumption
, Speed
);
553 if (old_sect
= 0) then
554 old_sect
:= PitStopSector
;
558 -- aggiorno le statistiche
559 Simulator
.Controller
.GetRace
.UpdateStatistics
(CarProperties
.CarId
, CarProperties
.Name
,old_lap
,old_sect
, (old_time
- Time_Of
(2009,9,21)), old_speed
, inter
);
560 --controllo se sono in grado di continuare la gara
561 if (CarProperties
.CarFuel
<= 0.0 or CarProperties
.TiresConsumption
>= 1.0) then
562 Print
("LOG: Auto "&CarProperties
.CarId
'Img&" non puo' proseguire la gara.");
563 Simulator
.Controller
.GetRace
.Kill
(CarProperties
.CarId
);
564 RetireRequest
(CarProperties
.CarId
) := True;
568 Put_Line
("DEBUG: PutOnPitLane è ritornato dalla simulazione.. Auto "&CarProperties
.CarId
'Img&" ha terminato la corsa");
572 function StartRace
(n_cars
: CarId_T
; Randomized
: Boolean) return Boolean is
574 if (TrackStarted
= False) then
577 -- inizializzo PitStopRequest.
578 for Index
in 1 .. n_cars
loop
579 PitStopRequest
(Index
) := False;
582 -- Modifico l'array in base al metodo di partenza deciso;
583 if (Randomized
= True) then
584 Put_Line
("Randomizzo la griglia di partenza");
586 Temp
: Semaphore_Ref
;
591 for Index
in 1 .. 48 loop
592 for i
in 1 .. CarId_T
'Last loop
593 -- intero casuale equamente disribuito tra 1 e n_registered
594 pos
:= CarId_T
( 1 + (Integer(Float(CarId_T
'Last ) * Random
(G
)) mod Integer(CarId_T
'Last))) ;
595 -- eseguo lo switch tra l elemento i-esimo e pos-esimo
596 Temp
:= PitLane
(pos
);
597 PitLane
(pos
) := PitLane
(i
);
602 Put_Line
("Terminata randomizzazione griglia di partenza");
604 -- sveglio la prima auto in attesa su PitLane,
607 success
: Boolean := False;
609 while (i
<= Integer(CarId_T
'Last) and then success
= False) loop
610 PitLane
(CarId_T
(i
)).Signal
(True, success
);
611 Put_Line
("Mando segnale all'auto "&i
'Img&" con responso "&success
'Img);
615 Put_Line
("Race started.");
619 -- Comunica di ritirare l'auto con id = CarId dal circuito
620 procedure Kill
(CarId
: in CarId_T
) is
622 Put_Line
("Killing car "&CarId
'Img&" ...");
623 RetireRequest
(CarId
) := True;
626 -- metodo di richiesta fermata ai box l'invocazione di questo metodo porta
627 -- il circuito a far fare una sosta all'auto "CarId" appena possibile.
628 procedure CallForPitStop
(CarId
: in CarId_T
; CarFuel
:CarFuel_T
; Tires
:Tires_T
) is
630 PitStopRequest
(CarId
) := True;
631 PitStopData
(CarId
) := (CarFuel
, Tires
);
632 Put_Line
("Car "&CarId_T
'Image(CarId
)&" requires Pit Stop.");
635 procedure InitTrack
is
637 for i
in CarId_T
loop
638 PitLane
(i
) := new Semaphore
;
640 -- Put_Line("griglia di partenza inizializzata");
643 function ReadTrackConf
(confFile
: String) return Boolean is
644 Grammar
: XML_Grammar
;
645 SReader
: Schema_Reader
;
648 Reader
: Schema
.Dom_Readers
.Tree_Reader
;
651 TrackList
: Node_List
;
657 Multiplicity
: Positive;
658 Weather
: String := "------";
660 intermedi
: Boolean := False;
662 Set_Public_Id
(SInput
, "Schema-file");
663 -- importo il file XMLSchema
664 Open
("schema.xsd", SInput
);
665 Parse
(SReader
, SInput
);
667 Grammar
:= Get_Created_Grammar
(SReader
);
668 Global_Check
(Grammar
);
670 Put_Line
("DEBUG: Leggo configurazione da file xml");
671 Set_Validating_Grammar
(Reader
, Grammar
);
674 Set_Public_Id
(Input
, "Track file");
675 Open
(confFile
, Input
);
676 Set_Feature
(Reader
, Sax
.Readers
.Validation_Feature
, false);
677 Set_Feature
(Reader
, Sax
.Readers
.Namespace_Feature
, false);
678 Set_Feature
(Reader
, Sax
.Readers
.Schema_Validation_Feature
, True);
680 Parse
(Reader
, Input
);
682 Doc
:= Get_Tree
(Reader
);
683 TrackList
:= Get_Elements_By_Tag_Name
(Doc
, "track");
685 if (Length
(TrackList
) /= 1) then
686 Put_Line
("Errore nel file XML. Ogni file deve contenere esattamente un elemento track");
688 List
:= Get_Elements_By_Tag_Name
(Doc
, "sector");
689 Put_Line
("DEBUG TRACK:ci sono "&Length
(List
)'Img&" settori");
690 Sectors
:= new Sector_Array_T
(1 .. Length
(List
));
691 Corsie
:= new Corsie_Array_T
(1 .. Length
(List
) + 1);
692 ExitOrder
:= new ExitOrder_T
(1 .. Length
(List
) +1);
694 for Index
in 1 .. Length
(List
) loop
695 Settore
:= Item
(List
, Index
- 1);
696 A
:= Get_Named_Item
(Attributes
(Settore
), "level");
697 Livello
:= Integer'Value (Node_Value
(A
)) ;
698 A
:= Get_Named_Item
(Attributes
(Settore
), "length");
699 Lunghezza
:= Natural'Value (Node_Value
(A
));
700 A
:= Get_Named_Item
(Attributes
(Settore
), "multiplicity");
701 Multiplicity
:= Positive'Value (Node_Value
(A
));
702 -- Creo l'array Corsie_T relativo al settore
703 Corsie
(Index
) := new Corsie_T
( 1 .. Multiplicity
);
704 ExitOrder
(Index
) := new CarIdVector_T
.Vector
;
706 A
:= Get_Named_Item
(Attributes
(Settore
), "weather");
707 -- Se l'attributo weather non è specificato, il settore è asciutto
708 if( A
= null or else Node_Value
(A
) = "dry") then
709 Put_Line
("dry sector");
712 Put_Line
("wet sector");
716 A
:= Get_Named_Item
(Attributes
(Settore
), "intermediate");
718 if( A
/= null and then Boolean'Value (Node_Value
(A
)) = True) then
719 Intermediate
.Append
(Index
);
720 Put_Line
("intertempo");
723 --Creo il settore e i lane
724 Sectors
(Index
) := new Sector
(Index
,Multiplicity
,Lunghezza
,Livello
,False);
725 for i
in 1 .. Multiplicity
loop
726 Corsie
(Index
)(i
) := new Lane_T
(Lunghezza
,Livello
,w
,False);
728 Put_Line
("creato settore "& Index
'Img);
730 BoxList
:= Child_Nodes
( Settore
);
731 if (Length
(BoxList
) /= 0) then
732 Put_Line
("Inizializzo box");
733 PitStopSector
:= Index
;
735 A
:= Get_Named_Item
(Attributes
(Item
(BoxList
,1)), "length");
736 Lunghezza
:= Natural'Value (Node_Value
(A
));
737 BoxSector
:= new Sector
(Index
, MaxId
, Lunghezza
, Livello
, True);
738 -- Creo l'array Corsie_T relativo ai box .. Moltiplicità MaxId
739 Corsie
(Length
(List
) + 1) := new Corsie_T
( 1 .. MaxId
);
740 ExitOrder
(Length
(List
) + 1) := new CarIdVector_T
.Vector
;
741 for i
in 1 .. MaxId
loop
742 Corsie
(Length
( List
) + 1)(i
) := new Lane_T
(Lunghezza
,Livello
,w
,True);
744 Put_Line
("Trovati box nel sttore "& PitStopSector
'Img&" di lunghezza "&Lunghezza
'Img);
747 -- Inizializzo PitLane
748 -- for i in CarId_T loop
749 -- PitLane(i) := new Semaphore;
753 TrackStarted
:= True;
756 when Error
: others =>
757 Print_NoLock
("Errore nel file di configurazione");
758 Print_NoLock
(Exception_Message
(Error
));