home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MMSRC.ZIP
/
MENUMGR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-03-13
|
47KB
|
1,285 lines
PROGRAM Menu_Manager;
USES
DOS, { standard turbo unit }
CRT, { standard turbo unit }
SYSUTIL, { system type routines }
QWIK, { screen i/o routines }
QWIKUTIL, { supplemental QWIK routines }
STRUTIL, { string handling routines }
IOUTIL, { bullet-proof user input routines }
MMUTILS; { menu manager utilities }
CONST
Shade = '░'; { ░▒▓ }
F1 = 59; { standard F1 key }
F4 = 62; { standard F4 key }
Prg_Owner = 'ShareWare'; { custom program owner }
Prg_Title = ' SW MENU MANAGER '; { custom program title }
Max_Nbr_Opts = 13; { maximum number of options per menu }
Max_Opt_Len = 30; { maximum option length }
Menu_Delim = ';'; { menu parameter delimiter }
Opt_Delim = ','; { option parameter delimiter }
TYPE
Str8 = STRING[8];
Str12 = STRING[12];
Str55 = STRING[55];
Opt_Str = STRING[Max_Opt_Len];
Opt_Types = (Batch,Delim,Menu);
Status_Types = (Used,Unused);
Opt_Rec = RECORD
Opt_Type : Opt_Types;
Select_Key : CHAR;
Opt_Name : Opt_Str;
Prg_Dir : Str55;
Prg_Name : Str12;
Parms : Str55;
Bat_Name : Str8;
Password : Str8;
Pause : BOOLEAN;
Prompts : BOOLEAN;
END;
Menu_Ptr = ^Menu_Rec;
Menu_Rec = RECORD
Menu_Name : Opt_Str;
Row,Col : BYTE;
Opts : ARRAY [1..Max_Nbr_Opts] OF Opt_Rec;
Exit_Menu_Name : Opt_Str;
Cur_Opt_Row : BYTE;
Menu_Scr_Ptr : POINTER;
Next_Menu_Ptr : Menu_Ptr;
Menu_Status : Status_Types;
END;
VAR
IO_Error : INTEGER; { global IORESULT value }
Head_Menu_Ptr : Menu_Ptr; { pointer to first menu }
Config : Opt_Str; { hardware description }
Config2 : Opt_Str; { monitor/card description }
Config3 : Opt_Str; { screen dimensions description }
Date_Time_Toggle : BOOLEAN; { show date and time toggle }
Help_Toggle : BOOLEAN; { show help toggle }
Header_Toggle : BOOLEAN; { show header toggle }
Changes : BOOLEAN; { any menu changes ? }
Env_Changes : BOOLEAN; { any environment changes ? }
fgMenu,bgMenu : ARRAY [1..16] OF BYTE; { menu colors }
fgTitl,bgTitl : ARRAY [1..16] OF BYTE; { menu title colors }
fgMain,bgMain, { main screen attribute colors }
fgCmnd,bgCmnd, { command line attribute colors }
fgName,bgName, { program name attribute colors }
fgHOpt,bgHOpt, { all highlighted options }
fgSlct,bgSlct, { all quick select keys }
fgHelp,bgHelp, { help message boxes }
fgNErr,bgNErr, { normal error message boxes }
fgNote,bgNote, { note message boxes }
fgFErr,bgFErr, { fatal error message boxes }
fgWarn,bgWarn, { warning message boxes }
fgInpt,bgInpt : BYTE; { all input fields }
{$I INIT_MENU_MANAGER.PAS }
{$I BLD_MENU_LIST.PAS }
PROCEDURE Show_Date_And_Time;
BEGIN
QWrite (1,CRTcols-15,-1,CSDS);
QWrite (1,CRTcols-30,-1,CSTS);
END;
PROCEDURE Show_Header_Bar;
BEGIN
QFill (1,LENGTH(Prg_Title)+1,1,CRTcols-LENGTH(Prg_Title),fgCmnd+bgCmnd,' ');
QWrite (1,1,fgName+bgName,Prg_Title);
END;
PROCEDURE Erase_Header_Bar;
BEGIN
QFill (1,1,1,CRTcols,fgMain+bgMain,Shade);
END;
PROCEDURE Init_Scr (fgMain,bgMain : INTEGER);
BEGIN
QFill (1,1,CRTrows,CRTcols,fgMain+bgMain,Shade);
IF Header_Toggle THEN
Show_Header_Bar;
END;
PROCEDURE Show_About_Msg;
VAR Col,Sec_Trigger : BYTE;
ScrPtr : POINTER;
c : CHAR;
Extended : BOOLEAN;
Hour,Minute,Second,Sec100 : WORD;
BEGIN
IF ParamCount > 0 THEN { must be returning from a batch call }
EXIT;
Col := (CRTcols - 37) DIV 2 + 1;
Save_Scr (5,Col,16,39,ScrPtr);
Draw_Box (5,Col,15,37,fgNote+bgNote,Double,-1,Shade,fgMain+bgMain-8);
QWrite (7,Col+1,LightMagenta+bgNote,Justify(Prg_Owner,Center,35,' '));
QWrite (8,Col+7,fgNErr+bgNote,'M E N U M A N A G E R');
QWrite (9,Col+12,fgNErr+bgNote,'Version 1.1.0');
QWrite (10,Col+14,fgNErr+bgNote,'6-Dec-88');
QWrite (12,Col+9,fgNErr+bgNote,'Copyright (c) 1989');
QWrite (13,Col+5,fgNErr+bgNote,'Creative Software Solutions');
QWrite (15,Col+1,fgNErr+bgNote,Justify(Config,Center,35,' '));
QWrite (16,Col+1,fgNErr+bgNote,Justify(Config2,Center,35,' '));
QWrite (17,Col+1,fgNErr+bgNote,Justify(Config3,Center,35,' '));
GetTime (Hour,Minute,Second,Sec100);
IF Second > 54 THEN
Sec_Trigger := Second + 6 - 60
ELSE
Sec_Trigger := Second + 6;
REPEAT
GetTime (Hour,Minute,Second,Sec100);
IF Date_Time_Toggle THEN
Show_Date_And_Time;
UNTIL KeyPressed OR (Second = Sec_Trigger);
IF KeyPressed THEN { read the key in, just to clear the buffer }
Wait_For_Key (c,Extended);
Show_Scr (5,Col,16,39,ScrPtr);
END;
PROCEDURE Manage_Menus;
VAR Cur_Menu_Ptr,Temp_Menu_Ptr : Menu_Ptr;
Batch_File,User_Batch_File : TEXT;
c : CHAR;
Extended,Option_Selected,Menu_Selected,Abort,Save_Scr_Ptr : BOOLEAN;
y,Old_y,x,Help_Row,Help_Col,Help_Rows,Help_Cols,Menu_Idx,i : BYTE;
Menu_Nbr,Last_Menu_Nbr : WORD;
Help_Scr_Ptr : POINTER;
Cur_Dir,Opt_Parms : STRING;
Saved_Opt : Opt_Rec; { hold buffer for cutting and pasting }
FUNCTION Get_Help_Row (Cur_Menu_Ptr : Menu_Ptr) : BYTE;
BEGIN
IF Cur_Menu_Ptr^.Row < 5 THEN { help goes on bottom half of screen with buffer }
Get_Help_Row := 19
ELSE
IF Cur_Menu_Ptr^.Row IN [5,6] THEN { help goes on bottom half of screen with no buffer }
Get_Help_Row := 20
ELSE
IF Header_Toggle THEN { we've got one less line to use }
IF Cur_Menu_Ptr^.Row > 8 THEN { help goes on top half of screen with buffer }
Get_Help_Row := 3
ELSE { help goes on top half of screen with no buffer }
Get_Help_Row := 2
ELSE
IF Cur_Menu_Ptr^.Row > 7 THEN { help goes on top half of screen with buffer }
Get_Help_Row := 2
ELSE
IF Cur_Menu_Ptr^.Row = 7 THEN { help goes on top half of screen with no buffer }
Get_Help_Row := 1;
END;
FUNCTION Opt_Question (Qst_Title,Qst_Str : STRING; Help_Nbr,Help_Row,Help_Col : BYTE) : BYTE;
CONST Return = #13;
Escape = #27;
Start_Row = 7;
VAR Opt_Nbr,Col,Qst_Str_Len : BYTE;
Done,Extended : BOOLEAN;
Qst_Scr_Ptr : POINTER;
c : CHAR;
BEGIN
IF Help_Toggle THEN
Erase_Help;
IF Scan(Qst_Str,Forwards,EQ,'[') = LENGTH(Qst_Str) THEN { there are no choices }
Qst_Str := CONCAT(Qst_Str,' ? [YES] [NO]');
Col := ((CRTcols-(LENGTH(Qst_Str)+4))DIV 2)+1;
Qst_Str_Len := LENGTH(Qst_Str);
Save_Scr (Start_Row,Col,5,Qst_Str_Len+4,Qst_Scr_Ptr);
Draw_Box (Start_Row,Col,4,Qst_Str_Len+2,Black+bgNote,No_Border,-1,Shade,fgMain+bgMain-8);
QWrite (Start_Row,Col,(bgNote DIV 16)+bBlack+8,Justify(Qst_Title,Center,Qst_Str_Len+2,' '));
QWrite (Start_Row+2,Col+1,fgNote+bgNote,Qst_Str);
IF Help_Toggle THEN
Show_Help (Help_Nbr,Help_Row,Help_Col,fgHelp+bgHelp);
Sound_Bell;
Opt_Nbr := 1;
Done := FALSE;
REPEAT
HSelect (Start_Row+2,Col+1,0,fgInpt+bgInpt,Opt_Nbr,'[',']',c,Extended);
IF Extended THEN
CASE ORD(c) OF
F1 : BEGIN
Help_Toggle := NOT Help_Toggle;
Env_Changes := TRUE;
IF Help_Toggle THEN
Show_Help (Help_Nbr,Help_Row,Help_Col,fgHelp+bgHelp)
ELSE
Erase_Help;
END;
61 : Done := TRUE;
ELSE
Sound_Bell;
END
ELSE
IF c IN [Return,Escape] THEN
Done := TRUE
ELSE
Sound_Bell;
UNTIL Done;
IF c = Return THEN
Opt_Question := Opt_Nbr
ELSE
Opt_Question := 0;
IF Help_Toggle THEN
Erase_Help;
Show_Scr (Start_Row,Col,5,Qst_Str_Len+4,Qst_Scr_Ptr);
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp);
END;
FUNCTION Str_Question (Qst_Title,Qst_Str : STRING; Help_Nbr,Help_Row,Help_Col : BYTE;
VAR Reply : STRING; Inp_Chr_Type : BOOLEAN) : BOOLEAN;
CONST Null = #0;
Return = #13;
Escape = #27;
Start_Row = 7;
VAR Done,Extended : BOOLEAN;
Qst_Scr_Ptr : POINTER;
c : CHAR;
Col,Qst_Str_Len,Start_Inp_Fld_Col,Inp_Fld_Len : Byte;
Def_Inp_Str : STRING;
BEGIN
Str_Question := FALSE;
IF Help_Toggle THEN
Erase_Help;
Qst_Str_Len := LENGTH(Qst_Str);
Col := ((CRTcols-(Qst_Str_Len+4))DIV 2)+1;
Save_Scr (Start_Row,Col,5,Qst_Str_Len+4,Qst_Scr_Ptr);
Draw_Box (Start_Row,Col,4,Qst_Str_Len+2,Black+bgNote,No_Border,-1,Shade,fgMain+bgMain-8);
QWrite (Start_Row,Col,(bgNote DIV 16)+bBlack+8,Justify(Qst_Title,Center,Qst_Str_Len+2,' '));
QWrite (Start_Row+2,Col+1,fgNote+bgNote,Qst_Str);
IF Help_Toggle THEN
Show_Help (Help_Nbr,Help_Row,Help_Col,fgHelp+bgHelp);
Start_Inp_Fld_Col := Scan(Qst_Str,Forwards,EQ,'[') + 2;
Inp_Fld_Len := Scan(Qst_Str,Forwards,EQ,']') - Start_Inp_Fld_Col + 1;
Def_Inp_Str := Reply;
Sound_Bell;
Done := FALSE;
REPEAT
QWrite (Start_Row+2,Col+Start_Inp_Fld_Col,-1,Justify(Def_Inp_Str,Left,Inp_Fld_Len,' '));
Input (Inp_Fld_Len,Start_Row+2,Col+Start_Inp_Fld_Col,fgInpt+bgInpt,Reply,c,Extended,Inp_Chr_Type);
IF Extended THEN
CASE ORD(c) OF
F1 : BEGIN
Help_Toggle := NOT Help_Toggle;
Env_Changes := TRUE;
IF Help_Toggle THEN
Show_Help (Help_Nbr,Help_Row,Help_Col,fgHelp+bgHelp)
ELSE
Erase_Help;
END;
61 : Done := TRUE;
ELSE
Sound_Bell;
END
ELSE
IF c = Null THEN
BEGIN
Str_Question := TRUE;
Done := TRUE;
END
ELSE
IF c IN [Return,Escape] THEN
Done := TRUE
ELSE
Sound_Bell;
UNTIL Done;
IF Help_Toggle THEN
Erase_Help;
Show_Scr (Start_Row,Col,5,Qst_Str_Len+4,Qst_Scr_Ptr);
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp); { menu help }
END;
PROCEDURE Init_Menu (VAR Temp_Menu_Ptr : Menu_Ptr; Name : STRING; y,x : BYTE);
BEGIN
NEW (Temp_Menu_Ptr);
WITH Temp_Menu_Ptr^ DO
BEGIN
Menu_Name := Name;
Row := y;
Col := x;
FILLCHAR (Opts,SIZEOF(Opts),CHR(0));
Exit_Menu_Name := ''; { will modify dynamically }
Cur_Opt_Row := 0; { will modify dynamically }
Menu_Scr_Ptr := NIL;
Next_Menu_Ptr := NIL;
END;
END;
PROCEDURE Show_Menu (VAR Cur_Menu_Ptr : Menu_Ptr);
VAR i : BYTE;
BEGIN
WITH Cur_Menu_Ptr^ DO
BEGIN
Save_Scr (Row,Col,Max_Nbr_Opts+2,Max_Opt_Len+8,Menu_Scr_Ptr);
Draw_Box (Row,Col,Max_Nbr_Opts+1,Max_Opt_Len+6,fgMenu[Menu_Idx]+bgMenu[Menu_Idx],No_Border,-1,Shade,
fgMain+bgMain-8);
QWrite (Row,Col,fgTitl[Menu_Idx]+bgTitl[Menu_Idx],Justify(Menu_Name,Center,Max_Opt_Len+6,' '));
FOR i := 1 TO Max_Nbr_Opts DO
WITH Opts[i] DO
IF Opt_Type = Delim THEN
QWrite (Row+i,Col+1,-1,Justify(Strip(Opt_Name,Ends,EQ,' '),Center,Max_Opt_Len+4,'─'))
ELSE
QWrite (Row+i,Col+1,-1,CONCAT(Select_Key,' ',Opt_Name));
END;
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp); { menu help }
END;
PROCEDURE Rename_Menu;
VAR Temp_Menu_Ptr : Menu_Ptr;
Reply : STRING;
i : Byte;
Done : BOOLEAN;
BEGIN
Done := FALSE;
REPEAT
Reply := Cur_Menu_Ptr^.Menu_Name;
IF Str_Question('Rename Menu',CONCAT('Menu name ? [',Make_String(Max_Opt_Len,' '),']'),2,13,3,Reply,Visible_Chrs) THEN
BEGIN
Temp_Menu_Ptr := Head_Menu_Ptr;
WHILE (Temp_Menu_Ptr^.Menu_Name <> Reply) AND
(Temp_Menu_Ptr^.Next_Menu_Ptr <> NIL) DO
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
IF Temp_Menu_Ptr^.Menu_Name = Reply THEN
Show_Error (4,9,9,fgNErr+bgNErr) { DUPLICATE MENU NAME }
ELSE
BEGIN
Done := TRUE;
Changes := TRUE;
Temp_Menu_Ptr := Head_Menu_Ptr;
REPEAT
FOR i := 1 TO Max_Nbr_Opts DO
WITH Temp_Menu_Ptr^.Opts[i] DO
IF (Opt_Type = Menu) AND
(Opt_Name = Cur_Menu_Ptr^.Menu_Name) THEN
Opt_Name := Reply;
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
UNTIL Temp_Menu_Ptr = NIL;
Cur_Menu_Ptr^.Menu_Name := Reply;
WITH Cur_Menu_Ptr^ DO
QWrite (Row,Col,fgTitl[Menu_Idx]+bgTitl[Menu_Idx],Justify(Menu_Name,Center,Max_Opt_Len+6,' '));
END;
END
ELSE
Done := TRUE;
UNTIL Done;
END;
PROCEDURE Change_Time;
VAR Done : BOOLEAN;
Reply : STRING;
Hour,Minute,Second,Sec100 : WORD;
FUNCTION Valid_Time (s : STRING; VAR Hour,Minute,Second : WORD) : BOOLEAN;
VAR i,Fld_Cnt : BYTE;
Error : INTEGER;
Fld : STRING;
Delim : CHAR;
Hour2,Minute2,Second2 : WORD;
BEGIN
Valid_Time := FALSE;
s := CONCAT(s,':');
IF LENGTH(s) < 2 THEN
EXIT;
Fld := '';
Fld_Cnt := 0;
FOR i := 1 TO LENGTH(s) DO
IF s[i] IN ['0'..'9'] THEN
Fld := CONCAT(Fld,s[i])
ELSE
BEGIN
Fld_Cnt := Fld_Cnt + 1;
CASE Fld_Cnt OF
1 : VAL (Fld,Hour2,Error);
2 : VAL (Fld,Minute2,Error);
3 : VAL (Fld,Second2,Error);
ELSE
EXIT;
END;
Fld := '';
END;
IF Fld_Cnt < 3 THEN
EXIT;
IF (Hour2 < 0) OR (Hour2 > 23) THEN
EXIT;
IF (Minute2 < 0) OR (Minute2 > 59) THEN
EXIT;
IF (Second2 < 0) OR (Second2 > 59) THEN
EXIT;
Hour := Hour2;
Minute := Minute2;
Second := Second2;
Valid_Time := TRUE;
END;
BEGIN { Change_Time }
GetTime (Hour,Minute,Second,Sec100);
Done := FALSE;
REPEAT
Reply := CONCAT(Justify(CIS(Hour),Right,2,'0'),':',
Justify(CIS(Minute),Right,2,'0'),':',Justify(CIS(Second),Right,2,'0'));
IF Str_Question('Change Time',CONCAT('System time ? [',Reply,']'),4,14,3,Reply,Visible_Chrs) THEN
IF Valid_Time(Reply,Hour,Minute,Second) THEN
BEGIN
SetTime (Hour,Minute,Second,0);
Done := TRUE;
END
ELSE
Show_Error (2,9,9,fgNErr+bgNErr) { INVALID TIME FORMAT }
ELSE
Done := TRUE;
UNTIL Done;
END;
PROCEDURE Swap_Options (Cur_Row : BYTE) ;
CONST Return = #13;
Escape = #27;
Null = #0;
VAR Done,Extended,Abort : BOOLEAN;
Old_Row,New_Row : BYTE;
c : CHAR;
Cur_Opt,AttrStr,s : STRING;
Temp_Opt : Opt_Rec;
PROCEDURE Show_Brackets (Row,Attr : BYTE);
BEGIN
QWrite (Row,Cur_Menu_Ptr^.Col,Attr,CHR(16));
QWrite (Row,Cur_Menu_Ptr^.Col+Max_Opt_Len+5,Attr,CHR(17));
END;
PROCEDURE Erase_Brackets (Row : BYTE);
BEGIN
QWrite (Row,Cur_Menu_Ptr^.Col,fgMenu[Menu_Idx]+bgMenu[Menu_Idx],' ');
QWrite (Row,Cur_Menu_Ptr^.Col+Max_Opt_Len+5,fgMenu[Menu_Idx]+bgMenu[Menu_Idx],' ');
END;
BEGIN { Swap_Options }
IF Help_Toggle THEN
Erase_Help;
IF Help_Toggle THEN
Show_Help (6,Get_Help_Row(Cur_Menu_Ptr),2,fgHelp+bgHelp); { swap help }
Abort := FALSE;
Done := FALSE;
New_Row := Cur_Row;
Old_Row := New_Row;
Get_Scr_Str (Cur_Row,Cur_Menu_Ptr^.Col+1,Max_Opt_Len+4,Cur_Opt,AttrStr);
QAttr (Cur_Row,Cur_Menu_Ptr^.Col+1,1,Max_Opt_Len+4,fgHOpt+bgHOpt);
Show_Brackets (Cur_Row,fgHOpt+bgHOpt);
WITH Cur_Menu_Ptr^ DO
BEGIN
REPEAT
IF New_Row <> Old_Row THEN
BEGIN
Get_Scr_Str (Cur_Row,Col+1,Max_Opt_Len+4,s,AttrStr);
QWrite (Old_Row,Col+1,fgMenu[Menu_Idx]+bgMenu[Menu_Idx],s);
Erase_Brackets (Old_Row);
Get_Scr_Str (New_Row,Col+1,Max_Opt_Len+4,s,AttrStr);
QWrite (Cur_Row,Col+1,fgHOpt+bgHOpt+Blink,s);
{ could turn on the Cur_Row brackets here... }
QWrite (New_Row,Col+1,fgHOpt+bgHOpt,Cur_Opt);
Show_Brackets (New_Row,fgHOpt+bgHOpt);
Old_Row := New_Row;
END;
REPEAT
IF Date_Time_Toggle THEN
Show_Date_And_Time;
UNTIL KeyPressed;
Wait_For_Key (c,Extended);
IF Extended THEN
CASE ORD(c) OF
F1 : BEGIN { F1 - help toggle }
Help_Toggle := NOT Help_Toggle;
Env_Changes := TRUE;
IF Help_Toggle THEN
Show_Help (6,Get_Help_Row(Cur_Menu_Ptr),2,fgHelp+bgHelp) { swap help }
ELSE
Erase_Help;
END;
61 : Abort := TRUE; { F3 - exit }
72, { left-arrow }
75 : IF New_Row > Row+1 THEN { up-arrow }
New_Row := New_Row - 1
ELSE
New_Row := Row + Max_Nbr_Opts;
77, { right-arrow }
80 : IF New_Row < Row+Max_Nbr_Opts THEN { down-arrow }
New_Row := New_Row + 1
ELSE
New_Row := Row + 1;
71 : New_Row := Row + 1; { home }
79 : New_Row := Row + Max_Nbr_Opts; { end }
ELSE
Sound_Bell;
END
ELSE
CASE ORD(c) OF
13 : Done := TRUE; { enter }
27 : Abort := TRUE; { escape }
ELSE { any other non-extended key }
Sound_Bell;
END;
UNTIL Done OR Abort;
Erase_Brackets (Cur_Row);
Erase_Brackets (New_Row);
IF Done THEN { we may have a valid swap }
BEGIN
IF New_Row <> Cur_Row THEN
BEGIN
Changes := TRUE;
Temp_Opt := Opts[New_Row-Row];
Opts[New_Row-Row] := Opts[Cur_Row-Row];
Opts[Cur_Row-Row] := Temp_Opt;
QAttr (Cur_Row,Col+1,1,Max_Opt_Len+4,fgHOpt+bgHOpt);
QAttr (New_Row,Col+1,1,Max_Opt_Len+4,fgMenu[Menu_Idx]+bgMenu[Menu_Idx]);
END;
END
ELSE
BEGIN
Get_Scr_Str (Cur_Row,Col+1,Max_Opt_Len+4,s,AttrStr);
QWrite (New_Row,Col+1,fgMenu[Menu_Idx]+bgMenu[Menu_Idx],s);
QWrite (Cur_Row,Col+1,fgHOpt+bgHOpt,Cur_Opt);
END;
END;
IF Help_Toggle THEN
Erase_Help;
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp); { menu help }
END;
PROCEDURE Change_Date;
CONST Return = #13;
Escape = #27;
Null = #0;
VAR Done,Extended : BOOLEAN;
Date_Scr_Ptr : POINTER;
Reply : STRING;
c : CHAR;
Year,Month,Day,DayofWeek : WORD;
FUNCTION Valid_Date (s : STRING; VAR Month,Day,Year : WORD) : BOOLEAN;
VAR i,Fld_Cnt : BYTE;
Error : INTEGER;
Fld : STRING;
Delim : CHAR;
Month2,Day2,Year2 : WORD;
BEGIN
Valid_Date := FALSE;
IF LENGTH(s) < 2 THEN
EXIT;
s := CONCAT(s,'/');
Fld := '';
Fld_Cnt := 0;
FOR i := 1 TO LENGTH(s) DO
IF s[i] IN ['0'..'9'] THEN
Fld := CONCAT(Fld,s[i])
ELSE
BEGIN
Fld_Cnt := Fld_Cnt + 1;
CASE Fld_Cnt OF
1 : VAL (Fld,Month2,Error);
2 : VAL (Fld,Day2,Error);
3 : VAL (Fld,Year2,Error);
ELSE
EXIT;
END;
Fld := '';
END;
IF Fld_Cnt < 3 THEN
EXIT;
IF (Month2 < 1) OR (Month2 > 12) THEN
EXIT;
IF (Day2 < 1) OR (Day2 > 31) THEN
EXIT;
IF (Year2 < 0) OR (Year2 > 99) THEN
EXIT;
Month := Month2;
Day := Day2;
Year := Year2;
Valid_Date := TRUE;
END;
BEGIN { Change_Date }
GetDate (Year,Month,Day,DayofWeek);
Done := FALSE;
REPEAT
Reply := CONCAT(Justify(CIS(Month),Right,2,'0'),'/',
Justify(CIS(Day),Right,2,'0'),'/',Justify(CIS(Year-1900),Right,2,'0'));
IF Str_Question('Change Date',CONCAT('System date ? [',Reply,']'),3,14,3,Reply,Visible_Chrs) THEN
IF Valid_Date(Reply,Month,Day,Year) THEN
BEGIN
SetDate (Year+1900,Month,Day);
Done := TRUE;
END
ELSE
Show_Error (3,9,9,fgNErr+bgNErr) { INVALID DATE FORMAT }
ELSE
Done := TRUE;
UNTIL Done;
END;
{$I SETTINGS_EDITOR.PAS }
FUNCTION Chk_Password (Opt_Password : STRING) : BOOLEAN;
VAR Done : BOOLEAN;
Reply : STRING;
BEGIN
IF LENGTH(Opt_Password) = 0 THEN
BEGIN
Chk_Password := TRUE;
EXIT;
END;
Chk_Password := FALSE;
Done := FALSE;
REPEAT
Reply := Make_String(8,' ');
IF Str_Question('Password','Enter Option Password (it will not show on screen) [ ]',
9,13,3,Reply,Invisible_Chrs) THEN
IF Reply = Opt_Password THEN
BEGIN
Chk_Password := TRUE;
Done := TRUE;
END
ELSE
Show_Error (5,8,9,fgNErr+bgNErr) { INCORRECT PASSWORD }
ELSE
Done := TRUE;
UNTIL Done;
END;
{$I OPTION_EDITOR.PAS }
PROCEDURE Erase_Menu (Cur_Menu_Ptr : Menu_Ptr);
BEGIN
IF Help_Toggle THEN
Erase_Help;
WITH Cur_Menu_Ptr^ DO
Show_Scr (Row,Col,Max_Nbr_Opts+2,Max_Opt_Len+8,Menu_Scr_Ptr);
END;
PROCEDURE Add_Menu (Temp_Menu_Ptr : Menu_Ptr);
VAR Last_Menu_Ptr : Menu_Ptr;
BEGIN
Last_Menu_Ptr := Head_Menu_Ptr;
WHILE Last_Menu_Ptr^.Next_Menu_Ptr <> NIL DO
Last_Menu_Ptr := Last_Menu_Ptr^.Next_Menu_Ptr;
Last_Menu_Ptr^.Next_Menu_Ptr := Temp_Menu_Ptr;
END;
PROCEDURE Set_Help;
BEGIN
Help_Toggle := NOT Help_Toggle;
Env_Changes := TRUE;
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp) { menu help }
ELSE
Erase_Help;
END;
PROCEDURE Set_Exit (VAR Cur_Menu_Ptr : Menu_Ptr);
VAR i : BYTE;
BEGIN
IF Menu_Nbr > 1 THEN { can exit current menu }
WITH Cur_Menu_Ptr^ DO
BEGIN
Temp_Menu_Ptr := Head_Menu_Ptr; { previous menu is before }
WHILE (Temp_Menu_Ptr^.Next_Menu_Ptr <> NIL) AND
(Temp_Menu_Ptr^.Menu_Name <> Exit_Menu_Name) DO
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
IF Temp_Menu_Ptr^.Menu_Name = Exit_Menu_Name THEN { found the named menu }
BEGIN
Exit_Menu_Name := ''; { reset the current exit pointer }
Cur_Opt_Row := 0; { reset the row pointer }
Erase_Menu (Cur_Menu_Ptr);
Cur_Menu_Ptr := Temp_Menu_Ptr;
Menu_Selected := TRUE;
Last_Menu_Nbr := Menu_Nbr;
Menu_Nbr := Menu_Nbr - 1;
Menu_Idx := Menu_Nbr MOD 16;
IF Header_Toggle THEN
WITH Cur_Menu_Ptr^ DO
IF Row = 1 THEN { have an overlap problem; need to adjust starting menu row }
BEGIN
Erase_Header_Bar;
Erase_Menu (Cur_Menu_Ptr);
Changes := TRUE;
Row := Row + 1;
Show_Menu (Cur_Menu_Ptr);
IF Cur_Opt_Row > 0 THEN
Cur_Opt_Row := Cur_Opt_Row + 1;
Show_Header_Bar;
END;
IF Help_Toggle THEN
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp);
END
ELSE
Show_Fatal (10,7,20,fgFErr+bgFErr); { fatal error of some sort }
END
ELSE { may want to exit to dos... }
BEGIN
i := Opt_Question('Quit Menu Manager','Are you sure you want to quit and return to DOS',1,14,14);
IF i IN [0,2] THEN
Abort := FALSE
ELSE
Abort := TRUE;
END;
END;
PROCEDURE Set_Header (VAR Cur_Menu_Ptr : Menu_Ptr);
BEGIN
Header_Toggle := NOT Header_Toggle;
Env_Changes := TRUE;
WITH Cur_Menu_Ptr^ DO
IF Header_Toggle THEN
BEGIN
IF Row = 1 THEN
BEGIN
Changes := TRUE;
Erase_Menu (Cur_Menu_Ptr);
Row := Row + 1;
Show_Menu (Cur_Menu_Ptr);
y := y + 1;
Old_y := Old_y + 1;
END;
Date_Time_Toggle := TRUE;
Show_Header_Bar;
END
ELSE
BEGIN
Date_Time_Toggle := FALSE; { force date and time off }
Erase_Header_Bar;
IF Help_Toggle THEN
BEGIN
Erase_Help;
Show_Help (0,Get_Help_Row(Cur_Menu_Ptr),3,fgHelp+bgHelp);
END;
END;
END;
PROCEDURE Set_Date_Time;
BEGIN
IF NOT(Header_Toggle) AND NOT(Date_Time_Toggle) THEN
BEGIN
Sound_Bell;
(* error message? *)
EXIT;
END;
Date_Time_Toggle := NOT Date_Time_Toggle;
Env_Changes := TRUE;
IF NOT Date_Time_Toggle THEN
QWrite (1,CRTcols-30,-1,Make_String(CRTcols-(CRTcols-30)+1,' '));
END;
PROCEDURE Up_Arrow (VAR y : BYTE);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF y > Row+1 THEN
y := y - 1
ELSE
y := Row + Max_Nbr_Opts;
END;
PROCEDURE Down_Arrow (VAR y : BYTE);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF y < Row+Max_Nbr_Opts THEN
y := y + 1
ELSE
y := Row + 1;
END;
PROCEDURE Move_Menu_Left (VAR Cur_Menu_Ptr : Menu_Ptr);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF Col > 1 THEN { ctrl-left-arrow }
BEGIN
Erase_Menu (Cur_Menu_Ptr);
Col := Col - 1;
Changes := TRUE;
Show_Menu (Cur_Menu_Ptr);
END;
END;
PROCEDURE Move_Menu_Right (VAR Cur_Menu_Ptr : Menu_Ptr);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF Col < CRTcols-(Max_Opt_Len+8)+1 THEN { ctrl-right-arrow }
BEGIN
Erase_Menu (Cur_Menu_Ptr);
Col := Col + 1;
Changes := TRUE;
Show_Menu (Cur_Menu_Ptr);
END;
END;
PROCEDURE Move_Menu_Down (VAR Cur_Menu_Ptr : Menu_Ptr);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF Row < CRTrows-(Max_Nbr_Opts+1) THEN { ctrl-pgdn }
BEGIN
Erase_Menu (Cur_Menu_Ptr);
Row := Row + 1;
Changes := TRUE;
Show_Menu (Cur_Menu_Ptr);
y := y + 1;
Old_y := Old_y + 1;
END;
END;
PROCEDURE Move_Menu_Up (VAR Cur_Menu_Ptr : Menu_Ptr);
BEGIN
WITH Cur_Menu_Ptr^ DO
IF (Header_Toggle AND (Row > 2)) OR
(NOT(Header_Toggle) AND (Row > 1)) THEN
BEGIN
Erase_Menu (Cur_Menu_Ptr);
Row := Row - 1;
Changes := TRUE;
Show_Menu (Cur_Menu_Ptr);
y := y - 1;
Old_y := Old_y - 1;
END;
END;
PROCEDURE Chk_Enter (VAR Cur_Menu_Ptr : Menu_Ptr);
VAR Temp_Menu_Ptr : Menu_Ptr;
BEGIN
WITH Cur_Menu_Ptr^ DO
WITH Opts[y-Row] DO
CASE Opt_Type OF
Batch : BEGIN
IF LENGTH(Opt_Name) = 0 THEN
IF y < Row+Max_Nbr_Opts THEN { right-arrow/down-arrow keys }
y := y + 1
ELSE
y := Row + 1
ELSE
IF Chk_Password(Password) THEN
Option_Selected := TRUE;
END;
Delim : BEGIN
IF y < Row+Max_Nbr_Opts THEN { right-arrow/down-arrow keys }
y := y + 1
ELSE
y := Row + 1;
END;
Menu : BEGIN { get the menu... }
{ de-select the option }
QAttr (y,Col+1,1,Max_Opt_Len+4,fgMenu[Menu_Idx]+bgMenu[Menu_Idx]);
Temp_Menu_Ptr := Cur_Menu_Ptr;
REPEAT
IF Temp_Menu_Ptr^.Next_Menu_Ptr = NIL THEN
Temp_Menu_Ptr := Head_Menu_Ptr
ELSE
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
UNTIL (Temp_Menu_Ptr^.Menu_Name = Opt_Name) OR
(Temp_Menu_Ptr = Cur_Menu_Ptr);
IF Temp_Menu_Ptr^.Menu_Name = Opt_Name THEN { found the menu }
IF LENGTH(Temp_Menu_Ptr^.Exit_Menu_Name) > 0 THEN { menu is already in use }
Show_Error (7,8,8,fgNErr+bgNErr) { MENU ALREADY IN USE }
ELSE { set the new menu }
BEGIN
IF Chk_Password(Password) THEN
BEGIN
Menu_Selected := TRUE;
Cur_Opt_Row := y;
IF Help_Toggle THEN
Erase_Help;
Last_Menu_Nbr := Menu_Nbr;
Menu_Nbr := Menu_Nbr + 1;
Menu_Idx := Menu_Nbr MOD 16;
Temp_Menu_Ptr^.Exit_Menu_Name := Menu_Name;
Cur_Menu_Ptr := Temp_Menu_Ptr;
Show_Menu (Cur_Menu_Ptr);
END;
END
ELSE { have to add a new menu }
IF Chk_Password(Password) THEN
BEGIN
Menu_Selected := TRUE;
Cur_Opt_Row := y;
IF Row + 2 <= CRTrows-(Max_Nbr_Opts+1) THEN
y := Row + 2
ELSE
y := 3;
IF Col + 6 < CRTcols-(Max_Opt_Len+8)+1 THEN
x := Col + 6
ELSE
x := 6;
Init_Menu (Temp_Menu_Ptr,Opt_Name,y,x);
Changes := TRUE;
Temp_Menu_Ptr^.Exit_Menu_Name := Menu_Name;
Add_Menu (Temp_Menu_Ptr);
IF Help_Toggle THEN
Erase_Help;
Last_Menu_Nbr := Menu_Nbr;
Menu_Nbr := Menu_Nbr + 1;
Menu_Idx := Menu_Nbr MOD 16;
Cur_Menu_Ptr := Temp_Menu_Ptr;
Show_Menu (Cur_Menu_Ptr);
END;
END;
END;
END;
PROCEDURE Chk_Key (c : CHAR);
VAR i : BYTE;
BEGIN
WITH Cur_Menu_Ptr^ DO
BEGIN
i := y - Row;
REPEAT
i := i + 1;
IF i > Max_Nbr_Opts THEN
i := 1;
UNTIL (UpCase(Opts[i].Select_Key) = UpCase(c)) OR (i+Row = y);
IF UpCase(Opts[i].Select_Key) = UpCase(c) THEN
y := i + Row
ELSE
Show_Error (1,y,21,fgNErr+bgNErr); { UNSUPPORTED FUNCTION }
END;
END;
FUNCTION Chk_Parms (Cur_Parms : STRING) : STRING;
VAR Reply : STRING;
BEGIN
Reply := Justify(Cur_Parms,Left,55,' ');
Chk_Parms := Reply;
IF Str_Question('New Parameters',CONCAT('Parameters ? [',Reply,']'),10,13,3,Reply,Visible_Chrs) THEN
Chk_Parms := Reply;
END;
PROCEDURE Delete_Option (Cur_Row : BYTE);
BEGIN
WITH Cur_Menu_Ptr^ DO
WITH Opts[Cur_Row-Row] DO
IF LENGTH(Opt_Name) > 0 THEN
IF Chk_Password(Password) THEN
IF Opt_Question('Confirm Option Delete','Are you sure you want to delete this option',8,13,14) = 1 THEN
BEGIN
Changes := TRUE;
Saved_Opt := Opts[Cur_Row-Row]; { save the current option }
FILLCHAR (Opts[Cur_Row-Row],SIZEOF(Opts[Cur_Row-Row]),CHR(0)); { clear option }
QWrite (Cur_Row,Col+1,-1,Make_String(Max_Opt_Len+4,' ')); { erase option from screen }
END;
END;
PROCEDURE Copy_Option (Opt_Nbr : BYTE);
BEGIN
WITH Cur_Menu_Ptr^.Opts[Opt_Nbr] DO
IF LENGTH(Opt_Name) > 0 THEN
IF Chk_Password(Password) THEN
Saved_Opt := Cur_Menu_Ptr^.Opts[Opt_Nbr];
END;
PROCEDURE Paste_Option (Cur_Row : BYTE);
BEGIN
IF LENGTH(Saved_Opt.Opt_Name) > 0 THEN
WITH Cur_Menu_Ptr^ DO
WITH Opts[Cur_Row-Row] DO
IF (Opt_Type = Batch) AND
((Select_Key = CHR(0)) OR (Select_Key = ' ')) AND
(LENGTH(Opt_Name) = 0) THEN
BEGIN
Changes := TRUE;
Opts[Cur_Row-Row] := Saved_Opt;
QWrite (Cur_Row,Col+1,-1,CONCAT(Select_Key,' ',Opt_Name)); { display the option }
END
ELSE
Show_Error (6,9,9,fgNErr+bgNErr) { CANNOT PASTE OPTION }
ELSE
Sound_Bell;
END;
PROCEDURE Set_Bat_File (VAR Bat_File : TEXT; Opt : Opt_Rec; Menu_Nbr,Menu_Opt : BYTE);
VAR Cur_Dir,Opt_Parms : STRING;
BEGIN
WITH Opt DO
BEGIN
IF LENGTH(Prg_Dir) > 0 THEN
WRITELN (Bat_File,'CD ',Prg_Dir);
IF LENGTH(Prg_Name) > 0 THEN
BEGIN
WRITE (Bat_File,Prg_Name);
IF Prompts THEN
Opt_Parms := Chk_Parms(Parms)
ELSE
Opt_Parms := Parms;
IF LENGTH(Opt_Parms) > 0 THEN
WRITELN (Bat_File,' ',Opt_Parms)
ELSE
WRITELN (Bat_File);
END;
IF Pause THEN
BEGIN
WRITELN (Bat_File,'ECHO ---READY TO RETURN TO MENUMGR---');
WRITELN (Bat_File,'PAUSE');
END;
IF LENGTH(Prg_Name) > 0 THEN
BEGIN
GetDir (0,Cur_Dir);
WRITELN (Bat_File,'CD ',Cur_Dir);
WRITELN (Bat_File,'MM ',Menu_Nbr,' ',Menu_Opt);
END;
END;
END;
BEGIN { Manage_Menus }
Cur_Menu_Ptr := Head_Menu_Ptr;
IF Cur_Menu_Ptr = NIL THEN { special case - no menus }
BEGIN
Init_Menu (Cur_Menu_Ptr,'Main Menu',3,6);
Changes := TRUE;
Head_Menu_Ptr := Cur_Menu_Ptr;
END;
Abort := FALSE;
Option_Selected := FALSE;
{ at this point, need to display all menus until the passed
menu number and option are reached; will also need to reverse-build
the Cur_Opt_Row values once final menu is reached; for now, just
display the first menu only... }
FILLCHAR(Saved_Opt,SIZEOF(Saved_Opt),CHR(0)); { blank out saved option }
Menu_Nbr := 1;
Last_Menu_Nbr := Menu_Nbr;
Menu_Idx := Menu_Nbr MOD 16; { needed for attribute arrays }
Show_Menu (Cur_Menu_Ptr);
REPEAT
WITH Cur_Menu_Ptr^ DO
BEGIN
IF Cur_Opt_Row = 0 THEN { start at first option }
y := Row + 1
ELSE { continue from where cursor was }
y := Cur_Opt_Row;
Old_y := y;
QAttr (y,Col+1,1,Max_Opt_Len+4,fgHOpt+bgHOpt); { highlight first menu item }
GotoRC (y,Col+Max_Opt_Len+5); { follow for appropriate placement of messages }
Menu_Selected := FALSE;
REPEAT
IF Old_y <> y THEN
BEGIN
QAttr (Old_y,Col+1,1,Max_Opt_Len+4,fgMenu[Menu_Idx]+bgMenu[Menu_Idx]);
Old_y := y;
END;
QAttr (y,Col+1,1,Max_Opt_Len+4,fgHOpt+bgHOpt);
GotoRC (y,Col+40);
REPEAT
IF Date_Time_Toggle THEN
Show_Date_And_Time;
UNTIL KeyPressed;
Wait_For_Key (c,Extended);
(* QAttr (y,Col+1,1,Max_Opt_Len+4,fgHOpt+bgHOpt+Blink); *)
IF Extended THEN
CASE ORD(c) OF
19 : Rename_Menu; { alt-r }
20 : Change_Time; { alt-t }
31 : Swap_Options (y); { alt-s }
32 : Change_Date; { alt-d }
46 : Copy_Option (y-Row); { alt-c }
47 : Paste_Option (y); { alt-v }
F1 : Set_Help; { F1 - help toggle }
60 : Settings_Editor; { F2 - options }
61 : Set_Exit (Cur_Menu_Ptr); { F3 - exit }
F4 : Set_Header (Cur_Menu_Ptr); { F4 - header toggle }
63 : Set_Date_Time; { F5 - date time toggle }
72, { left-arrow }
75 : Up_Arrow (y); { up-arrow }
77, { right-arrow }
80 : Down_Arrow (y); { down-arrow }
71 : y := Row + 1; { home }
79 : y := Row + Max_Nbr_Opts; { end }
82 : Option_Editor (y-Row); { insert }
45, { alt-x }
83 : Delete_Option (y); { delete }
115 : Move_Menu_Left (Cur_Menu_Ptr); { ctrl-left-arrow }
116 : Move_Menu_Right (Cur_Menu_Ptr); { ctrl-right-arrow }
118 : Move_Menu_Down (Cur_Menu_Ptr); { ctrl-pgdn }
132 : Move_Menu_Up (Cur_Menu_Ptr); { ctrl-pgup }
ELSE { any other extended key }
Show_Error (1,10,21,fgNErr+bgNErr); { UNSUPPORTED FUNCTION }
END
ELSE
CASE ORD(c) OF
13 : Chk_Enter (Cur_Menu_Ptr); { enter }
27 : Set_Exit (Cur_Menu_Ptr); { escape }
ELSE { any other non-extended key }
Chk_Key (c); { select key pressed? }
END;
UNTIL Option_Selected OR Menu_Selected OR Abort;
{ at this point, a batch file is ready to go, we're quitting, or another menu has been selected }
END;
UNTIL Option_Selected OR Abort;
{ at this point, a batch file is ready to go, or we're quitting }
{ if option selected, see if there is a prompt for parameters... }
ASSIGN (Batch_File,'GO.BAT');
{$I-}
REWRITE (Batch_File);
{$I+}
WRITELN (Batch_File,'ECHO OFF');
WRITELN (Batch_File,'CLS');
IF Option_Selected THEN
WITH Cur_Menu_Ptr^.Opts[y-Cur_Menu_Ptr^.Row] DO
IF LENGTH(Bat_Name) = 0 THEN { commands will be in "go" only }
Set_Bat_File (Batch_File,Cur_Menu_Ptr^.Opts[y-Cur_Menu_Ptr^.Row],Menu_Nbr,y-Cur_Menu_Ptr^.Row)
ELSE
BEGIN
ASSIGN (User_Batch_File,CONCAT(Bat_Name,'.BAT'));
{$I-}
RESET (User_Batch_File);
{$I+}
IO_Error := IORESULT;
IF IO_Error = 2 THEN { create the user batch file }
BEGIN
{$I-}
REWRITE (User_Batch_File);
{$I+}
IO_Error := IORESULT;
IF IO_Error = 0 THEN
BEGIN
WRITELN (User_Batch_File,'ECHO OFF');
Set_Bat_File (User_Batch_File,Cur_Menu_Ptr^.Opts[y-Cur_Menu_Ptr^.Row],Menu_Nbr,y-Cur_Menu_Ptr^.Row);
END
ELSE
IF IO_Error > 0 THEN { some error I can't handle }
BEGIN
Show_Error (IO_Error+100,10,21,fgNErr+bgNErr); { I/O ERROR }
END;
END
ELSE
IF IO_Error > 0 THEN { some error I can't handle }
BEGIN
Show_Error (IO_Error+100,10,21,fgNErr+bgNErr); { I/O ERROR }
END;
{$I-}
CLOSE (User_Batch_File);
{$I+}
WRITELN (Batch_File,Bat_Name);
END;
CLOSE (Batch_File);
END;
PROCEDURE Update_Menu_File;
VAR Menu_File : TEXT;
Temp_Menu_Ptr : Menu_Ptr;
i : BYTE;
PROCEDURE Mark_Menu_Status (Menu_Name : Opt_Str);
VAR i : BYTE;
Temp_Menu_Ptr : Menu_Ptr;
BEGIN
Temp_Menu_Ptr := Head_Menu_Ptr;
WHILE (Temp_Menu_Ptr^.Menu_Name <> Menu_Name) AND (Temp_Menu_Ptr <> NIL) DO
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
IF Temp_Menu_Ptr^.Menu_Name = Menu_Name THEN
IF Temp_Menu_Ptr^.Menu_Status <> Used THEN
BEGIN
Temp_Menu_Ptr^.Menu_Status := Used;
FOR i := 1 TO Max_Nbr_Opts DO
WITH Temp_Menu_Ptr^.Opts[i] DO
IF (Opt_Type = Menu) AND (LENGTH(Opt_Name) > 0) THEN
Mark_Menu_Status(Opt_Name);
END;
END;
BEGIN { Update_Menu_File }
IF NOT Changes THEN { nothing to update }
EXIT;
{ check menus in chain for in use }
Mark_Menu_Status (Head_Menu_Ptr^.Menu_Name);
{ write out menufile }
ASSIGN (Menu_File,'MENUFILE.DAT');
{$I-}
REWRITE (Menu_File);
{$I+}
IO_Error := IORESULT;
IF IO_Error <> 0 THEN
BEGIN
Show_Error (IO_Error+100,10,21,fgNErr+bgNErr); { I/O ERROR }
EXIT;
END;
Temp_Menu_Ptr := Head_Menu_Ptr;
REPEAT
WITH Temp_Menu_Ptr^ DO
IF Menu_Status = Used THEN
BEGIN
WRITE (Menu_File,Menu_Name,Menu_Delim);
WRITE (Menu_File,Row,Menu_Delim);
WRITELN (Menu_File,Col);
FOR i := 1 TO Max_Nbr_Opts DO
WITH Opts[i] DO
BEGIN
CASE Opt_Type OF
Batch : WRITE (Menu_File,'BATCH',Opt_Delim);
Delim : WRITE (Menu_File,'DELIM',Opt_Delim);
Menu : WRITE (Menu_File,'MENU',Opt_Delim);
END;
WRITE (Menu_File,Select_Key,Opt_Delim);
WRITE (Menu_File,Opt_Name,Opt_Delim);
WRITE (Menu_File,Prg_Dir,Opt_Delim);
WRITE (Menu_File,Prg_Name,Opt_Delim);
WRITE (Menu_File,Parms,Opt_Delim);
WRITE (Menu_File,Bat_Name,Opt_Delim);
WRITE (Menu_File,Password,Opt_Delim);
IF Pause THEN
WRITE (Menu_File,Pause,Opt_Delim)
ELSE
WRITE (Menu_File,Opt_Delim);
IF Prompts THEN
WRITELN (Menu_File,Prompts)
ELSE
WRITELN (Menu_File);
END;
END;
Temp_Menu_Ptr := Temp_Menu_Ptr^.Next_Menu_Ptr;
UNTIL Temp_Menu_Ptr = NIL;
{$I-}
CLOSE (Menu_File);
{$I+}
END;
BEGIN { Menu_Manager }
Init_Menu_Manager; { initialize global attributes for hardware configuration }
Bld_Menu_List; { open menu file, build linked list, close file }
ModCursor (CursorOff); { turn the cursor off }
Init_Scr (fgMain,bgMain); { display the initial screen }
Show_About_Msg; { display the program identification }
Manage_Menus; { work with the menus }
ModCursor (CursorOn); { turn the cursor back on }
Update_Menu_File; { update menu file, if necessary }
Update_Menu_Env; { update menu enviroment, if necessary }
END.