unit Gadgets;

interface

{ *	This unit provides an indirect interface into GadTools, to make things
	a little easier to deal with
}

uses
	Exec, Base, Intuition, GadTools, Utility;

const
	MENUNUM		= $001F;	{ Mask for Code in MENUPICK message to get
								the number of the menu }
	MENUSHIFT	= 0;		{ Amount to 'shr' Code }

	ITEMNUM		= $07E0;	{ Mask to get the item number }
	ITEMSHIFT	= 5;		{ Amount to shift }
	
	SUBNUM		= $F800;	{ Mask to get the submenu item number }
	SUBSHIFT	= 11;		{ Amount to shift }
	
	NOSUB		= $1F;		{ Value for "no sub-item" }
var
	okGadgets	: boolean; { TRUE if everything initializes well }
	
procedure AddTitle(title: string);

procedure AddChoice(itemname: string;cmd: char;flags: word;
					mx: longint;main: boolean);

function MakeMenu(win: pWindow): boolean;

implementation

{ Remember that you can change these maximums as you need to }

const
	MAX_NEWMENU		= 200;	{ Maximum number of menu items per menu strip }
	MAX_MENUSTRBUF	= 4000; { Maximum 4K worth of menu choice strings }
	MAX_MENUSTRIPS	= 20;	{ Maximum number of menu strips }
type
	tMenuStripItem	= record
		menu	: pMenu;	{ Actual menu strip put together }
		window	: pWindow;	{ Window attached to }
		visinfo	: pointer;	{ Visual info for menu }
		startp	: word;		{ Start position of strings in MenuStrBuf }
		endp	: word;		{ End position of strings in MenuStrBuf }
	end;
	tNewMenuArray	= array[1..MAX_NEWMENU] of tNewMenu;
	tMenuStrBuf		= array[1..MAX_MENUSTRBUF] of char;
	tMenuStripList	= array[1..MAX_MENUSTRIPS] of tMenuStripItem;
		
var
	NewMenus	: tNewMenuArray;
	topNewMenu	: word;
	MenuStrBuf	: tMenuStrBuf;
	topMenuStr	: word;
	MenuStripList	: tMenuStripList;
	topMenuStrip	: word;
	menustarted	: boolean;	{ Has a menu been started? }
	ExitSave	: pointer;
{----------------------------------------------------------}
procedure AddTitle(title: string);

{ *	Adds a title for a menu }

begin
	if (topNewMenu+1>=MAX_NEWMENU) or
		(topMenuStr+length(title)+2>=MAX_MENUSTRBUF) then
		exit;
	if not menustarted then
	begin
		if topMenuStrip>=MAX_MENUSTRIPS then
			exit;
		inc(topMenuStrip);
		with MenuStripList[topMenuStrip] do
		begin
			menu := nil;
			window := nil;
			startp := topMenuStr+1;
			endp := startp
		end;
		menustarted := TRUE
	end;
	inc(topNewMenu);
	with NewMenus[topNewMenu] do
	begin
		nm_Type := NM_TITLE;
		title := title+#0;
		move(title[1],MenuStrBuf[topMenuStr+1],length(title));
		nm_Label := @MenuStrBuf[topMenuStr+1];
		inc(topMenuStr,length(title));
		nm_CommKey := nil;
		nm_Flags := 0;
		nm_MutualExclude := 0;
		nm_UserData := nil
	end;
end;
{----------------------------------------------------------}
procedure AddChoice(itemname: string;cmd: char;flags: word;
					mx: longint;main: boolean);

{ *	Adds a choice to a menu.
	ITEMNAME is the text of the menu item, '_' for a bar.
	CMD is the keyboard shortcut command, #0 for none
	FLAGS include CHECKED, CHECKIT and MENUTOGGLE
	MX is the mutual exclude mask (add all 1 shl itemnumbers together)
		Use zero here if the choice is not of a CHECKIT type
	MAIN is TRUE if this is a main item, FALSE if it is a sub-item }

var
	command	: string[2];
begin
	if topMenuStr+ord(itemname<>'_')*(length(itemname)+2+2*ord(cmd>#0))
		>=MAX_MENUSTRBUF then
		exit;
	if not menustarted or (topNewMenu+1>=MAX_NEWMENU) then
		exit;
	inc(topNewMenu);
	with NewMenus[topNewMenu] do
	begin
		if main then
			nm_Type := NM_ITEM
		else
			nm_Type := NM_SUB;
		if itemname='_' then
		begin
			nm_Label := STRPTR(NM_BARLABEL);
			nm_CommKey := nil
		end
		else
		begin
			itemname := itemname+#0;
			move(itemname[1],MenuStrBuf[topMenuStr+1],length(itemname));
			nm_Label := @MenuStrBuf[topMenuStr+1];
			inc(topMenuStr,length(itemname));
			if cmd>#0 then
			begin
				command := cmd+#0;
				move(command[1],MenuStrBuf[topMenuStr+1],length(command));
				nm_CommKey := @MenuStrBuf[topMenuStr+1];
				inc(topMenuStr,length(command));
			end
			else
				nm_CommKey := nil;
			MenuStripList[topMenuStrip].endp := topMenuStr
		end;
		nm_Flags := flags;
		nm_MutualExclude := mx;
		nm_UserData := nil
	end
end;
{----------------------------------------------------------}
function MakeMenu(win: pWindow): boolean;

{ * This function makes and attaches the menu to the given
	window, returning TRUE for a successful operation
}
var
	taglist		: tTagItem;
	menumade	: boolean;
begin
	if not menustarted or (topNewMenu=0) then
	begin
		MakeMenu := FALSE;
		exit;
	end;
	menumade := FALSE;
	inc(topNewMenu);
	with NewMenus[topnewmenu] do
	begin
		nm_Type := NM_END;
		nm_Label := nil;
		nm_CommKey := nil;
		nm_Flags := 0;
		nm_MutualExclude := 0;
		nm_userData := nil
	end;
	with taglist do
	begin
		ti_Tag := TAG_END;
		ti_Data := 0
	end;
	with MenuStripList[topMenuStrip] do
	begin
		menu := CreateMenusA(@NewMenus[1],@taglist);
		if menu<>nil then
		begin
			visinfo := GetVisualInfoA(win^.WScreen,@taglist);
			if visinfo<>nil then
			begin
				if LayoutMenusA(menu,visinfo,@taglist) then
				begin
					if SetMenuStrip(win,menu) then
					begin
						menumade := TRUE;
						window := win
					end
					else
					begin
						FreeMenus(menu);
						FreeVisualInfo(visinfo)
					end
				end
				else
					FreeVisualInfo(visinfo)
			end
		end
	end;
	menustarted := FALSE;
	topNewMenu := 0;
	MakeMenu := menumade
end;
{----------------------------------------------------------}
procedure CloseTopMenu;

begin
	with MenuStripList[topMenuStrip] do
	begin
		ClearMenuStrip(window);
		FreeMenus(menu);
		FreeVisualInfo(visinfo);
		topMenuStr := startp-1
	end;
	dec(topMenuStrip)
end;
{----------------------------------------------------------}
{$F+}
procedure CloseGadgets;

begin
	if menustarted then
	begin
		dec(topMenuStrip);
		menustarted := FALSE
	end;
	while topMenuStrip>0 do
		CloseTopMenu;
	ExitProc := ExitSave; { Restore exit pointer }
	if GadToolsBase<>nil then
		CloseLibrary(GadToolsBase)
end;
{----------------------------------------------------------}
{ Initialization section patches exit routine to close library
  upon exit and initializes the library
}

begin
	okGadgets := FALSE;
	GadToolsBase := nil;
	topMenuStr := 0;
	topNewMenu := 0;
	topMenuStrip := 0;
	menustarted := FALSE;
	ExitSave := ExitProc;
	ExitProc := @CloseGadgets; { Add CloseGadgets to exit chain }
	GadToolsBase := OpenLibrary('gadtools.library',0);
	if GadToolsBase<>nil then
		okGadgets := TRUE
end.