program air_traffic_control;
{$RANGECHECKS ON}{$OVERFLOWCHECKS ON}{$HINTS ON}
{.$DEFINE SKIP_PASSWORDPROMPT}
{.$DEFINE SKIP_CHOICEPOSITIVE}
{.$DEFINE SKIP_WAITS}
uses
Dos, Crt;
const
DefaultPW = '';
SystemInstructionDelay = 1000;
TakeOffDelay = 20000;
airtrafficfilename = 'airtraffic.txt';
platformfilename = 'airport_condition.txt';
type
Tairport_platform =
record
airplane_no : string[30];
airplane_predicted_time_left : integer;
end;
Tairtraffic_condition =
record
airplane_no : string[30];
airplane_landing_time_left : integer;
end;
var
hour : word = 0;
min : word = 0;
sec : word = 0;
msec : word = 0;
NrLandedPlanes : integer = 0; // previously named: Num
NrAirbornePlanes : integer = 0; // previously named: Count2
target : integer = 0;
count : integer;
z : integer;
platformfile,
airtrafficfile : text;
platform : array[1..30] of Tairport_platform;
airtraffic : array[1..20] of Tairtraffic_condition;
ch : char;
// Displays PromptMsg and awaits input from keyboard to match global PassWord
// definition. If the PassWord does not match the HintMsg is displayed until
// PassWord matches. In case HintMsg is empty then the screen is cleared and
// the PromptMsg is repeated.
// The routine loops until userinput matches password
procedure PromptForPassWord(aPromptMsg: string = 'Password:'; aHintMsg: string = '');
var
password : string[20];
begin
{$IFNDEF SKIP_PASSWORDPROMPT}
repeat
write(aPromptMsg);
readln(password);
if (aHintMsg <> '') then
begin
if (password <> DefaultPW) then WriteLn(aHintMsg);
end
else ClrScr;
until password=DefaultPW;
{$ENDIF}
end;
// Copy from http://www.freepascal.org/docs-html/rtl/system/reset.html
// Note that the original code had an error in that if the file does not
// exist the example is still atempting to close the file -> error.
// This code has that issue fixed.
// Check if a given filename/path exists and returns a true/false answer
function FileExists (aFileName: string) : boolean;
var
f : File;
begin
if (aFileName <> '') then
begin
{$i-}
Assign (f, aFileName);
Reset (f);
{$i+}
if (IOResult = 0) then
begin
Close (f);
Exit(true);
end;
end;
FileExists := false;
end;
// Creates a new texfile from given Filename and returns filepointer
// in FileVar. In case things go wrong the function halts the program (panic).
procedure CreateNewTextFile(aFileName: string; var aFileVar: Text);
var
LastError : Word = 0;
begin
if (aFileName <> '') then
begin
{$i-}
Assign (aFileVar, aFileName);
Rewrite (aFileVar);
{$i+}
LastError := IoResult;
if (LastError = 0) then Close(aFileVar) else
begin
WriteLn('Fatal error ! Unable to create file ', aFileName, ' (IOResult = ', LastError, ')');
Halt(1);
end;
end
else
begin
WriteLn('Fatal error ! Empty Filename');
Halt(1);
end;
end;
procedure user_display;
type
TDayType = (Sun,Mon,Tue,Wed,Thu,Fri,Sat);
var
YY : Word = 0;
MM : word = 0;
DD : word = 0;
DayOfWeek : Word = 0;
hour : Word = 0;
min : Word = 0;
sec : Word = 0;
msec : Word = 0;
today : TDayType;
begin
textbackground(black);
ClrScr;
Getdate(YY,MM,DD,DayOfWeek);
GetTime(hour,min,sec,msec);
Today := TDayType(DayOfWeek);
textcolor(yellow);
WriteLn('Welcome to execute air traffic control');
textcolor(yellow);
PromptForPassword('PassWord:', 'Wrong password, enter again');
ClrScr;
WriteLn('Day of Today:',DD,'/',MM,'/',YY,',',Today);
WriteLn('Current time: ',hour,':',min,':',sec);
WriteLn('Now start the system of air traffic control management');
textcolor(yellow);
PromptForPassword('PassWord:', 'Wrong password, enter again');
ClrScr;
end;
procedure input_airtraffic(var aNrAirbornePlanes:integer);
var n: integer;
begin
for n:= Low(airtraffic) to High(airtraffic)
do airtraffic[n].airplane_no := '';
aNrAirbornePlanes := 0;
if not FileExists(airtrafficfilename) then
begin
CreateNewTextFile(airtrafficfilename, airtrafficfile);
// AirTraffic must at least consist of one (valid) entry
// otherwise the rest of the code won't run properly as condition
// "zero planes in sky" plus "zero planes on ground" is treated as
// nothing to do (it might happen on startup so account for it here).
// ToDo: Add IOResult checking
Append(airtrafficfile);
WriteLn(airtrafficfile, 'fes2135487');
WriteLn(airtrafficfile, '3');
WriteLn(airtrafficfile, 'qwe7634153');
WriteLn(airtrafficfile, '7');
WriteLn(airtrafficfile, 'jfd1325748');
WriteLn(airtrafficfile, '11');
Close(airtrafficfile);
end;
// ToDo: Add IOResult checking
Assign(airtrafficfile, airtrafficfilename);
Reset(airtrafficfile);
// ToDo: Add IOResult checking
while not eof(airtrafficfile) do
begin
aNrAirbornePlanes := aNrAirbornePlanes + 1;
with airtraffic[aNrAirbornePlanes] do
begin
readln(airtrafficfile,airplane_no);
readln(airtrafficfile,airplane_landing_time_left);
end;
end;
close(airtrafficfile);
end;
procedure input_platform_condition(var aNrLandedPlanes: integer);
var
idx, n : integer;
begin
Writeln('dumping airport plane stats');
aNrLandedPlanes :=0;
for n := Low(platform) to High(platform)
do platform[n].airplane_no := '';
if not FileExists(platformfilename) then
begin
CreateNewTextFile(platformfilename, platformfile);
end;
// ToDo: Add IOResult checking
Assign(platformfile, platformfilename);
Reset(platformfile);
// ToDo: Add IOResult checking
idx := 0;
while not eof(platformfile) do
begin
if (idx < High(platform)) then inc(idx) else break;
with platform[idx] do
begin
readln(platformfile,airplane_no);
readln(platformfile,airplane_predicted_time_left);
if (airplane_no <> '') then
begin
aNrLandedPlanes := aNrLandedPlanes + 1;
Writeln('[ok] Plane = "', airplane_no, '" predicted_time_left = ', airplane_predicted_time_left);
end
else
Writeln('[xx] Plane = "', airplane_no, '" predicted_time_left = ', airplane_predicted_time_left);
end;
end;
close(platformfile);
WriteLn('Press enter to continue'); ReadLn;
end;
procedure take_off(var aNrLandedPlanes,target:integer);
var
choice: char;
begin
with platform[target] do
begin
repeat
write('plane ',airplane_no,'is ready to take off,asking for permission(Y/N)?');
choice := ReadKey;
if not( Upcase(choice) in ['Y','N'] )
then write('Wrong input choice,please input choice again(Y/N):');
ClrScr;
until (Upcase(choice) In ['Y','N']);
if (UpCase(choice)='N')
then airplane_predicted_time_left := 5 else
begin
PromptForPassWord('Enter password to execute this order:');
WriteLn('please wait for the processing of taking off.......');
Delay(TakeOffDelay);
writeln('plane ',airplane_no,'has been taken off');
ReadLn;
aNrLandedPlanes := aNrLandedPlanes - 1;
airplane_no := '$$$';
airplane_predicted_time_left := 999;
end;
end;
end;
procedure update_platform_time_left(var aNrLandedPlanes, target, count: integer);
begin
target := 0;
//@ if count <= High(platform) then
if count < High(platform) then
begin
count := count+1;
with platform[count] do
begin
airplane_predicted_time_left := airplane_predicted_time_left - 1;
if (airplane_predicted_time_left<=0) and (airplane_no <> '') then
begin
target := count;
if (platform[target].airplane_no <> '$$$') then take_off(aNrLandedPlanes, target);
if (count <= High(platform))
then update_platform_time_left(aNrLandedPlanes, target, count);
end
else if count < High(platform)
then update_platform_time_left(aNrLandedPlanes, target, count);
end;
end;
end;
procedure update_air_traffic(count:integer; var aNrLandedPlanes, aNrAirbornePlanes: integer);
var
choice1: char;
target,count1, n: integer;
begin
n := 1;
target := 0;
count1 := 0;
count := count+1;
if count<=aNrAirbornePlanes then
begin
with airtraffic[count] do
begin
airplane_landing_time_left := airplane_landing_time_left-1;
if (airplane_landing_time_left<=0) and (airplane_no<>'') then
begin
repeat
write('airplane ',airplane_no,' is asking for the permission of landing(Y/N):');
{$IFDEF SKIP_CHOICEPOSITIVE}
choice1 := 'y';
{$ELSE}
choice1 := ReadKey;
{$ENDIF}
until UpCase(choice1) in ['Y', 'N'];
WriteLn;
PromptForPassWord('Please input password to continue:');
case Upcase(choice1) of
'Y':
begin
Writeln('chosen to allow landing, searching for a free platform');
target := -1; // assume failure
for count1 := Low(platform) to High(platform) do
begin
if platform[count1].airplane_no = '' then
begin
target := count1;
break;
end;
end;
// WriteLn('The target platform is ', target);
// WriteLn('The value of count1 is ', count1);
if (target < 1) then
Begin
writeln('No platform remain, please stay on the air');
airplane_landing_time_left := 5;
end
else
begin
{$IFNDEF SKIP_WAITS}
write('airplane ',airplane_no, ' landing to platform ',target);
readln;
{$ENDIF}
platform[target].airplane_no := airplane_no;
platform[target].airplane_predicted_time_left := 400;
airplane_no := '';
aNrLandedPlanes := aNrLandedPlanes + 1;
// Update airtraffic array, e.g. 'remove' item
for n := Succ(count) to High(AirTraffic) do
begin
// copy/transfer
airtraffic[Pred(n)].airplane_no := airtraffic[n].airplane_no;
airtraffic[Pred(n)].airplane_landing_time_left := airtraffic[n].airplane_landing_time_left;
end;
// Always 'clear' last item in list as things moved. This also
// takes care of things in case the above loop did not execute.
airtraffic[High(AirTraffic)].airplane_no := '';
airtraffic[High(AirTraffic)].airplane_landing_time_left := 0;
// We now have one less plane in the air.
aNrAirbornePlanes := aNrAirbornePlanes - 1;
end;
//@ aNrAirbornePlanes := aNrAirbornePlanes - 1;
end;
'N': airplane_landing_time_left := 5
end { case choice }
end
else
//@ if count <= High(airtraffic) then
if count < High(airtraffic) then
begin
update_air_traffic(count, aNrLandedPlanes, aNrAirbornePlanes);
end;
end;
end;
end;
procedure generate_airplane_no(var aNrAirbornePlanes: integer);
Var
x: array[1..3] of char;
y: array[1..7] of char;
z: string[30] = '';
count, abc: integer;
begin
if (aNrAirbornePlanes < High(airtraffic)) then
begin
aNrAirbornePlanes := aNrAirbornePlanes + 1;
for count:= Low(x) to High(x)
do x[count] := ' ';
for count:= Low(y) to High(y)
do y[count] := ' ';
if aNrAirbornePlanes <= High(airtraffic) then
begin
randomize;
abc := random(9);
for count:= Low(x) to High(x)
do x[count] := chr(random(26)+65);
for count:= Low(y) to High(y)
do y[count] := chr(random(10)+48);
for count := 1 To 2
do z := concat(z, x[count]);
for count := low(y) to High(y)
do z := concat(z, y[count]);
with airtraffic[aNrAirbornePlanes] do
begin
airplane_no := z;
airplane_landing_time_left := random(20)+ 1; // ??? High(airtraffic) intended ?
{$IFNDEF SKIP_WAITS}
readln;
{$ENDIF}
end;
end;
end;
end;
procedure update_platformfile;
var
n: integer;
begin
rewrite(platformfile);
for n := Low(PlatForm) to High(Platform) do
begin
with platform[n] do
begin
writeln(platformfile,airplane_no);
writeln(platformfile,airplane_predicted_time_left);
end;
end;
close(platformfile);
end;
procedure update_airtrafficfile(var aNrAirbornePlanes: integer);
var n: integer;
begin
rewrite(airtrafficfile);
for n := Low(AirTraffic) to aNrAirbornePlanes do
begin
with airtraffic[n] do
begin
writeln(airtrafficfile, airplane_no);
writeln(airtrafficfile, airplane_landing_time_left);
end;
end;
close(airtrafficfile);
end;
begin
NrAirbornePlanes := 0;
user_display;
input_airtraffic(NrAirbornePlanes);
input_platform_condition(NrLandedPlanes);
while (NrLandedPlanes >= 0) do
begin
ClrScr;
GetTime(hour,min,sec,msec);
writeln('Current time: ',hour,':',min,':',sec);
z := 0;
writeln('There are total ', NrLandedPlanes, ' planes in the airport now');
writeln('There are total ', NrAirbornePlanes, ' planes are waiting for landing');
count := 0;
repeat
writeln('Press Enter to continue/Press ESC to exit');
ch := ReadKey;
ClrScr;
until (ch=#27) or (ch=#13);
case ch of
#13:
begin
if ( (NrLandedPlanes=0) and (NrAirbornePlanes=0) ) then
begin
WriteLn('No plane information found, please wait until plane land/take off....');
WriteLn('press ENTER to continue!!');
repeat
ch := ReadKey;
until (ch=#13);
ClrScr;
end
else
begin
generate_airplane_no(NrAirbornePlanes);
ClrScr;
WriteLn('Waiting for the system instruction.....');
Delay(SystemInstructionDelay);
ClrScr;
update_air_traffic(count, NrLandedPlanes, NrAirbornePlanes);
update_platform_time_left(NrLandedPlanes, target, count);
update_platformfile;
update_airtrafficfile(NrAirbornePlanes);
end;
end;
#27: exit;
end; { case ch }
end;
end.