Topspeed_JPI/JPI-1/Pas/LOGITEL.PAS

program logitel;

(* Simple hotel accounting program to test translation of file types *)

(*$V-*)

(* Maximum rooms in the LogiTel motel *)
const MAX_ROOMS = 100;
      MAX_MENU = 4;

type string80 = string[80];
     string60 = string[60];
     string14 = string[14];

     GuestInfo = record
                     Empty : boolean;
                     Name : string60;
                     Expenses : real;
                 end;

var Guest : ARRAY [1..MAX_ROOMS] OF GuestInfo;
    Num_Guests : 0..MAX_ROOMS;
    Choice : integer;
    Answer : char;

    Filename : string14;
    GuestFile : FILE OF GuestInfo;

procedure Wait_Message;

var C : char;

begin
    writeln; writeln;
    writeln('Press <CR> to continue ');
    readln(C);
end;


procedure Center_Text(S : string80; Line_Num : integer);
(* Procedure to display line 'S' at row 'Line_Num' *)

var Spaces : integer;

begin
    Spaces := 40 - Length(S) DIV 2;
    GOTOXY(1,Line_Num);
    ClrEOL;
    GOTOXY(Spaces,Line_Num);
    writeln(S)
end;


procedure Initialize;
(* Procedure to initialize a new motel guest list *)
var I : integer;

begin
    Num_Guests := 0;
    for I := 1 TO MAX_ROOMS do
        with Guest[I] do begin
            Empty := TRUE;
            Name := '';
            Expenses := 0.
        end;
end;

procedure ReadList;
(* Procedure to read guest list *)

var I : integer;

begin
    write('Enter filename ');
    readln(Filename); writeln;
    Assign(GuestFile,Filename);
    (*$I-*) Reset(GuestFile); (*$I+*)
    if IOresult = 0
    then
        for I := 1 TO MAX_ROOMS do
            read(GuestFile,Guest[I])
    else begin
        Initialize;
        writeln('Cannot find file ',Filename);
        writeln('Initializing motel list');
        Wait_Message;
    end;
    Close(GuestFile);
end;

procedure SaveList;
(* Procedure to write guest list *)

var I : integer;

begin
  if Num_Guests > 0 then begin
    if Filename = '' (* Writing a new guest list? *)
    then begin
        write('Enter filename ');
        readln(Filename); writeln
    end;
    Assign(GuestFile,Filename);
    (*$I-*) Rewrite(GuestFile); (*$I+*)
    if IOresult = 0
    then begin
        Num_Guests := 0;
        for I := 1 TO MAX_ROOMS do begin
            write(GuestFile,Guest[I]);
            if NOT Guest[I].Empty then
                Num_Guests := Num_Guests + 1
        end
    end
    else begin
        writeln('Sorry cannot write to file ');
        Wait_Message;
    end;
    Close(GuestFile);
 end
end;


procedure AddList;
(* Procedure to add  a guest, if there is room *)

var Found : boolean;
    Room : integer;

begin
    if Num_Guests < MAX_ROOMS
    then begin
        (* Search for vacant room *)
        Found := FALSE;
        Room := 1;
        while (Room <= MAX_ROOMS) AND (NOT Found) do
            if Guest[Room].Empty
                then Found := TRUE
                else Room := Room + 1;

        (* Enter guest name *)
        Center_Text('******* Welcome to Logitel ******',1);
        writeln; writeln;
        with Guest[Room] do begin
            write('Name ? ');
            readln(Name);
            Empty := FALSE;
            Expenses := 0.;
        end;
        writeln;
        writeln('Your room number is ',Room);
        Wait_Message;
        Num_Guests := Num_Guests + 1;
    end
    else
        writeln('Sorry! We have no vacancies ')

end;

procedure FalseInfo(Room : integer);
(* Procedure to display warning message *)

begin
    writeln('---------------------------------');
    writeln('   This cannot be correct!');
    writeln('   There is no guest in room ',Room);
    writeln('   Please re-enter room number');
    writeln('---------------------------------');
    writeln
end;


procedure DelList;
(* Procedure to check out guest from motel *)

var Room : integer;
    OK : boolean;

begin
 if Num_Guests > 0 then
    repeat
        repeat
          write('Enter room number ');
          readln(Room); writeln;
        until (Room > 0) AND (Room <= MAX_ROOMS);
        OK := NOT Guest[Room].Empty;
        if OK
        then  begin
            with Guest[Room] do begin
              write(Name,' please pay $ ',Expenses);
              writeln;
              Empty := TRUE;
              Name := '';
              Expenses := 0.;
            end;
            Num_Guests  := Num_Guests - 1;
            Wait_Message
        end
        else FalseInfo(Room);
    until OK

  else begin
      writeln('Motel is empty!');
      Wait_Message;
  end
end;

procedure Charge;
(* Procedure to post charges to guests *)

var Room : integer;
    OK : boolean;
    New_Charge : real;

begin
 if Num_Guests > 0 then
    repeat
        repeat
          write('Enter room number ');
          readln(Room); writeln;
        until (Room > 0) AND (Room <= MAX_ROOMS);
        OK := NOT Guest[Room].Empty;
        if OK
        then  begin
            with Guest[Room] do begin
              write('Enter charge ');
              readln(New_Charge);
              Expenses := Expenses + New_Charge;
            end;
        end
        else FalseInfo(Room);
    until OK

  else begin
      writeln('Motel is empty!');
      Wait_Message;
  end
end;

procedure ViewList;
(* Procedure to lookup a particular guest *)

var Room : integer;

begin
    repeat
      write('Enter room number ');
      readln(Room); writeln;
    until (Room > 0) AND (Room <= MAX_ROOMS);
    with Guest[Room] do
        if Empty
        then
            writeln('Room ',Room,' is empty')
        else begin
            writeln('Room # ',Room,' information');
            writeln;
            writeln('        Guest : ',Name); writeln;
            writeln('        Expenses : $ ',Expenses);
            writeln
        end;

    Wait_Message;
end;


begin (*-------- M A I N -----------*)
  ClrScr;
  write('Start a new hotel list? (Y/N) ');
  readln(Answer);
  Filename := '';
  if UpCase(Answer) = 'Y' then Initialize
                          else ReadList;
  repeat
    repeat
        CLrScr;
        Center_Text('-------- Activity Menu ------- ',2);
        writeln; writeln;
        writeln('0) Quit'); writeln;
        writeln('1) Enter new guest name '); writeln;
        writeln('2) Check out guest name '); writeln;
        writeln('3) Add expenses to guest'); writeln;
        writeln('4) Lookup a room information'); writeln;
        writeln; writeln;
        write('Select by number ');
        readln(Choice); writeln;
    until (Choice >= 0) AND (Choice <= MAX_MENU);
    ClrScr;
    CASE Choice OF
        0 : SaveList;
        1 : AddList;
        2 : DelList;
        3 : Charge;
        4 : ViewList;
    end;
  until Choice = 0;
end.