gt3070b@prism.gatech.EDU (Jeff Watkins) (05/30/90)
{
Menu files have the following form:
Menu entry
Line entry
[Line entries...]
[Menu entry
Line entry...]
Menu entries are of the form:
;m <Title>
Line entries are of the form:
;l <text> [command] (attribute)
if a line entry invokes a submenu, the submenu bit of the attribute
byte is set and the command byte indicates which submenu to execute. Menus
are incrementally numbered as they are encountered in the menu file with the
root menu as number 0.
}
unit GMenu;
interface
const
inactive= 0;
checked= 1;
check= 2;
SubMenu= 7;
type
ItemRec= record
T: string[20];
a: byte;
c: byte;
end;
ItemArray= array[0..0] of ItemRec;
ItemPtr= ^ItemArray;
MenuRec= record
Title: string[20];
Items: ItemPtr;
NItems: byte;
Back: word;
MenuW: word;
Total: longint;
end;
MenuArray= array[0..0] of MenuRec;
MenuPtr= ^MenuArray;
function LoadMenu(FileName:string):MenuPtr;
procedure Toggle(var M:menuRec;c:byte);
function Menu(Var M:MenuPtr;px,py:word):byte;
procedure KillMenu(Var M:MenuPtr);
implementation
uses misc,gutil,graph,mouse,crt;
var
ViewSettings: ViewPortType;
TextSettings: TextSettingsType;
LineSettings: LineSettingsType;
function LoadMenu(FileName:string):MenuPtr;
var
F: Text;
M: array[1..100] of MenuRec;
TotalMenus: byte;
Items: array[0..100] of ItemRec;
I: ItemRec;
CItem: Byte;
TM: MenuPtr;
y: byte;
procedure NextItem;
var
S: string;
itemFound: boolean;
y: byte;
begin
itemFound:=false;
repeat
repeat
readln(F,S);
until eof(F) or (S[1]=';');
if upcase(S[2])='M' then
begin
if TotalMenus>0 then
begin
Getmem(M[TotalMenus].Items,SizeOf(ItemRec)*M[TotalMenus].NItems);
Move(Items[0],M[TotalMenus].Items^,SizeOf(ItemRec)*M[TotalMenus].NItems);
end;
inc(TotalMenus);
M[TotalMenus].Items:=nil;
M[TotalMenus].NItems:=0;
M[TotalMenus].Title:=extract(S,'<','>');
M[TotalMenus].MenuW:=0;
Citem:=0;
end;
if upcase(S[2])='L' then
begin
if M[TotalMenus].Nitems=0 then
CItem:=0;
inc(M[TotalMenus].NItems);
if extract(S,'(',')') <>'' then
Items[Citem].A:=VNum(extract(S,'(',')'))
else
Items[Citem].A:=0;
if extract(S,'[',']')<>'' then
Items[CItem].C:=VNUm(extract(S,'[',']'))
else
Items[Citem].C:=255;
items[Citem].T:=extract(S,'<','>');
if length(Items[Citem].T)*10+30>M[TotalMenus].MenuW then
M[TotalMenus].MenuW:=length(Items[Citem].T)*10+30;
inc(Citem);
ItemFound:=true;
end;
until (ItemFound=true) or eof(f);
end;
begin
TotalMenus:=0;
assign(F,FileName);
reset(F);
repeat
NextItem;
until eof(F);
Getmem(M[TotalMenus].Items,SizeOf(ItemRec)*M[TotalMenus].NItems);
Move(Items[0],M[TotalMenus].Items^,SizeOf(ItemRec)*M[TotalMenus].NItems);
getmem(TM,TotalMenus*SizeOf(MenuRec));
move(M,TM^,TotalMenus*SizeOF(MenuRec));
TM^[0].Total:=TotalMenus*SizeOf(MenuRec);
LoadMenu:=Tm;
end;
procedure KillMenu(Var M:MenuPtr);
begin
freemem(M,M^[0].Total);
M:=nil;
end;
procedure Toggle(var M:menuRec;c:byte);
var
y: byte;
begin
{ toggle the check mark on or off }
for y:=0 to M.nitems do
if (M.items^[y].c=c) and not bitset(M.Items^[y].a,SubMenu) then
M.items^[y].a:=M.items^[y].a xor 2;
end;
function Menu(Var M:MenuPtr;px,py:word):byte;
var
x,y: word;
s: byte;
B: array[0..10] of pointer;
size: array[0..10] of word;
ox: array[0..10] of word;
oy: array[0..10] of word;
but: boolean;
MenuH,
MenuW: word;
CMenu: byte;
Sel: word;
Menus: byte;
outside: boolean;
procedure Select(l:byte);
begin
if bitset(M^[CMenu].items^[l].a,inactive) then
exit;
UBox(px+20,py+l*15+10,px+MenuW-25,py+l*15+22);
setcolor(selectcolor);
setfillstyle(1,selectcolor);
hidem;
rectangle(px+21,py+l*15+11,px+MenuW-26,py+l*15+21);
floodfill(px+22,py+l*15+12,selectcolor);
setcolor(8);
outtextxy(px+24,py+l*15+11,M^[Cmenu].items^[l].t);
showm;
end;
procedure UnSelect(l:byte);
begin
if bitset(M^[CMenu].Items^[l].a,inactive) then
exit;
setcolor(7);
hidem;
rectangle(px+20,py+l*15+10,px+MenuW-25,py+l*15+22);
setfillstyle(1,7);
floodfill(px+21,py+l*15+11,7);
setcolor(8);
Outtextxy(px+24,py+l*15+11,m^[CMenu].Items^[l].t);
showm;
end;
procedure PopUpMenu(var M:MenuRec;var px,py:word);
var
y: word;
begin
MenuW:=M.MenuW;
MenuH:=15*M.NItems+15;
if px+MenuW>MaxX then
px:=MaxX-MenuW-1;
if py+MenuH>MaxY then
py:=Maxy-MenuH-1;
size[Menus]:=Imagesize(px,py,px+MenuW,py+MenuH);
getmem(B[Menus],Size[Menus]);
hidem;
getimage(px,py,px+MenuW,py+MenuH,B[Menus]^);
showm;
UBox(px,py,px+MenuW,py+MenuH);
setcolor(8);
settextstyle(SmallFont,HorizDir,4);
settextJustify(LeftText,TopText);
for y:=0 to M.nItems-1 do
begin
hidem;
OutTextXY(px+24,py+y*15+11,M.Items^[y].t);
{ if BitSet(M.Items^[y].a,Inactive) and
(M.Items^[y].t='') then
begin
setcolor(15);
line(px,py+y*15+19,px+Menuw-1,py+y*15+19);
setcolor(8);
line(px+1,py+y*15+12,px+Menuw,py+y*15+12);
end;}
if bitset(M.Items^[y].a,SubMenu) then
RightArrow(px+MenuW-10,py+y*15+15,0);
if bitset(M.Items^[y].a,check) then
UBox(px+10,py+y*15+10,px+18,py+y*15+20);
if bitset(M.Items^[y].a,checked) then
begin
line(px+11,py+y*15+11,px+17,py+y*15+19);
line(px+11,py+y*15+19,px+17,py+y*15+11);
end;
showm;
end;
end;
begin
GetTextSettings(TextSettings);
GetViewSettings(ViewSettings);
GetLineSettings(LineSettings);
SetViewPort(0,0,MaxX,maxY,true);
but:=but2;
CMenu:=0;
Menus:=0;
PopUpMenu(M^[CMenu],px,py);
ox[0]:=px;
oy[0]:=py;
M^[CMenu].Back:=Cmenu;
s:=255;
outside:=false;
repeat
outside:=true;
if (my >= py) and (my <= py+MenuH) and
(mx >= px) and (mx <= px+MenuW) then
outside:=false;
y:=(my-py-10) div 15;
if (y<>s) and not outside then
begin
if s<>255 then
UnSelect(s);
if (y<M^[CMenu].nitems) and (y>=0) then
s:=y
else
s:=255;
if s<>255 then
select(s);
end;
if (s<>255) and bitset(M^[CMenu].items^[s].a,SubMenu) and
(mx > px + MenuW-40) then
begin
unselect(S);
M^[M^[CMenu].Items^[s].c].Back:=Cmenu;
Cmenu:=M^[CMenu].Items^[s].c;
Inc(Menus);
ox[menus]:=px;
oy[menus]:=py;
px:=px+Menuw-45;
py:=py+y*15;
PopUpMenu(M^[CMenu],px,py);
s:=255;
end;
if outside then
begin
if s<>255 then
unselect(s);
s:=255;
if menus>0 then
begin
hidem;
putimage(px,py,B[Menus]^,0);
showm;
freemem(B[Menus],ImageSize(px,py,px+MenuW,py+MenuH));
end;
Cmenu:=M^[Cmenu].Back;
px:=ox[Menus];
py:=oy[menus];
if menus>0 then
begin
dec(Menus);
outside:=false;
end;
MenuW:=M^[Cmenu].MenuW;
MenuH:=15*M^[Cmenu].NItems+15;
end;
until (click2);
menu:=255;
if s<>255 then
begin
sel:=M^[Cmenu].Items^[s].c;
if not bitset(M^[CMenu].Items^[s].a,inactive) and
not bitset(M^[CMenu].Items^[s].a,submenu) then
menu:=Sel
else
menu:=255;
end;
for Menus:=Menus downto 0 do
begin
hidem;
putimage(px,py,B[Menus]^,0);
showm;
freemem(B[Menus],ImageSize(px,py,px+MenuW,py+MenuH));
px:=ox[Menus];
py:=oy[Menus];
Cmenu:=M^[Cmenu].Back;
MenuW:=M^[Cmenu].MenuW;
MenuH:=20*M^[Cmenu].NItems;
end;
with ViewSettings do
SetViewPort(x1,y1,x2,y2,clip);
with TextSettings do
begin
SetTextStyle(Font,Direction,CharSize);
SetTextJustify(Horiz,Vert);
end;
With LineSettings do
SetLineStyle(LineStyle,Pattern,Thickness);
end;
end.
--
Jeff Watkins gt3070b@prism.gatech.edu
"All opinions are mine... so don't even think of keeping some to yourself!"