home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1988
/
02
/
lindley
/
lindley.ls2
< prev
next >
Wrap
Text File
|
1979-12-31
|
16KB
|
904 lines
{************************************************}
{*** ***}
{*** Menu System support procedures ***}
{*** for the serial protocol analyzer ***}
{*** written by ***}
{*** Craig A. Lindley ***}
{*** ***}
{*** Ver: 2.0 Last update: 08/15/87 ***}
{*** ***}
{************************************************}
CONST
{max # of video attributes - 1}
AttribMax = 5;
Attributes: ARRAY[0..AttribMax] OF
RECORD
f, {foreground color}
b: Integer; {background color}
END
{Attributes are:}
{Low, High, Rev, LowBlink, HighBlink, RevBlink}
= ((f:7; b:0) , (f:15;b:0) , (f:0; b:7),
(f:23;b:0) , (f:31;b:0) , (f:16;b:7));
{menu display lines relative to screen line 1}
MenuLine1 = 2;
MenuLine2 = 3;
MenuLine3 = 4;
MenuLine4 = 5;
{max A tree dimensions}
level2width = 7;
level3width = 5;
level4width = 7;
home= #199; {home key code}
larrow= #203; {left cursor arrow code}
rarrow= #205; {right cursor arrow code}
endkey= #207; {end key code}
bs= #08; {backspace key}
lf= #10; {line feed code}
cr= #13; {carrage return code}
Esc= #27; {escape key code}
sp= #32; {ascii space code}
TYPE
AttribType = (Low ,High, Rev, LowBlink,
HighBlink, RevBlink);
{data structure for atree menu entry}
{see text for details}
menu_entry=
RECORD
title: STRING[10];
desc: STRING[40];
chars: STRING[8];
index: Byte;
ccode: Byte;
END;
tree = ARRAY[0..level2width,
0..level3width,
0..level4width]
OF menu_entry;
VAR
ExitMenu,
ExitProgram: Boolean;
ind1,ind2,
ind3,
selector,
cmd_code,
level: Byte;
{atree data structure used for nested menus}
atree: tree;
{******* Keyboard and Display Procedures ********}
PROCEDURE Beep;
BEGIN
Sound(1000);
Pause(1);
NoSound;
END;
FUNCTION GetKey : Byte;
VAR
Ch: Char;
B: Byte;
CurrentX,
CurrentY: Integer;
BEGIN
{save cursor position}
{because we are going to yield}
{and loose control of display}
CurrentX := WhereX;
CurrentY := WhereY;
{yield until a key is pressed}
WHILE NOT keypressed DO
yield ;
{put the cursor back}
GoToXY(CurrentX,CurrentY);
{read the key}
read(kbd,Ch);
{see if its an extended key}
IF (Ch = Esc) AND keypressed THEN
BEGIN
{if so read again and mark}
{as extended by setting MSB}
read(kbd,Ch);
B := ord(Ch)+128;
END
ELSE
{in either case B has key code}
B := ord(Ch);
GetKey := B;
END;
FUNCTION repl (Count:Integer; ch:Char):FullString;
{replicate a char into a string of}
{specified length}
VAR
i: Integer;
BEGIN
FOR i:=1 TO Count DO repl[i]:=ch;
repl[0]:=Char(Count);
END;
PROCEDURE WriteString (Stng:FullString;
Attrib:AttribType);
BEGIN
{set the foreground and background}
{colors and write the string}
WITH Attributes[ORD(Attrib)] DO
BEGIN
TextColor(f);
TextBackGround(b);
END;
write(Stng);
{go back to low video mode}
WITH Attributes[ORD(Low)] DO
BEGIN
TextColor(f);
TextBackGround(b);
END;
END;
PROCEDURE WriteStringAt (Stng:FullString;
Attrib:AttribType;
X,Y:Integer);
BEGIN
GoToXY(X,Y);
WriteString(Stng,Attrib);
END;
{*********** Start of Menu Procedures ***********}
PROCEDURE center (Line,Width:Integer;
Outstr:FullString;
Attrib:AttribType);
{Center and write string with attribute on a}
{specified line in a given width field}
BEGIN
GoToXY(1,Line);
Clreol;
GoToXY((Width DIV 2)-(length(Outstr) DIV 2),
Line);
WriteString(Outstr,Attrib);
END;
PROCEDURE DrawFrame (x,y,width,height:Integer);
VAR
top,bottom: Str80;
BEGIN
top:= repl(width,Char(205));
bottom:=repl(width,Char(205));
WriteStringAt(top,High,x,y);
WriteStringAt(bottom,High,x,y+height-1);
END;
PROCEDURE DrawMenuFrame;
BEGIN
DrawFrame(1,1,80,6);
center(MenuLine1,78,
' Serial Protocol Analyzer Menu ',Rev);
END;
PROCEDURE DisplayMenu (ind1,ind2,ind3,level,
selector:Byte);
VAR
tind1,tind2,
tind3,i: Integer;
attrib: AttribType;
titlestr: FullString;
BEGIN
titlestr:='-- '+
atree[ind1,ind2,ind3].title+' Selection'+' --';
center(MenuLine2,78,titlestr,Low);
GoToXY(1,MenuLine4);
clreol;
GoToXY(9,MenuLine3);
clreol;
FOR i:= 1 TO atree[ind1,ind2,ind3].index DO
BEGIN
CASE level OF
1: ind1:=i;
2: ind2:=i;
3: ind3:=i;
END;
IF selector <> i THEN {item not selected}
attrib:=Low
ELSE
BEGIN
attrib:=Rev;
tind1:=ind1;
tind2:=ind2;
tind3:=ind3;
END;
WriteString(atree[ind1,ind2,ind3].title,
attrib);
write(' '); {spaces to separate items}
END;
GoToXY(9,MenuLine4);
clreol;
write(atree[tind1,tind2,tind3].desc);
END;
PROCEDURE ProcessCr (VAR ind1,ind2,ind3,level,
selector,cmd_code:Byte);
BEGIN
{assign selector to index as it was picked}
CASE level OF
1: ind1:=selector;
2: ind2:=selector;
3: ind3:=selector;
END;
{if entry is terminal entry}
IF atree[ind1,ind2,ind3].index = 0 THEN
BEGIN
{get associated cmd code}
cmd_code:=atree[ind1,ind2,ind3].ccode;
{process depending upon level}
CASE level OF
1: ind1:=0;
2: BEGIN
ind1:=0;
ind2:=0;
ind3:=0;
level:=1;
END;
3: BEGIN
ind2:=0;
ind3:=0;
level:=2;
END;
END;
END
ELSE
BEGIN
{down to next menu level}
level:=level+1;
END;
{select set to 1st item}
selector:=1;
END;
PROCEDURE ProcessMenu (VAR ind1,ind2,ind3,level,
selector,cmd_code:Byte);
VAR
key: Char;
position: Integer;
BEGIN
key:=upcase(GetKey);
CASE key OF
rarrow: BEGIN
selector:=selector+1;
IF selector >
length(atree[ind1,ind2,ind3].chars) THEN
selector:=1;
END;
larrow: BEGIN
selector:=selector-1;
IF selector < 1 THEN
selector :=
length(atree[ind1,ind2,ind3].chars);
END;
endkey: selector :=
length(atree[ind1,ind2,ind3].chars);
home: selector:=1;
cr: ProcessCr(ind1,ind2,ind3,level,
selector,cmd_code);
esc: cmd_code := 1; {force exit}
'A'..'Z','0'..'9' {1st letter of menu item ?}
: BEGIN
position :=
pos(key,atree[ind1,ind2,ind3].chars);
IF position <> 0 THEN
BEGIN {is 1st letter}
selector:=position;
ProcessCr(ind1,ind2,ind3,level,
selector,cmd_code);
END
ELSE {is not so beep}
Beep;
END;
ELSE {invalid so beep}
beep;
END;
END;
{Procedure used to process the operator}
{selected commands}
{Defined in the main program's code}
PROCEDURE ProcessCmd (cmd_code: Byte); FORWARD;
FUNCTION DoMenu : Boolean;
VAR
Line: Integer;
BEGIN
{stop update of screen info}
UpdateScreenStatus := False;
{clear top 6 display lines}
FOR Line := 1 TO 6 DO
BEGIN
GoToXY(1,Line);
Clreol;
END;
{and 2nd to the last one}
GoToXY(1,24);
Clreol;
DrawMenuFrame;
{clear the menu exit flag}
ExitMenu := False;
{clear the program exit flag}
ExitProgram := False;
{selector to 1st item in menu}
selector:=1;
{command code initialized to 0 }
cmd_code:=0;
{1st tier of heirachy}
level:=1;
{root menu array location}
ind1:=0;
ind2:=0;
ind3:=0;
REPEAT
DisplayMenu (ind1,ind2,ind3,level,selector);
ProcessMenu (ind1,ind2,ind3,level,selector,
cmd_code);
ProcessCmd (cmd_code);
cmd_code:=0; {reset code selected last}
UNTIL ExitMenu;
{start update of screen info}
UpdateScreenStatus := True;
{return flag}
DoMenu := ExitProgram;
END;
PROCEDURE Init_Menu;
{initialize the menu tree}
BEGIN
fillchar(atree,sizeof(atree),0);
WITH atree[0,0,0] DO
BEGIN
title:='Main Menu';
chars:='QPDTFCE';
index:=7;
END;
WITH atree[1,0,0] DO
BEGIN
title:='Quit';
desc:='Exit Analyzer Menus';
ccode:=1;
END;
WITH atree[2,0,0] DO
BEGIN
title:='Parameters';
desc:='Set Serial Parameters';
chars:='QBSWP';
index:=5;
END;
WITH atree[2,1,0] DO
BEGIN
title:='Quit';
desc:='Exit this submenu';
END;
WITH atree[2,2,0] DO
BEGIN
title:='Baud Rate';
desc:='Change Serial Baud Rate';
chars:='Q361249';
index:=7;
END;
WITH atree[2,2,1] DO
BEGIN
title:='Quit';
desc:='Exit this submenu';
END;
WITH atree[2,2,2] DO
BEGIN
title:='300';
ccode:=2;
END;
WITH atree[2,2,3] DO
BEGIN
title:='600';
ccode:=3;
END;
WITH atree[2,2,4] DO
BEGIN
title:='1200';
ccode:=4;
END;
WITH atree[2,2,5] DO
BEGIN
title:='2400';
ccode:=5;
END;
WITH atree[2,2,6] DO
BEGIN
title:='4800';
ccode:=6;
END;
WITH atree[2,2,7] DO
BEGIN
title:='9600';
ccode:=7;
END;
WITH atree[2,3,0] DO
BEGIN
title:='Stop Bits';
desc:='Set Number of Stop Bits';
chars:='Q12';
index:=3;
END;
WITH atree[2,3,1] DO
BEGIN
title:='Quit';
desc:='Exit this submenu';
END;
WITH atree[2,3,2] DO
BEGIN
title:='1';
ccode:=8;
END;
WITH atree[2,3,3] DO
BEGIN
title:='2';
ccode:=9;
END;
WITH atree[2,4,0] DO
BEGIN
title:='Word Len.';
desc:='Set Bits / Word';
chars:='Q5678';
index:=5;
END;
WITH atree[2,4,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[2,4,2] DO
BEGIN
title:='5';
ccode:=10;
END;
WITH atree[2,4,3] DO
BEGIN
title:='6';
ccode:=11;
END;
WITH atree[2,4,4] DO
BEGIN
title:='7';
ccode:=12;
END;
WITH atree[2,4,5] DO
BEGIN
title:='8';
ccode:=13;
END;
WITH atree[2,5,0] DO
BEGIN
title:='Parity';
desc:='Set Serial Parity';
chars:='QOEN';
index:=4;
END;
WITH atree[2,5,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[2,5,2] DO
BEGIN
title:='Odd';
ccode:=14;
END;
WITH atree[2,5,3] DO
BEGIN
title:='Even';
ccode:=15;
END;
WITH atree[2,5,4] DO
BEGIN
title:='None';
ccode:=16;
END;
WITH atree[3,0,0] DO
BEGIN
title:='Display';
desc:='Select Channels for Display';
chars:='Q12B';
index:=4;
END;
WITH atree[3,1,0] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[3,2,0] DO
BEGIN
title:='COM1';
ccode:=17;
END;
WITH atree[3,3,0] DO
BEGIN
title:='COM2';
ccode:=18;
END;
WITH atree[3,4,0] DO
BEGIN
title:='Both 1 & 2';
ccode:=19;
END;
WITH atree[4,0,0] DO
BEGIN
title:='Trigger';
desc:='Controls Trigger Modes';
chars:='QCPMS';
index:=5;
END;
WITH atree[4,1,0] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[4,2,0] DO
BEGIN
title:='Channel';
desc:='Set Trigger Channel';
chars:='Q12';
index:=3;
END;
WITH atree[4,2,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[4,2,2] DO
BEGIN
title:='COM1';
ccode:=20;
END;
WITH atree[4,2,3] DO
BEGIN
title:='COM2';
ccode:=21;
END;
WITH atree[4,3,0] DO
BEGIN
title:='Pattern';
desc:='Input Pattern for Trigger';
ccode:=22;
END;
WITH atree[4,4,0] DO
BEGIN
title:='Mode';
desc:='Select Trigger Mode';
chars:='QBAE';
index:=4;
END;
WITH atree[4,4,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[4,4,2] DO
BEGIN
title:='Before';
desc:='Display Data Before Trigger';
ccode:=23;
END;
WITH atree[4,4,3] DO
BEGIN
title:='After';
desc:='Display Data After Trigger';
ccode:=24;
END;
WITH atree[4,4,4] DO
BEGIN
title:='Enable';
desc:='Enable the Trigger';
ccode:=25;
END;
WITH atree[4,5,0] DO
BEGIN
title:='Stop';
desc:='Stop waiting for Trigger Event';
ccode:=26;
END;
WITH atree[5,0,0] DO
BEGIN
title:='Format';
desc:='Set Display Format';
chars:='QAHS';
index:=4;
END;
WITH atree[5,1,0] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[5,2,0] DO
BEGIN
title:='Ascii';
desc:='Ascii Display Format';
chars:='QNH';
index:=3;
END;
WITH atree[5,2,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[5,2,2] DO
BEGIN
title:='Normal';
desc:='Data Only';
ccode:=27;
END;
WITH atree[5,2,3] DO
BEGIN
title:='HandShake';
desc:='Data and HandShake';
ccode:=28;
END;
WITH atree[5,3,0] DO
BEGIN
title:='Hex';
desc:='Hex Display Format';
chars:='QNH';
index:=3;
END;
WITH atree[5,3,1] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[5,3,2] DO
BEGIN
title:='Normal';
desc:='Data Only';
ccode:=29;
END;
WITH atree[5,3,3] DO
BEGIN
title:='HandShake';
desc:='Data and HandShake';
ccode:=30;
END;
WITH atree[5,4,0] DO
BEGIN
title:='Spaces';
desc:='Insert space in data display';
ccode:=31;
END;
WITH atree[6,0,0] DO
BEGIN
title:='Control';
desc:='Alter Analyzer Operation';
chars:='QASCR';
index:=5;
END;
WITH atree[6,1,0] DO
BEGIN
title:='Quit';
desc:='Exit this SubMenu';
END;
WITH atree[6,2,0] DO
BEGIN
title:='Acquire';
desc:='Acquire Data';
ccode:=32;
END;
WITH atree[6,3,0] DO
BEGIN
title:='Stop';
desc:='Stop Data Acquisition';
ccode:=33;
END;
WITH atree[6,4,0] DO
BEGIN
title:='Clear';
desc:='Clear Screen of Data';
ccode:=34;
END;
WITH atree[6,5,0] DO
BEGIN
title:='Reset';
desc:='Reset Analyzer';
ccode:=35;
END;
WITH atree[7,0,0] DO
BEGIN
title:='End';
desc:='End the Analyzer Session';
ccode:=36;
END;
END;