unit Base;

interface

{ *	This unit provides a simple cleans-up-after-itself interface to the
	Graphics and Intuition libraries.  USEing this unit will automatically
	open the Intuition and Graphics libraries, which will be closed when
	your program ends.
	
	Also provided are two functions to open simple screens and windows.
	These will also be closed when your program ends, regardless.
}

uses
	Exec, Intuition, Graphics;
var
	okBase	: boolean; { TRUE if everything initializes well }

{--- Available functions ---}
function NewScreen(wide,high,deep,view: word;
					title: string;custom: boolean): pScreen;

function NewWindow(left,top,wide,high: word;
					f_idcmp,f_settings: longint;
					wmin,hmin,wmax,hmax: word;
					wtitle: string;wscreen: pScreen): pWindow;

implementation

const
	BASE_SCREEN = 1;	{ Screen stored in list ID }
	BASE_WINDOW = 2;	{ Window stored in list ID }
	MAX_BASE_LIST = 20;	{ Max. number of screens+windows that
							would be automatically taken care of }
type
	base_list = record { Record of all opened screens and windows }
		case kind : byte of
			BASE_SCREEN : (pscr : pScreen);
			BASE_WINDOW : (pwin : pWindow)
	end;
var
	ExitSave	: pointer;	{ Temporary storage for the exit procedure }
	BaseList	: array[1..MAX_BASE_LIST] of base_list;	{ Auto. list }
	topBaseList	: byte;		{ How many items in the auto. list }
{----------------------------------------------------------}
procedure CloseBaseList;

{ *	Closes the last screen or window that was opened }

var
	test	: boolean;
begin
	if topBaseList>0 then	{ Any opened with NewWindow or NewScreen? }
	begin
		with BaseList[topBaseList] do	{ If so, close the last one }
			case kind of
				BASE_WINDOW :
					CloseWindow(pwin);
				BASE_SCREEN :
					test := CloseScreen(pscr)
			end;
		dec(topBaseList)	{ Decrease the total number of them }
	end
end;
{----------------------------------------------------------}
{$F+}
procedure CloseBase;

{ * This is put in the list of procedures to go through when
	the program exits.  It closes all screens and windows
	opened with NewWindow or NewScreen, and closes the graphics
	and intuition libraries as well
}

begin
	ExitProc := ExitSave;	{ Restore exit pointer to original }
	while topBaseList>0 do	{ Close all New.. Windows and Screens }
		CloseBaseList;
	if GfxBase<>nil then	{ Close graphics library if opened }
		CloseLibrary(pLibrary(GfxBase));
	if IntuitionBase<>nil then	{ Close intuition library if opened }
		CloseLibrary(pLibrary(IntuitionBase))
end;
{----------------------------------------------------------}
function NewScreen(wide,high,deep,view: word;
					title: string;custom: boolean): pScreen;

{ * A quick function to open a screen of dimensions WIDExHIGH,
	with DEEP number of planes. 
	VIEW is the viewmodes (HIRES, LACE, etc.)
	TITLE is the title for the screen bar.
	CUSTOM is TRUE for a custom screen, FALSE for a workbench-
		type of screen.
	Returns a pointer to the screen that was opened, or NIL
		if the operation was not successful
}

var
	new_scr	: tNewScreen;
	act_scr : pScreen;					
begin
	if topBaseList>=MAX_BASE_LIST then
	begin
		NewScreen := nil;
		exit
	end;
	with new_scr do
	begin
		LeftEdge := 0;
		TopEdge := 0;
		Width := wide;
		Height := high;
		Depth := deep;
		DetailPen := 0;
		BlockPen := 1;
		ViewModes := view;
		if custom then
			Type_ := CUSTOMSCREEN
		else
			Type_ := WBENCHSCREEN;
		Font := nil;
		if title='' then
			DefaultTitle := nil
		else
		begin
			title := title+#0;	{ Make it a zero-terminated string }
			DefaultTitle := @title[1]
		end;
		Gadgets := nil;
		CustomBitMap := nil
	end;
	act_scr := OpenScreen(@new_scr);
	if act_scr<>nil then	{ Did it open okay? }
	begin
		inc(topBaseList);	{ Add it to the auto. list }
		with BaseList[topBaseList] do
		begin
			kind := BASE_SCREEN;
			pscr := act_scr
		end;
		NewScreen := act_scr
	end
	else
		NewScreen := nil
end;
{----------------------------------------------------------}
function NewWindow(left,top,wide,high: word;
					f_idcmp,f_settings: longint;
					wmin,hmin,wmax,hmax: word;
					wtitle: string;wscreen: pScreen): pWindow;

{ *	A quick function to open a window, upper left at LEFT,TOP,
	with dimensions WIDExHIGH.
	F_IDCMP are the IDCMP flags to look for (CLOSEWINDOW_,
		VANILLAKEY, etc.)
	F_SETTINGS are the display flags to set (WINDOWCLOSE,
		WINDOWDRAG, etc.)
	WMIN,HMIN are the minimum dimensions of the window to allow.*
	WMAX,HMAX are the maximum dimensions of the window to allow.*
	(*Set all to zero if the window is not resizeable, otherwise
	  the window will be set to be resizeable)
	WTITLE is the title of the window.
	WSCREEN is a pointer to the screen to put it on, NIL for the
		Workbench screen.
	Returns a pointer to the opened window, or NIL if the
		operation was not successful
}

var
	new_win		: tNewWindow;
	act_win		: pWindow;
begin
	if topBaseList>=MAX_BASE_LIST then { Too many already? }
	begin
		NewWindow := nil;
		exit
	end;
	with new_win do
	begin
		LeftEdge := left;
		TopEdge := top;
		Width := wide;
		Height := high;
		DetailPen := -1;
		BlockPen := -1;
		IDCMPFlags := f_idcmp;
		Flags := f_settings;
		FirstGadget := nil;
		CheckMark := nil;
		if wtitle='' then
			Title := nil
		else
		begin
			wtitle := wtitle+#0;	{ Make a null-terminated title }
			Title := @wtitle[1]
		end;
		Screen := wscreen;
		BitMap := nil;
		MinWidth := wmin;
		MinHeight := hmin;
		MaxWidth := wmax;
		MaxHeight := hmax;
		if wmin or hmin or wmax or hmax>0 then	{ Minimums and maximums? }
			Flags := Flags or WINDOWSIZING;		{ Must be resizeable }
		if Screen=nil then
			Type_ := WBENCHSCREEN
		else
			Type_ := CUSTOMSCREEN
	end;
	act_win := OpenWindow(@new_win);
	if act_win<>nil then	{ Opened okay? }
	begin
		inc(topBaseList);	{ Add it to the list }
		with BaseList[topBaseList] do
		begin
			kind := BASE_WINDOW;
			pwin := act_win
		end;
		NewWindow := act_win
	end
	else
		NewWindow := nil
end;
{----------------------------------------------------------}
{ Initialization section diverts the exit routine to CloseBase
  upon exit and initializes the libraries that will be used
}

begin
	okBase := FALSE;	{ Not everything is okay yet }
	IntuitionBase := nil;	{ Hasn't been opened yet, set to NIL }
	GfxBase := nil;			{ Same here }
	topBaseList := 0;		{ Nothing in the auto. list }
	ExitSave := ExitProc;	{ Store the current exit procedure }
	ExitProc := @CloseBase; { Add CloseBase to exit chain }
	IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',0));
	if IntuitionBase<>nil then
	begin
		GfxBase := pGfxBase(OpenLibrary('graphics.library',0));
		if GfxBase<>nil then
			okBase := TRUE
	end
end.