
{*****************************************************
 ***               APPLICATION                     ***
 *****************************************************}
{$I compdirs}

unit tuiApp;

INTERFACE

uses
{$IFDEF WINDOWS}
	wincrt,	{windows}
	windrvrs,
{$ELSE}
	drivers, video,
{$ENDIF}
	menus, {status line}
	views, {cmhelp}
	dialogs, {radio buttons}
	app,
	kamsetup,
{	setup, kamsetup,{}
	dohelp; {CHelpcolours, runhelp}

{type
	TDesktopSetup = object(TSetup)
		AutoZoom : boolean;
		AutoCascade : Boolean;

		function Edit : word; virtual;
		procedure Load; virtual;
		procedure Store; virtual;
	end;

var
	DesktopSetup : TDesktopSetup;{}

type

	PKameleonApplication = ^TKameleonApplication;
	TKameleonApplication = object(TApplication)

		constructor Init;
		procedure Run; virtual;
		destructor Done; virtual;

		procedure InitMenuBar;    virtual;
		procedure InitStatusLine; virtual;
		procedure InitDeskTop; virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
		procedure GetEvent(var Event : TEvent); virtual;
		procedure Idle; virtual;

		procedure OutOfMemory; virtual;

		function GetPalette : PPalette; virtual;
	end;

const
		Kameleon 				: PKameleonApplication = nil;
		KameleonPalette : PPalette = nil; {program palette}
		AppMenu 				: PMenu = nil; 						{for startup2 to build}

	{--- Dynamic menus bit -----}
	OftenDirItem : array[1..3] of PMenuItem = (nil,nil,nil);
	DirCategoryMenu : PMenuItem = nil;


function DesktopEmpty : boolean; {returns whether desktop empty}
procedure ClearDesktopMessage; {instruction to clear desktop}


{colours here rather than in palettes so that palettes unit doesn't have to
keep getting loaded}
const
	{from demo help}
	CHelpColor      = #$37#$3F#$3A#$13#$13#$30#$3E#$1E;
	CHelpBlackWhite = #$07#$0F#$07#$70#$70#$07#$0F#$70;
	CHelpMonochrome = #$07#$0F#$07#$70#$70#$07#$0F#$70;

	CKameleon : array[apColor..apMonochrome] of string[Length(CAppColor)+length(CHelpColor)] =
		(CAppColor+CHelpColor, CAppBlackWhite+CHelpBlackWhite, CAppMonochrome+CHelpMonochrome);


IMPLEMENTATION

uses dattime, {for status line}
		global, minilib, {status line}
		TuiEdit, {for desktop setup/edit}
		tuiMsgs, {pause message}
		tui, {our menu bar}
		dosutils, {gasp}
		messtext,
		help, {hc xxxx}
		{$IFNDEF Windows} memory, {$ENDIF} {for setting heap size}
		dohints,
		crt,
		objects,
		tasks;

{*******ADMIN ROUTINES********************}
function DesktopEmpty : boolean;
begin
	if Desktop^.Last = Desktop^.Last^.Next then DesktopEmpty := True
																				 else DesktopEmpty := False;  {only one - the background - allowed}
end;

procedure ClearDesktopMessage;
begin
	PauseMessage('Please Note','You must have a clear Desktop to perform this'+#13#10
							 +'Please Exit all windows',hcClearDesktopMsg);
end;


{******************************
 *** KAMELEON STATUS LINE   ***
 ******************************}
type
	PKameleonStatusLine = ^TKameleonStatusLine;
	TKameleonStatusLine = object(TStatusLine)

		LastTime : TTime;

		function Hint(AHelpCtx : word) : string; virtual;
		procedure Update; virtual;
	end;

procedure TKameleonStatusLine.Update;
var	S : string;
begin
	inherited Update;

	{use global variable to display for general use}
	TimeNow.SetToNow;

	if LastTime.Sec <> TimeNow.Sec then begin {If time changed}
		if LastTime.Hour<>TimeNow.Hour then Today.SetToToday; {keep up to date}
		LastTime.SetTo(TimeNow);
		{Overwrite last bit with time & heap left - so make sure help strings are
		less than 65 chars}
		{$IFDEF RallyPress}
			WriteStr(Size.X-10,0,'³ '+TimeNow.Digit8, 1);
		{$ELSE}
			{$IFDEF Development}
				S := '³ '+TimeNow.Digit8 + ' ' + HeapLeft+' '+StackLeft;
				WriteStr(Size.X-length(S),0,S,1);
				if MemAvail<$5000 then
					WriteStr(Size.X-length(S)+11,0,HeapLeft,$FF); {flashing warning}
			{$ELSE}
				WriteStr(Size.X-10,0,'³ '+TimeNow.Digit8, 1);
			{$ENDIF}
		{$ENDIF}

	end;{}
end;

function TKameleonStatusLine.Hint;
begin
	{$IFDEF RallyPress}
		Hint := '';
	{$ELSE}
		Hint := GetHint(AHelpCtx);
		LastTime.Clear;  {If hint is being accessed, will need to redo time as well}
	{$ENDIF}
end;

type
	{=== LOGO BACKGROUND =======}
	PSBSLogoBackGround = ^TSBSLogoBackGround;
	TSBSLogoBackGround = object(TBackGround)
		 procedure Draw; virtual;
	end;


{******************************
 ***     LOGO - CENTRE TEXT ***
 ******************************}
{Normal background with a centralised logo, etc}
const
		No = 7;
		Text : array[1..No] of string[40] = ('ÚÄÄÄÄÄÄÄÄÄÄÄ¿                          ',
																				 '³ ÜÜ ÜÜ   ÜÜ³ Small Business Solutions ',
																				 '³Û   Û Û Û  ³ Nares Gladley Farm       ',
																				 '³ßÛÜ ÛßÜ ßÛÜ³ Leighton Buzzard         ',
																				 '³  Û Û Û   Û³                          ',
																				 '³ßß  ßß  ßß ³ Tel +44 (0)1525 237 456  ',
																				 'ÀÄÄÄÄÄÄÄÄÄÄÄÙ                          ');

procedure TSBSLogoBackGround.Draw;
var Buffer : TDrawBuffer;
		I,Y,X : integer;

begin
	inherited Draw; {Do normal background}
	Y := (Size.Y - No) div 3;       {One third down page}
	X := (Size.X - length(Text[1])) div 2;  {Half way across page}
	for I := 1 to No do
		WriteStr(X,Y+I, Text[I], 1);
end;


{**********************************************************
 ***             DEFINE KAMELEON APPLICATION            ***
 **********************************************************}
constructor TKameleonApplication.Init;
var	VideoMode : word;
		Palette : string;
begin
	TextMode(C80); {Resetting the mode makes sure the cursor appears again}

	{set screenmode variable - svga in video.pas must check for application = nil}
	VideoMode := S2Num(ProgramSetup.Get(siVideoMode,''));
	if VideoMode <> 0 then SVGA(VideoMode);

	inherited Init;

{	DesktopSetup.Init('Desktop');  {Extract Setup for the desktop}

	HelpCtx := hcDesktop;

	Palette := ProgramSetup.Get(siPalette,'');
	if Palette <> '' then AppPalette := apUser;
end;

procedure TKameleonApplication.Run;
begin
	RunAllTasks(StartupTasks);

	inherited Run;
end;

destructor TKameleonApplication.Done;
begin
	{close all views first}
	Message(@Self, evCommand, cmCloseAll, nil);
	RunAllTasks(ShutDownTasks);{}

	inherited Done;
end;

{========== SET UP STATUS LINE ====================}
procedure TKameleonApplication.InitStatusLine;
var
	Bounds: TRect;                            {Status Line Boundary}
	S : string[3];

begin
	GetExtent(Bounds);                          {Get Screen Size Boundaries}
	Bounds.A.Y := Bounds.B.Y -1;              {Move top of Stat Line to 1 above bottom}
	S := ProgVer.Release; if DataVer.Release<>ProgVer.Release then S := S+'/'+DataVer.Release; {show the data version too}

	StatusLine := New(PKameleonStatusLine, Init(Bounds,             {Create Status Line}
		NewStatusDef(0, $FFFF,                                  {Set range of help contexts?!}
			NewStatusKey(
				{$IFDEF RallyPress}
				'555 Safari Rally 1997',
				{$ELSE}
				'Kameleon '+N2Str(ProgVer.Main)+'.'+N2Str(ProgVer.Sub)+S, {version from global unit}
				{$ENDIF}
				kbNone,
				cmShowAbout,
			NewStatusKey(
				'',
				kbAltX,
				cmQuit,
			nil)),
		nil)                                              {No more definitions}
	));
end;

{=========== SET UP MENU BAR =====================}
procedure TKameleonApplication.InitMenuBar;
var	R: TRect;

begin
{	AddItemEnd(AppMenu,
		NewItem('E~x~it', '', kbAltX, cmQuit, hcNoContext,
		nil)
	);{just do a check in handleevent}

	GetExtent(R);
	R.B.Y := R.A.Y + 1;

	MenuBar := New(PMenuBar, init(R, AppMenu)); {see startup2}

	{switch off pre-process event handling, so focussed event gets a chance to
		get to the event first, but do postprocess in case it's not handled?}
	MenuBar^.Options := (MenuBar^.Options and not ofPreProcess) or ofPostProcess;
end;


procedure TKameleonApplication.InitDeskTop;
var R : TRect;
begin
	GetExtent(R);  {Get available area for desktop, minus for status line & menu bar}
	R.Grow(0,-1);
	Desktop := New(PDesktop, init(R));

	{set help context}
	Desktop^.HelpCtx := hcDesktop;

	{change background to SBS logo type}
	Desktop^.GetExtent(R);{}
	dispose(Desktop^.BackGround, done);
	Desktop^.BackGround := New(PSBSLogoBackGround, Init(R,#177)); {Logo background with slightly darker fuzzy background}
	Desktop^.Insert(Desktop^.Background);
end;


procedure TKameleonApplication.GetEvent(Var Event : TEvent);
var hcType : word;
begin
	inherited GetEvent(Event);

	{check for macros}
{	if (Event.What=evNothing) and (CurrentMacro<>'') then
		GetMacroEvent(event);{}

{	if Event.What = evKeyBoard then
		writeln(Event.KeyCode); {for getting scan codes}

	{check for help here, as handleevent might not be called}
	{(keep task checks for menu-generated commands}
	if (Event.What=evKeyDown) then
		case Event.KeyCode of
			kbHelp				: begin RunHelp;			ClearEvent(Event); end;
			kbHelpLow			: begin RunHelpLow;   ClearEvent(Event); end;
			kbHelpIndex   : begin RunHelpIndex; ClearEvent(Event); end;
			kbHelpLast    : begin RunHelpLast;  ClearEvent(Event); end;
		end;
end;

procedure TKameleonApplication.HandleEvent;
var P : pointer;
begin
	inherited HandleEvent(Event); {get events, check status line}

	if Event.What=evCommand then

		case Event.Command of
			{desktop command - close all}
			cmCloseAll : 	repeat
											P := Message(Desktop, evCommand, cmClose, nil)
										until P = nil;

			{change video mode}
			cmVideo..cmOtherVideo : begin
				SVGA(Event.Command);
				{save in program setup?}
				ProgramSetup.Put(siVideoMode, N2Str(Event.Command));
				ProgramSetup.Store;
			end;

		else
			{Check task list}
			RunTask(DesktopTasks, Event.Command);
		end;

{	if (Event.What = evKeyDown) and (Event.KeyCode = kbAltX) then
		StartEvent(evCommand, cmQuit);{see status line}

end;


procedure TKameleonApplication.Idle;

begin
	{only do idle if idle flag not set - so that program errors, etc can
	stop lists from continuing to be drawn in the background, etc}
	if not IdleOff then begin
		Gasp; {Gasp! give OS/2 a chance to breath...?}
		inherited Idle;

		{Call printer driver to print a line if anything needs printed}
		RunAllTasks(IdleTasks);
	end;
end;

procedure TKameleonApplication.OutofMemory;
begin
	RunAllTasks(LowMemoryTasks);
	ProgramWarning('Not enough memory to complete operation'+CRLF+CRLF+'Please close some views & try again',hcMemoryLowMsg);
end;


function TKameleonApplication.GetPalette : PPalette;
begin
	GetPalette := @CKameleon[AppPalette];
end;



begin
{$IFDEF fixit}	writeln('TuiApp...'); {$ENDIF}

	Kameleon := nil;

	IdleOff := False;

{	RegisterTask(DesktopTasks, cmDesktopSetup, @EditDesktopSetup);{}

	KameleonPalette := @CKameleon[apColor]; {default}
end.
