Path: utzoo!utgpu!news-server.csri.toronto.edu!mailrus!iuvax!rutgers!mephisto!prism!gt3070b
From: gt3070b@prism.gatech.EDU (Jeff Watkins)
Newsgroups: comp.lang.pascal
Subject: Re: Units -- GMenu
Summary: Graphic Menus
Message-ID: <9927@hydra.gatech.EDU>
Date: 30 May 90 02:08:44 GMT
References: <9918@hydra.gatech.EDU> <9919@hydra.gatech.EDU> <9920@hydra.gatech.EDU> <9922@hydra.gatech.EDU> <9923@hydra.gatech.EDU> <9924@hydra.gatech.EDU> <9925@hydra.gatech.EDU>
Organization: Georgia Institute of Technology
Lines: 356

{
	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!"