Category : File Managers
Archive   : TPMNUS16.ZIP
Filename : MNUDRV.PAS

{$I-}
unit MnuDrv;
{-------------}
INTERFACE
{-------------}
uses Crt,Dos,Win; { standard TP5.5 units }

type
MediumStr = string[50];
LongStr = string[100];
MaxStr = string[255];

const
ON = True;
OFF = False;

type
ScanCodeType = ( Enter,Esc,HomeKey,NoKey,Tab,BS,Space,EndKey,
UpKey,DownKey,LeftKey,RightKey,PgUpKey,PgDnKey,
InsKey,DelKey,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,
AltA,AltB,AltC,AltD,AltE,AltF,AltG,AltH,AltI,AltJ,AltK,
AltL,AltM,AltN,AltO,AltP,AltQ,AltR,AltS,AltT,AltU,AltV,
AltW,AltX,AltY,AltZ );

RecPtrs = ( RecP1,RecP2,RecP3,RecP4,RecP5,RecP6,RecPc7,RecP8,RecP9,RecP10 );

Pages = ( Page0,Page1,Page2,Page3,Page4,
Page5,Page6,Page7,Page8,Page9 );

MenuRecPtr = ^MenuRec;
PtrArray = array[1..22] of MenuRecPtr;
MenuRec = record
MenuLine: MaxStr;
AltPos: integer;
LineNo: integer;
AltChar: char;
X,Y: integer;
end;

PgMenuRecPtr = ^PgMenuRec;
PgPtrArray = array[RecPtrs] of PgMenuRecPtr;
PgMenuRec = record
MenuLine: MaxStr;
AltPos: integer;
LineNo: integer;
AltChar: char;
end;

PageArray = array[pages] of PgPtrArray;

PointType = record
X,Y: integer;
end;

Wndow = record
UpperX,UpperY,LowerX,LowerY: integer;
end;

WinRec = record
State: WinState;
Buffer: pointer;
end;

DirectionType = ( Up,Down,Left,Right );

const
DfltC_NAttr: word = Black + Cyan * 16; { default normal color attribute }
DfltC_HAttr: word = White + Red * 16; { default hilite color attribute }
DfltC_AAttr: word = Red + Cyan * 16; { default altkey color attribute }
DfltC_MAttr: word = White + Cyan * 16; { default mouse arrow attribute }
M_Nattr: word = 7; { mono normal attribute }
M_Hattr: word = 112; { mono hilite attribute }
M_Aattr: word = 112; { mono altkey attribute }
M_MAttr: word = 112;
Dflt_Xpos: integer = 1; { default menu x location }
Dflt_Ypos: integer = 1; { default menu y location }
Msg1 = 'Menu not found . . . Program Terminated.';
Msg2 = 'String conversion error.';
Msg3 = 'Command strings not found.';
Msg4 = 'Excessive menu length . . . 100 maximum entries.';
Msg5 = 'Environment not set to TPMNU=';
Msg6 = 'Error in menu command file . . . check syntax.';
Delimiter: char = ']';
MaxPgLines = 10;
MaxMenuLines = 100;
MoveUp = TRUE;
MoveDown = FALSE;

var
AltColor,BarColor,NormalColor,MsArrowColor: byte;
Attrmx, Attrmn, NoLines, NoChars,
CurrentLine, LocateX, LocateY :integer;
AttrOffset, ScrnAddress :Word;
Ok, Done, CustomColor,
CustomPos,Mouse :Boolean;
f, f_Cmd :text;
Wnd :Wndow;
R :MenuRecPtr;
Key :ScancodeType;
CurrentDrive,CurrentDir,
EscStr, AltxStr,F1Str :MediumStr;
CurrentPage,FirstPage,LastPage :Pages;
CurrentRecPtr :RecPtrs;
Pg :PageArray;
PgUp,PgDn :PointType;
Pa :PtrArray;
m1,m2,m3,m4,m5: word;


procedure Menu( FName: MediumStr; var EscKey,F1key,AltXkey: boolean );
PROCEDURE PasMouse(var m1,m2,m3,m4,m5:word);
procedure ChangeCursor(TurnOn : boolean);
function ColorMonitor:Boolean;
function VMem: word;
procedure Beep;
procedure StripBlanks(var TxtStr: MaxStr);
procedure Abort(Msg: MediumStr);
procedure OpenFiles( Filename: MediumStr);
procedure SetDefaultColors;
procedure DecodeColorStr(var InputStr: MaxStr );
procedure ChkColorInput(var ColorStr: MaxStr);
procedure DecodePositionStr(var InputStr: MaxStr );
procedure ChkMenuPos(var PositionStr: MaxStr);
procedure Shadow;
procedure ShowPrompts;
function MouseDrv: Boolean;
procedure ShowMouse;
procedure HideMouse;
function WhereMouseX: word;
function WhereMouseY: word;
procedure InitMouse;
function IOError(FileName : MediumStr) : boolean;
function ReadChar: ScanCodeType;

{-------------}
IMPLEMENTATION
{-------------}

{------ check equipment flags for color present ------}
function ColorMonitor:Boolean;
begin
ColorMonitor:=NOT (48 AND Mem[0000:1040]=48);
end;

{------ return screen address ------}
function VMem: word;
begin
if LastMode = CO80 then VMem := $B800
else VMem := $B000;
end;

{------ beep tone mellower than ^G ------}
procedure Beep;
begin
Sound(220);
Delay(75);
NoSound;
end;

{------ strip blank characters from textline ------}
procedure StripBlanks( var TxtStr: MaxStr);
var i: Integer;
begin
while (TxtStr[1]=' ') and (Length(TxtStr) > 0) do
Delete(TxtStr,1,1);
while (TxtStr[Length(TxtStr)]=' ') and (Length(TxtStr) > 0) do
Delete(TxtStr,Length(TxtStr),1);
end;

{ --------------- turn cursor on/off ---------------}
procedure ChangeCursor(TurnOn : boolean);
{ Uses interrupt $10 to turn the cursor on or off }
const
OldScanStart : byte = 0; { The saved values of the cursor scan lines }
OldScanEnd : byte = 0;
var Reg : Registers; { Registers used for BIOS and DOS function calls }
begin
with Reg do
begin
case TurnOn of
ON : begin
AH := 1;
CH := OldScanStart;
CL := OldScanEnd;
Intr($10, Reg); { Turn cursor on }
end;
OFF : begin
AH := 3;
BH := 0;
Intr($10, Reg);
OldScanStart := CH; { Save old cursor scan lines }
OldScanEnd := CL;
AH := 1;
CH := 32;
CL := 0;
Intr($10, Reg); { Turn cursor off }
end;
end; { case }
end; { with }
end; { ChangeCursor }

{-------- call Interrupt 33 for mouse functions ----------}
PROCEDURE PasMouse(var m1,m2,m3,m4,m5:word);
VAR Regs : Registers;
BEGIN
IF m1 >=0 THEN
BEGIN
Regs.AX:=m1;
Regs.BX:=m2;
Regs.CX:=m3;
IF (m1=9) OR (m1=12) OR (m1=20) OR (m1=22) OR (m1=23) THEN
BEGIN
Regs.DX:=Ofs(m4); { m4 = pointer of the address }
Regs.ES:=Seg(m4); { of the user array or sub }
END { routine }
ELSE IF (m1=16) THEN
BEGIN
Regs.CX:= m2; { left x coordinate }
Regs.DX:= m3; { upper y coordinate }
Regs.SI:= m4; { right x coordinate }
Regs.DI:= m5; { lower y coordinate }
END
ELSE Regs.DX:= m4;
Intr($33,Regs); { call mouse driver at interrupt 33h }
IF (m1=20) THEN
m2:=Regs.ES { special return }
ELSE m2:=Regs.BX; { standard returns }
m1:=Regs.AX;
m3:=Regs.CX;
m4:=Regs.DX;
END; { if }
END; { procedure }

{------ determine if mouse driver is present -------}
function MouseDrv: Boolean;
var Found: Boolean;
begin
Found := False;
m1:=0; m2:=0; m3:=0; m4:=0; m5:=0;
PasMouse(m1,m2,m3,m4,m5);
if (m1<>0) then Found := True;
MouseDrv := Found;
end;

{------ display/not display mouse -----}
procedure ShowMouse;
begin
m1:=1;
PasMouse(m1,m2,m3,m4,m5);
end;
procedure HideMouse;
begin
m1:=2;
PasMouse(m1,m2,m3,m4,m5);
end;

{------ convert mouse coordinates to text screen coordinates ------}
function WhereMouseX: word;
begin
WhereMouseX := (m3 div 8) + 1;
end;
function WhereMouseY: word;
begin
WhereMouseY := (m4 div 8) + 1;
end;

{ -------------- initialize mouse if driver found -------------}
procedure InitMouse;
begin
Mouse := True;
m1 := 10; { text cursor mouse }
m2 := 0; { software }
m3 := $77FF; { XOR, blink }
m4 := $F700;
PasMouse(m1,m2,m3,m4,m5);
ShowMouse;
end;

{ --------- restores text screen buffer ---------- }
procedure RestoreScrn(ScreenAddress: word;
DataPtr: pointer;
CursX,CursY: integer);
begin
Move(DataPtr^,Mem[ScreenAddress:0000],4000);
FreeMem(DataPtr,4000);
Window(1,1,80,25);
Gotoxy(CursX,CursY);
end;

{ ----------- saves text screen to buffer ------------ }
procedure SaveScrn(ScreenAddress: word;
var DataPtr: pointer;
var CursX,CursY: integer);
begin
GetMem(DataPtr,4000);
CursX:=WhereX;
CursY:=WhereY;
Move(Mem[ScreenAddress:0000],DataPtr^,4000);
end;

{------ convert integer to text string ------}
function IntegerToStr(Number: integer) : MaxStr;
var S: MaxStr;
begin
Str(Number,S);
IntegerToStr := S;
end;

{------ handle IO errors ------}
function IOError(FileName : MediumStr) : boolean;
var
Msg : LongStr;
Result,x,y : integer;
ScrnPtr: Pointer;
OldTxtAttr: word;
Ch: char;
begin
Result := IOResult;
if Result <> 0 then
begin
OldTxtAttr := TextAttr;
if ColorMonitor then TextAttr := Black + Red * 16
else TextAttr := Black + LightGray * 16;
FileName := '"' + FileName + '"'; { Put file name in quotes }
case Result of
2: Msg := 'file '+ FileName + ' not found.';
3: Msg := 'path not found.';
4: Msg := 'too many files open.';
5: Msg := 'file access denied.';
6: Msg := 'unrecognized file handle';
12: Msg := 'attempted file access with wrong filemode';
15: Msg := 'invalid drive number used in getdir';
16: Msg := 'directory cannot be removed by rmdir';
17: Msg := 'drives specified by rename cannot differ';
100: Msg := 'attempted read past end of file';
101: Msg := 'disk data area is full';
102: Msg := 'cannot attempt I/O without assigning file';
103: Msg := 'file not prepared with reset or rewrite';
104: Msg := 'file not prepared to be read from';
105: Msg := 'file not prepared to be written to';
106: Msg := 'illegal numeric format in data';
150: Msg := 'attempt to read write-protected disk';
151: Msg := 'unit is unknown';
152: Msg := 'disk drive is not ready';
153: Msg := 'command is unknown';
154: Msg := 'error in cyclical redundancy check';
155: Msg := 'invalid drive request structure length';
156: Msg := 'seek error on disk';
157: Msg := 'media type is unknown';
158: Msg := 'disk sector not found';
159: Msg := 'printer is out of paper';
160: Msg := 'write fault on I/O device';
161: Msg := 'read fault on I/O device';
162: Msg := 'general hardware failure'
else Msg := 'I/O error #'+ IntegerToStr(Result);
end; { case }
Beep;
X := WhereX;
Y := WhereY;
SaveScrn(VMem,ScrnPtr,X,Y);
Gotoxy(1,25); ClrEol;
Gotoxy(16,25);
Write('I/O ERROR: ' + Msg + ' ');
Repeat
Ch := Readkey;
Until Ch = #27;
RestoreScrn(VMem,ScrnPtr,X,Y);
TextAttr := OldTxtAttr;
IOError := True;
end
else
IOError := False;
end; { IOError }

{------ return which key pressed using user defined type ------}
function ReadChar: ScanCodeType;
var Ch: Char;
Key: ScanCodeType;
begin
Ch := ReadKey;
if Ch = #0 then
case Readkey of
#30: Key := AltA;
#48: Key := AltB;
#46: Key := AltC;
#32: Key := AltD;
#18: Key := AltE;
#33: Key := AltF;
#34: Key := AltG;
#35: Key := AltH;
#23: Key := AltI;
#36: Key := AltJ;
#37: Key := AltK;
#38: Key := AltL;
#50: Key := AltM;
#49: Key := AltN;
#24: Key := AltO;
#25: Key := AltP;
#16: Key := AltQ;
#19: Key := AltR;
#31: Key := AltS;
#20: Key := AltT;
#22: Key := AltU;
#47: Key := AltV;
#17: Key := AltW;
#45: Key := AltX;
#21: Key := AltY;
#44: Key := AltZ;
#59: Key := F1;
#60: Key := F2;
#61: Key := F3;
#62: Key := F4;
#63: Key := F5;
#64: Key := F6;
#65: Key := F7;
#66: Key := F8;
#67: Key := F9;
#68: Key := F10;
#71: Key := HomeKey;
#72: Key := UpKey;
#73: Key := PgUpKey;
#75: Key := LeftKey;
#77: Key := RightKey;
#79: Key := EndKey;
#80: Key := DownKey;
#81: Key := PgDnKey;
#82: Key := InsKey;
#83: Key := DelKey;
end
else
case Ch of
#8: Key := BS;
#9: Key := Tab;
#13: Key := Enter;
#27: Key := Esc;
#32: Key := Space;
else Key := NoKey;
end;
ReadChar := Key;
end;

{
-----------------------------------------------------------------------------
main procedure
-----------------------------------------------------------------------------
}

{--------------- initialize global variables -------------}
procedure Init;
var i: integer;
begin
if ColorMonitor then ScrnAddress := $B800
else ScrnAddress := $B000;
for i := 1 to 22 do
Pa[i] := NIL;
NoLines := 0;
Done := False;
Mouse := False;
EscStr := '';
AltxStr := '';
F1Str := '';
CurrentLine := 1;
LocateX := 1;
LocateY := 1;
CustomColor := false;
CustomPos := false;
GetDir(0,CurrentDir);
CurrentDrive := CurrentDir[1] + CurrentDir[2];
end;

{--------------- terminate if error w/ message --------------}
procedure Abort(Msg: MediumStr);
begin
Beep;
Gotoxy(1,1);
Writeln(Msg);
Halt(1);
end;

{------------------ open program files -------------------}
procedure OpenFiles( Filename: MediumStr);
var Command: MediumStr;
begin
Ok := False;
Assign(f,Filename);
Reset(f);
if IOError(Filename) then Exit;
if GetEnv('TPMNU') = '' then Abort(Msg5);
Assign(f_Cmd,GetEnv('TPMNU'));
Rewrite(f_Cmd);
if IOError(GetEnv('TPMNU')) then Exit;
Ok := True;
end;

{--------- determine if color monitor, set colors ---------}
procedure SetDefaultColors;
begin
case ColorMonitor of
true: begin
NormalColor := DfltC_Nattr;
BarColor := DfltC_Hattr;
AltColor := DfltC_Aattr;
MsArrowColor := DfltC_MAttr;
end;
false: begin
NormalColor := M_Nattr;
BarColor := M_Hattr;
AltColor := M_Aattr;
MsArrowColor := M_MAttr;
end;
end;
end;

{-------- get custom color values from file string ---------}
procedure DecodeColorStr(var InputStr: MaxStr );
var i,code: integer;
foreN,backN,foreH,backH,foreA,backA: word;
begin
for i := 1 to Pos(Delimiter,InputStr) do
Delete(InputStr,1,1);
StripBlanks(InputStr);
Val(InputStr[1] + InputStr[2],foreN,code);
Val(InputStr[3] + InputStr[4],backN,code);
Val(InputStr[5] + InputStr[6],foreH,code);
Val(InputStr[7] + InputStr[8],backH,code);
Val(InputStr[9] + InputStr[10],foreA,code);
Val(InputStr[11] + InputStr[12],backA,code);
if backN > 7 then backN := Black;
if backH > 7 then backH := LightGray;
if backA > 7 then backA := Black;
NormalColor := foreN + backN * 16;
BarColor := foreH + backH * 16;
AltColor := foreA + backA * 16;
MsArrowColor := NormalColor;
end;

{-------- check for custom colors from menu file -----------}
procedure ChkColorInput(var ColorStr: MaxStr);
begin
CustomColor := Pos('[colors]',ColorStr) <> 0;
if CustomColor and ColorMonitor then DecodeColorStr(ColorStr)
else SetDefaultColors;
end;

{-------- get custom position from file string -------------}
procedure DecodePositionStr(var InputStr: MaxStr );
var i,code: integer;
begin
for i := 1 to Pos(Delimiter,InputStr) do
Delete(InputStr,1,1);
StripBlanks(InputStr);
Val(InputStr[1] + InputStr[2],LocateX,code);
if code <> 0 then LocateX := 1;
Val(InputStr[3] + InputStr[4],LocateY,code);
if code <> 0 then LocateY := 1;
if (LocateX > 76) then LocateX := 1;
if (LocateY > 23) then LocateY := 1;
end;

{-------- check for custom position from menu file ---------}
procedure ChkMenuPos(var PositionStr: MaxStr);
begin
CustomPos := Pos('[locate]',PositionStr) <> 0;
if CustomPos then DecodePositionStr(PositionStr);
end;

{-------- get menu lines from text file --------------}
procedure GetMenu(var LineCount: integer;
var MaxChars: integer);
var
M: MenuRecPtr;
S_temp: MaxStr;
Code: integer;
Done: Boolean;
HotKey: Char;
i: integer;

begin
Ok := False;
Done := False;
HotKey := '^';
MaxChars := 0;
while not (S_Temp = '[startmenu]') or EOF(f) do
begin
Readln(f,S_Temp);
if not CustomColor then ChkColorInput(S_Temp);
if not CustomPos then ChkMenuPos(S_Temp);
if (Pos('[esckey]',S_Temp) <> 0) then EscStr := S_Temp;
if (Pos('[altxkey]',S_Temp) <> 0) then AltxStr := S_Temp;
if (Pos('[f1key]',S_Temp) <> 0) then F1Str := S_Temp;
end;
if (S_Temp <> '[startmenu]') then Exit;
while not EOF(f) do
begin
Readln(f,S_Temp);
if (Pos(Delimiter,S_Temp) <> 0) then
begin
New(M);
with M^ do
begin
Inc(LineCount);
MenuLine := S_Temp;
case Pos(Delimiter,MenuLine) of
3: Val( MenuLine[2], LineNo, code );
4: Val( MenuLine[2] + MenuLine[3], LineNo, code );
end;
if Code <> 0 then Abort(Msg2);
for i := 1 to Pos(Delimiter,MenuLine) do
Delete(MenuLine,1,1);
StripBlanks(MenuLine);
AltPos := Pos(HotKey,MenuLine);
AltChar := MenuLine[Pos(HotKey,MenuLine) + 1];
Delete(MenuLine,AltPos,1);
if Length(MenuLine) > MaxChars then
MaxChars := Length(MenuLine);
end; { with }
Pa[LineCount] := M;
end;
end;
Close(f);
if LineCount > 22 then Abort(Msg4);
Ok := True;
end;

{------------ set menu window -------------------}
procedure GetSetWndow(Xpos,Ypos: integer);
var i: integer;
begin
with Wnd do
begin
LowerX := Xpos + NoChars + 3;
if LowerX > 79 then
begin
Dec(Xpos, (LowerX - 79));
Dec(LowerX, (LowerX - 79));
end;
LowerY := Ypos + NoLines + 1;
if LowerY > 24 then
begin
Dec(Ypos, (LowerY - 24));
Dec(LowerY, (LowerY - 24));
end;
UpperX := Xpos;
UpperY := Ypos;
Attrmx := UpperX + NoChars + 1;
Attrmn := UpperX;
for i := 1 to NoLines do
begin
with Pa[i]^ do
begin
X := UpperX + 2;
Y := UpperY + i;
end;
end;
end;
end;

{--------------- draw a shadow around frame --------------}
procedure Shadow;
var OldTxtAttr: byte;
i: integer;
HorizChar,VertChar: char;
ShadowAttr: word;
begin
OldTxtAttr := TextAttr;
if ColorMonitor then begin
ShadowAttr := DarkGray + Black * 16;
HorizChar := Chr(223);
VertChar := Chr(219);
end
else begin
ShadowAttr := Lightgray + black * 16;
HorizChar := Chr(177);
VertChar := Chr(177);
end;
TextAttr := ShadowAttr;
with Wnd do begin
for i := (UpperX + 1) to (LowerX + 1) do begin
gotoxy(i, (LowerY + 1));
write(HorizChar);
end;
for i := (UpperY + 1) to LowerY do begin
gotoxy( (LowerX + 1),i);
write(VertChar);
end;
end;
TextAttr := OldTxtAttr;
end;

{------------------ frame menu window ---------------------}
procedure OpenWindow;
var FAttr: byte;
begin
with Wnd do
begin
Window(UpperX,UpperY,LowerX,LowerY);
FrameWin('',DoubleFrame,NormalColor,NormalColor);
FillWin(#0,NormalColor);
Window(1,1,80,25);

Shadow;
end;
end;

{---------- write line with normal attributes ---------}
procedure WriteNormLine(Line: integer);
var Col: integer;
begin
with Pa[Line]^ do
begin
for Col := Attrmn to Attrmx do { change highlited to normal }
begin
AttrOffset := ((Y - 1) * 160) + (Col * 2) + 1;
Mem[ScrnAddress:AttrOffset] := NormalColor;
end;
AttrOffset := ( (Y - 1) * 160) + ((Attrmn + AltPos) * 2) + 1;
Mem[ScrnAddress:AttrOffset] := AltColor;
end;
end;

{---------- write highlighted line --------------------}
procedure WriteHiLine(Line: integer);
var Col: integer;
begin
with Pa[Line]^ do
for Col := Attrmn to Attrmx do { highlite next line }
begin
AttrOffset:=((Y - 1) * 160) + (Col * 2) + 1;
Mem[ScrnAddress:AttrOffset] := BarColor;
end;
end;

{----------- write menu w/ first menu bar ----------------}
procedure WriteMenu;
var Col: integer;
i: integer;
begin
TextAttr := NormalColor;
for i := 1 to NoLines do
with Pa[i]^ do
begin
gotoxy(X,Y);
write(MenuLine);
AttrOffset := ( (Y - 1) * 160) + ((Attrmn + AltPos) * 2) + 1;
Mem[ScrnAddress:AttrOffset] := AltColor;
end;
WriteHiLine(1);
end;

{------------------ move menu bar, up --------------------}
procedure MoveMenuBar(Up: Boolean);
var Col: integer;
begin
WriteNormLine(CurrentLine);
case Up of
True: if (CurrentLine = 1) then CurrentLine := NoLines
else Dec(CurrentLine);
False: if (CurrentLine = NoLines) then CurrentLine := 1
else Inc(CurrentLine);
end;
WriteHiLine(CurrentLine);
end;

{--------------- get command lines from menu file -----------}
procedure GetCmd(Filename: MediumStr; SelectNo: integer);
var S_Temp: MaxStr;
Found: boolean;
LineNo: integer;
DeLimiter: Char;
Code: integer;
begin
Found := False;
DeLimiter := ']';
Code := 0;
LineNo := 0;
S_Temp := '';
Reset(f);
if IOError(Filename) then Exit;
while not (S_Temp = '[startmenu]') do
readln(f,S_Temp);
while not Found or EOF(f) do
begin
Readln(f,S_Temp);
case Pos(Delimiter,S_Temp) of
3: Val( S_Temp[2], LineNo, code );
4: Val( S_Temp[2] + S_Temp[3], LineNo, code );
end;
if code <> 0 then Abort(Msg2);
if LineNo = SelectNo then Found := True;
end; { with }
if EOF(f) then Abort(Msg3);
while not (S_Temp = '') do
begin
Readln(f,S_Temp);
StripBlanks(S_Temp);
WriteLn(f_Cmd,S_Temp);
end;
Writeln(f_Cmd,CurrentDrive);
Writeln(f_Cmd,'cd ',CurrentDir);
Close(f);
Done := True;
end;

{--------- move menu bar to alternate key response --------}
procedure AltMoveMenuBar(NewLine: integer);
begin
WriteNormLine(CurrentLine);
WriteHiLine(NewLine);
CurrentLine := NewLine;
end;

{------------ check for alternate key pressed -------------}
procedure ChkAltKey(AltKey: ScancodeType);
var AltKy: char;
KeyFound: boolean;
NewLine: integer;
Count: integer;
begin
KeyFound := false;
case AltKey of
AltA: AltKy := 'A';
AltB: AltKy := 'B';
AltC: AltKy := 'C';
AltD: AltKy := 'D';
AltE: AltKy := 'E';
AltF: AltKy := 'F';
AltG: AltKy := 'G';
AltH: AltKy := 'H';
AltI: AltKy := 'I';
AltJ: AltKy := 'J';
AltK: AltKy := 'K';
AltL: AltKy := 'L';
AltM: AltKy := 'M';
AltN: AltKy := 'N';
AltO: AltKy := 'O';
AltP: AltKy := 'P';
AltQ: AltKy := 'Q';
AltR: AltKy := 'R';
AltS: AltKy := 'S';
AltT: AltKy := 'T';
AltU: AltKy := 'U';
AltV: AltKy := 'V';
AltW: AltKy := 'W';
AltX: AltKy := 'X';
AltY: AltKy := 'Y';
AltZ: AltKy := 'Z';
end;
for Count := 1 to NoLines do
with Pa[Count]^ do
begin
KeyFound := (AltKy = AltChar);
if KeyFound then
begin
NewLine := LineNo;
AltMoveMenuBar(NewLine);
GetCmd('',CurrentLine);
Exit;
end;
end;
end;

{----------- get mouse position and select line ------------}
procedure MouseSelect;
var InRangeX,InRangeY,InRange: boolean;
MouseX,MouseY,NewLine: integer;
begin
with Wnd do
begin
MouseX := WhereMouseX;
MouseY := WhereMouseY;
{ less confusing boolean breakdown then full evaluation }
InRangeX := (MouseX > (UpperX + 1)) and (MouseX < (LowerX - 1));
InRangeY := (MouseY > UpperY) and (MouseY < LowerY);
InRange := InRangeX and InRangeY;
if not InRange then Exit;
if InRange then
begin
NewLine := MouseY - UpperY;
AltMoveMenuBar(NewLine);
GetCmd('',CurrentLine);
end;
end;
Done := True;
end;

{----------display prompts if requested-------------------}
procedure ShowPrompts;

procedure StripLead(var s: mediumStr; Pad: boolean);
var i: integer;
begin
if s <> '' then
begin
for i := 1 to Pos(Delimiter,s) do
Delete(s,1,1);
if Pad then
s := s + ' ';
end;
end;

begin
if (EscStr = '') and (AltxStr = '') and (F1Str = '') then Exit;
StripLead(EscStr,false);
StripLead(AltxStr,true);
StripLead(F1Str,true);
gotoxy(1,25);
if ColorMonitor then TextAttr := NormalColor
else TextAttr := BarColor;
case Mouse of
true: write(' ',#30,#31,'-MOVE ',#17,#217,'/LeftButton/Alt()-SELECT '+
F1Str + AltxStr + EscStr );
false: write(' ',#30,#31,'-MOVE ',#17,#217,'-SELECT '+
F1Str + AltxStr + EscStr );
end;
ClrEOL;
end;

{----------- start program main loop ---------------------}
procedure MainLoop( Filename: MediumStr;
var EscKeyPressed,F1KeyPressed,AltXKeypressed: boolean);
var Escape,ButtonPressed: boolean;
begin
Escape := false;
repeat
m1 := 3;
m2 := 999;
repeat
PasMouse(m1,m2,m3,m4,m5);
ButtonPressed := (m2 = 1);
until ButtonPressed or KeyPressed;
if ButtonPressed then MouseSelect
else
begin
Key := ReadChar;
case Key of
UPKEY: MoveMenuBar(True);
DOWNKEY: MoveMenuBar(False);
ENTER: GetCmd(FileName,CurrentLine);
ESC: Escape := True;
ALTX: begin
done := true;
AltXKeyPressed := True;
end;
F1: begin
F1KeyPressed := True;
Done := True;
end;
else ChkAltKey(Key);
end;
end;
until Escape or Done;
EscKeyPressed := Escape;
end;

{----------------- close files w/ error check ------------}
procedure CloseFiles( Filename: MediumStr);
var i: integer;
begin
for i := 1 to NoLines do
Dispose(Pa[i]);
Close(f_Cmd);
if IOError(GetEnv('TPMNU')) then Exit;
end;

{===========================================================================
MAIN
============================================================================}
procedure Menu;
begin
Init;
ChangeCursor(OFF);
OpenFiles(Fname);
if not Ok then Halt(1);
GetMenu(NoLines, NoChars);
if not Ok then Abort(Msg6);
GetSetWndow(LocateX,LocateY);
OpenWindow;
WriteMenu;
if MouseDrv then InitMouse;
ShowPrompts;
MainLoop(Fname,EscKey,F1Key,AltXkey);
CloseFiles(FName);
HideMouse;
end;

END. {unit menutool}
{$I+}