Category : Pascal Source Code
Archive   : CLEMENT.ZIP
Filename : MENU1.INT

(*----------------------------------------------------------*)
(* Copyright (c) 1985, 1986 Namir CLement Shammas *)
(*----------------------------------------------------------*)

(*---------------------------------------- Menu1 ---------*)

PROCEDURE Menu1(VAR Menu_Option : MenuStrings; (* input *)
Num_Header, Num_Options : INTEGER; (* input *)
VAR Menu_Choice : INTEGER; (* output *)
Double_Spaced : BOOLEAN); (* input *)

CONST
HL = #205; VL = #186;
LUC = #201; LLC = #200;
RUC = #187; RLC = #188;
LT = #204; RT = #185;
LE = 1; RE = 78; (* Left and right edges *)

VAR S1, S2, Choice_Str : STRING80;
I, Row, Error_Code : INTEGER;
Entry_OK : BOOLEAN;

(*---------------------------------------- Menu1 \ Center_Message ---------*)

PROCEDURE Center_Message(VAR S : STRING80 (* in/out *));

VAR L, Spaces : INTEGER;

BEGIN
Spaces := ((RE - LE - 1) - Length(S)) DIV 2;
FOR L := 1 TO Spaces DO
S := ' ' + S;
END; (* Center_Message *)

(*---------------------------------------- Menu1 \ Empty_Edges ---------*)

PROCEDURE Empty_Edges;

BEGIN
DISP_CHR(VL,Row,LE); DISP_CHR(VL,Row,RE); INC(Row);
END; (* Empty_Edges *)

(*---------------------------------------- Menu1 \ Convert ---------*)

FUNCTION Convert(VAR Strr : STRING80 (* input *)) : BOOLEAN;
(* Function to verify that Strr is a correct image of an integer *)

CONST BEEP = ^G;

VAR I, L : INTEGER;
OK : BOOLEAN;

BEGIN
OK := TRUE;
I := 1;
L := Length(Strr);
WHILE (I <= L) AND OK DO BEGIN

CASE Strr[I] OF
' ' : Delete(Strr,I,1);
'0'..'9' : (* do nothing *);
ELSE OK := FALSE;
END; (* CASE *)

I := I + 1;

END; (* WHILE *)

IF NOT OK THEN WRITE(BEEP);
Convert := OK

END; (* Convert *)

(*-------------------------------------------------------------*)

BEGIN
S1 := HL;
FOR I := 2 TO (RE - LE - 1) DO S1 := S1 + HL;

(* Row 1 *)
Row := 1;
S2 := LUC + S1 + RUC; DISP_STR(S2,Row,LE); INC(Row);
FOR I := 1 TO Num_Header DO BEGIN
IF Double_Spaced THEN Empty_Edges;
S2 := Menu_Option[I];
Center_Message(S2);
S2 := VL + S2;
DISP_STR(S2,Row,LE); DISP_CHR(VL,Row,RE); INC(Row);
END;
IF Double_Spaced THEN Empty_Edges;

(* Draw internal bar *)
S2 := LT + S1 + RT; DISP_STR(S2,Row,LE); INC(Row);

FOR I := (1 + Num_Header) TO (Num_Options + Num_Header) DO BEGIN
IF Double_Spaced THEN Empty_Edges;
S2 := VL + Menu_Option[I];
DISP_STR(S2,Row,LE); DISP_CHR(VL,Row,RE); INC(Row);
END;

IF Double_Spaced THEN Empty_Edges;

(* Draw bottom frame *)
S2 := LLC + S1 + RLC; DISP_STR(S2,Row,LE); INC(Row);

INC(Row);

S2 := 'Enter choice by number ';
DISP_STR(S2,Row,LE);
REPEAT
GOTOXY(Length(S2)+1,Row); ClrEol;
READLN(Choice_Str); WRITELN; WRITELN;
IF Convert(Choice_Str)
THEN BEGIN
Entry_OK := TRUE;
Val(Choice_Str, Menu_Choice, Error_Code)
END
ELSE BEGIN
Entry_OK := FALSE;
Error_Code := 1
END;
UNTIL Entry_OK AND (Error_Code = 0);
END; (* Menu1 *)