{**************************************************************************
 ***                                                                    ***
 ***                           MESSAGE BOXES                            ***
 ***                                                                    ***
 **************************************************************************}
{any sort of message, progress box, etc}
{$I compdirs} {need singleuser/multiuser flag}

unit tuimsgs;

INTERFACE

uses  {$IFDEF WIndows} windrvrs, {$ELSE} drivers, {$ENDIF}
			tui,views,dialogs, {text}
			objects,
			global,
			dattime; {progress box}

const
	{lifted from msgbox (rather than include whole thing}
	{---- Box type & icon ----}
	mfMessage      = $0000;    		{ message only}
	mfWarning      = $0001;       { warning}
	mfError        = $0002;       { Display a Error box }
	mfInformation  = $0003;       { Display an Information Box }
	mfConfirmation = $0004;       { Display a Confirmation Box }

	{---- Bleep --------------}
	mfNoBleep      = $0000;
	mfWakeUpBleep  = $0010;
	mfPayAttentionBleep  = $0020;
	mfWarningBleep = $0030;
	mfErrorBleep   = $0040;
	mfNotifyBleep  = $0050;

	{---- Buttons -----------}
	mfYesButton    = $0100;       { Put a Yes button into the dialog }
	mfNoButton     = $0200;       { Put a No button into the dialog }
	mfOKButton     = $0400;       { Put an OK button into the dialog }
	mfCancelButton = $0800;       { Put a Cancel button into the dialog }
	mfOverRideButton 	= $1000;
	mfRetryButton 		= $2000;
	mfContinueButton 	= $4000;
	mfSkipButton			= $8000;

	{--- Button sets -------}
	mfYesNo        		= mfYesButton + mfNoButton;
	mfYesNoCancel  		= mfYesButton + mfNoButton + mfCancelButton;
																{ Standard Yes, No, Cancel dialog }
	mfOKCancel     		= mfOKButton + mfCancelButton;
																{ Standard OK, Cancel dialog }
	mfCancelOverRetry = mfCancelButton or mfOverrideButton or mfRetryButton;
	mfOKOverRetry     = mfOKButton or mfOverrideButton or mfRetryButton;
	mfCancelSkip 			= mfCancelButton or mfSkipButton; {std progress box}

	{Miscellaneous buttons}
	mfButtons1         = $10000;
	mfButtons2         = $20000;
	mfButtons3         = $30000; {All three buttons}
	mfButtons4         = $40000; {All four buttons}



	{--- Common returned commands - saves using other units}
	cmCancel = Views.cmCancel;
	cmOK 		 = Views.cmOK;
	cmRetry  = Global.cmRetry;
	cmYes		 = Views.cmYes;

	{--- Progress Box Display Option bitmaps --------}
	bpCounter = $01;
	bpBar     = $02;
	bpEFTime  = $04;
	bpTime    = $05;

{===== VARIOUS BLEEPS =======}
procedure WrongKeyBleep;
procedure WrongFldBleep;
procedure WarningBleep;
procedure WakeUpBleep;   	{Bleep to pay attention for a moment - eg computer busy for a long stretch but needing occ prompts}
procedure PayAttentionBleep; {Something important has just come up}
procedure ErrorBleep;
procedure DoneBleep;  		{Bleep for saying "done job"}
procedure NotifyBleep;    {Bleep for some pause messages - ie not important but notify}

const
	MaxMsgView = 6;

type
	TMessageStr = string; {for now - maybe a pchar later}

	{General Message box - based on MessageBox function}
	{Pass mf options as you would to that routine}
	PMessageBox = ^TMessageBox;
	TMessageBox = object(TDialog)

		mfType : word;
		mfBleep : word;
		mfButtons : longint;
		LMargin : byte;
		NoButtons : byte;

		MessageView : array[1..MaxMsgView] of PStaticText;
		Button : array[1..4] of PButton;{}

		StoreEvent : TEvent;   {Store currently awaited event}

		DoneBleep : boolean;

		MinWidth : byte; {minimum width}
		IconWidth : byte; {width to leave for "icon"}

		Command : word;

		constructor Init(const NTitle, Message : TMessageStr; const NmfOptions : longint; const NHelpCtx : word);
		destructor Done; virtual;
		function GetPalette : PPalette; virtual;
		procedure Resize(const Message : TMessageStr);
		procedure SetMessage(const Message : TMessageStr);
		procedure Draw; virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
	end;

	PBarView = ^TBarView;
	TBarView = object(TView)
		Perc : integer;
		ArrowPos : integer;
		procedure Update(NPerc : integer);
		procedure Draw; virtual;
	end;

	{Progress box - % done etc}
	PProgressBox = ^TProgressBox;
	TProgressBox = object(TMEssageBox)
		NoDone, NoTotal : longint;
		PercDone : single;
		Timer : TTimer;

		EFT : TTime;
		LastEFTTimer : TTime; {for estimated finish time}
		LastEFTPerc : single; {percentage done}

		TimerView, EFTView : PStaticText;
		BarView : PBarView;

		DisplayOptions : byte;

		constructor Init(const NTitle : Tmessagestr; Message : TMessageStr; const mfOptions : longint; NHelpCtx : word);
		procedure CalcEFT;
		procedure Update(Message : TMessageStr; const NNoDone, NNoTotal : longint);
		procedure Draw; virtual;
		procedure ResetTime;
		procedure Gasp;
	end;

{General Messages}
function MessageBox(const Title, Message : TMessageStr; const mfOptions : longint; const HelpCtx : word) : word;

{Create & insert new box}
function NewMessageBox(const Title, Message : TMessageStr; const mfOptions : longint; const HelpCtx : word) : PMessageBox;
function NewProgressBox(const Title, Message : TMessageStr; const mfOptions : longint; const HelpCtx : word) : PProgressBox;

{standard shortcut messages}
procedure PauseMessage(const Title,MEssage : TMessageStr; const HelpCtx : word);         {Display and Pause for keypress}
procedure ProgramError(const Message : TMessageStr; const HelpCtx : word); {shortcut to messagebox}
procedure ProgramWarning(const Message : TMessageStr; const HelpCtx : word);        {Noticed but fixed}

function InputWarning(const Message : string; HelpCtx : word) : word;        {Fields wrong}

{---- THinking Messages to keep user informed -------}
var ThinkingAllowed : boolean;
procedure ThinkingOn(const Message : TMEssageStr);
procedure TitledThinkingOn(const Title, Message : TMessageStr);
procedure ThinkingOff;

{Errors}
procedure RecordError(const S1,S2,S3 : string);
{procedure DebugNote(const S1 : string);{}


{**************************************
 ***       IMPLEMENTATION           ***
 **************************************}

IMPLEMENTATION

uses
	{$IFDEF WIndows} wincrt, {$ELSE} crt, {$ENDIF}
	app,
	help,
	dbg,
	messtext,
	minilib;

{******************************************************
 ***                BLEEPS & SOUNDS                 ***
 ******************************************************}
{$IFDEF WIndows}
procedure Sound(F : word);
begin end;

procedure Delay(F : word);
begin end;

procedure NoSound;
begin end;
{$ENDIF}

{Internal functions}
procedure RisingBleep(LoFreq, HiFreq : word; Time : byte);
var FreqInterval : word;
		Freq : word;
begin
	FreqInterval := (HiFreq - LoFreq) div Time;
	if FreqInterval=0 then FreqInterval := 1;

	Freq := LoFreq;
	while (Freq<=HiFreq) do begin
		Sound(Freq);
		Delay(10);
		Freq := Freq + FreqInterval;
	end;{}
end;

procedure FallingBleep(HiFreq, LoFreq : word; Time : byte);
var FreqInterval : word;
		Freq : word;
begin
	{have to split up the calculation so it does an integer type rather than word}
	FreqInterval := (HiFreq -LoFreq) div Time;
	if FreqInterval=0 then FreqInterval := 1;

	Freq := HiFreq;
	while (Freq>=LoFreq) do begin
		Sound(Freq);
		Delay(10);
		Freq := Freq - FreqInterval;
	end;
end;

{=========== BLEEPS ==================}
procedure WrongKeyBleep; begin Sound(300); Delay(100); NoSound; end;
procedure WrongFldBleep; begin Sound(300); Delay(150); NoSound; end;
procedure WarningBleep;  begin Sound(150); Delay(150); NoSound; end;
procedure ErrorBleep;    begin Sound( 50); Delay(100); NoSound; Delay(100); Sound( 50); delay(200); NoSound; end;
procedure DoneBleep;     begin FallingBleep(800,100,10); RisingBleep(100,700,15); NoSound; end;
procedure WakeUpBleep;   begin RisingBleep(200,800,20); NoSound; Delay(50); RisingBleep(200,800,20); NoSound; end;
procedure PayAttentionBleep;   begin RisingBleep(200,800,20); NoSound; Delay(50); RisingBleep(200,800,20); NoSound; end;
procedure NotifyBleep;		begin RisingBleep(200,800,20); NoSound; end;


{**********************************
 ***       MESSAGE BOX          ***
 **********************************}

constructor TMessageBox.Init;
var Bounds : TRect;
		I : integer;
		Event : TEVent;
		X : integer;
		bfType : byte;

	procedure NewButton(S : string; cm : word);
	var R : TRect;
	begin
		inc(NoButtons);
		if NoButtons<=4 then begin {o/w range overflow}
			R.Assign(0,0,MaxOf(8,length(S)-Count('~',S)+4),2);
			Button[NoButtons] := New(PButton, init(R, S, cm, bfType));
			Button[NoButtons]^.GrowMode := gfGrowhiY + gfGrowLoY;
			bfType := bfNormal;
		end;
	end;

begin
	{---- Instantiate -----}
	Bounds.Assign(0,0,30,9); {dummy - see setmessage}
	inherited Init(Bounds, NTitle);
	Options := Options or ofCenterX or ofCenterY;

	Command := cmOK;  {Start by assuming OK}

	for I :=1 to MaxMsgView do MessageView[I] := nil;

	{----- Set fields --------}
	mfType 		:= NmfOptions and $0000F;
	mfBleep 	:= NmfOptions and $000F0;
	mfButtons := NmfOptions and $FFF00;

	MinWidth 	:= 10; {minimum message width}
	if mfType>mfMessage then IconWidth := 5 else IconWidth := 0; {leave room for icon}

	{if error or warning switch off idle so no more processing done while message dealt with}
	if (mfType = mfWarning) or (mfType = mfError) then begin
		IdleOff := True;
		while IsEvent do Desktop^.GetEvent(Event); {clear pending events}
	end;

	{---- BUTTONS ----}
	for I := 1 to 4 do Button[I] := nil;
	if mfButtons = 0 then mfButtons := mfContinueButton;

	{---- Create buttons ----------}
	NoButtons := 0; bfType := bfDefault;
	if mfButtons and mfOKButton >0				 	then NewButton('O~K~', 				cmOK);
	if mfButtons and mfRetryButton >0			then NewButton('~R~etry', 		cmRetry);
	if mfButtons and mfContinueButton >0 	then NewButton('C~o~ntinue', 	cmOK);
	if mfButtons and mfCancelButton >0 		then NewButton('~C~ancel', 		cmCancel);
	if mfButtons and mfYesButton >0 				then NewButton('~Y~es', 			cmYes);
	if mfButtons and mfNoButton >0 				then NewButton('~N~o', 				cmNo);
	if mfButtons and mfOverRideButton >0		then NewButton('O/ride', 			cmOverride); {no hot key for override}
	if mfButtons and mfSkipButton >0 			then NewButton('~S~kip',    	cmSkip);


	if (mfButtons>=mfButtons1) and (mfButtons<=mfButtons4) then	NewButton('Option ~1~', cmButton1);
	if (mfButtons>=mfButtons2) and (mfButtons<=mfButtons4) then	NewButton('Option ~2~', cmButton2);
	if (mfButtons>=mfButtons3) and (mfButtons<=mfButtons4) then NewButton('Option ~3~', cmButton3);
	if (mfButtons>=mfButtons4) and (mfButtons<=mfButtons4) then	NewButton('Option ~4~', cmButton4);

	{--- set size, message, view}
	MinWidth := MaxOf(MinWidth, NoButtons*10); {make sure room for buttons}

	SetMessage(Message); {& resize with new minwidth}

	{insert buttons, centralised around middle of box}
	X := (Size.X div 2) - (NoButtons * 5) + IconWidth -1; {assume about 10 chars/button}
	for I := 1 to NoButtons do begin
		Button[I]^.MoveTo(X, Size.Y-3);
		Insert(BUtton[I]);
		X := X + 10;
	end;

	SelectNext(False);  {Move to first button}
	{Don't use GetEvent as this does an idle, which has various knock-on effects}
{  StoreEvent := App.Pending;{}

	DoneBleep := False; {haven't yet done bleep}

	{--- Help Context -----}
	HelpCtx := NHelpCtx;
	if HelpCtx=hcNoContext then
		case mfType of
			mfError 	: HelpCtx := hcErrorMsg;
			mfWarning : HelpCtx := hcWarningMsg;
		else
			HelpCtx := hcMessageMsg;
		end;

end;

destructor TMessageBox.Done;
begin
	{switch back on idle}
	if (mfType = mfWarning) or (mfType = mfError) then IdleOff := False;
	inherited Done;
end;

function TMessageBox.GetPalette;
const
	ErrorCol   : string[9]  = #255#255#255#255#255#255#255#255#255;
	WarningCol : string[18] = #4#4#4#4#4#4#4#4#4    {Shortcut text}
													+ #41#42#43#44#45#46#47#48#49;   {Normal buttons}
begin
	case mfType of
		mfWarning : GetPalette := @WarningCol;
		mfError   : GetPalette := @ErrorCol;
	else
		GetPalette := inherited GetPalette;
	end;

end;

procedure TMessageBox.ReSize(const Message : TMessageStr);
var Width,L : byte;
begin
	{--- Work out size of box ----}
	{work out width first so centrex, etc works}
	Width := MinWidth;
	for L := 1 to NumLines(Message) do
		Width := MaxOf(Width, length(GetLine(message, L)));

	GrowTo(Width+IconWidth+6, MaxOf(8,NumLines(Message)+6)); {leave room for symbol & frame}
end;

procedure TMessageBox.SetMessage(const Message : TMessageStr);
var MsgLine, ViewNum, L : byte;
		S : string;

begin
	Lock;
	{delete existing message views}
	for L := 1 to MaxMsgView do begin
		if MessageView[L]<>nil then dispose(messageView[L], done);
		MessageView[L] := nil;
	end;

	ReSize(Message);

	{insert text, leaving space for images}
	MsgLine := 1; ViewNum := 1;
	while (ViewNum<=MaxMsgView) and (MsgLine<=NumLines(Message)) do begin
		S := GetLine(message,MsgLine);
		if S<>'' then begin
			MessageView[ViewNum] := InsText(@Self, ((Size.X - IconWidth - length(S)) div 2) +IconWidth, MsgLine+1, S);
			inc(ViewNum);
		end;
		inc(MsgLine);
	end;

	Unlock;
	DrawView;{}
end;

procedure TMessageBox.Draw;
var L : byte;
begin
	inherited Draw;
	case mfType of
		mfWarning : begin
			writestr(4,1, 'Ü',1);
			writestr(4,2, 'Û',1);
			writestr(4,3, 'Û',1);
			writestr(4,4, 'Û',1);

			writestr(4,6, 'Û',1);
		end;
		mfInformation : begin
			writestr(3,2, ' Û',1);

			writestr(3,4, 'ßÛ',1);
			writestr(3,5, ' Û',1);
			writestr(3,6, 'ÜÛÜ',1);
		end;
		mfConfirmation : begin
			writestr(2,1, ' ÛÛ',1);
			writestr(2,2, 'Û  Û',1);
			writestr(2,3, '  ÞÝ',1);
			writestr(2,4, '  Û',1);

			writestr(2,6, '  Û',1);
		end;
		mfError : begin
			writestr(2,2, 'Û   Û',1);
			writestr(2,3, ' Û Û',1);
			writestr(2,4, '  Û',1);
			writestr(2,5, ' Û Û',1);
			writestr(2,6, 'Û   Û',1);
		end;
	end;

	{Check for pressed buttons}
	if Command<>cmOK then {ignore cmOK - standard}
		for L := 1 to NoButtons do
			if Button[L]^.Command = Command then Button[L]^.DrawState(True);  {Redraw button in down position}
end;


procedure TMessageBox.HandleEvent;
begin
	if Event.What = evCommand then begin
		Command := Event.Command;  {Mark field, so that callers can see if keypressed}
		Draw;
	end;

	if not DoneBleep then begin
		case mfBleep of
			mfWakeUpBleep       : WakeUpBleep;
			mfPayAttentionBleep : PayAttentionBleep;
			mfWarningBleep      : WarningBleep;
			mfErrorBleep        : ErrorBleep;
			mfNotifyBleep				: NotifyBleep;
		end;
		DoneBleep := True;
	end;


	if Event.What = evCommand then {Could be any button}
		 case Event.Command of
			cmCancel, cmRetry, cmOverride, cmSkip,
			cmButton1, cmButton2, cmButton3, cmButton4 : begin
				if (State and sfModal)>0 then EndModal(EVent.COmmand); {if not modal, doing this does an endmodal desktop}
				ClearEvent(Event);
			end;
		 end;

	inherited HandleEvent(Event);

{$IFNDEF Development}
	if mfType = mfError then
{$ENDIF}
		if (Event.What = evKeyDown)
			 and (Event.KeyCode = kbAltX) then halt(0);  {allow break out}

		if (Event.What = evCommand)
			 and (Event.Command = cmQuit) then halt(0);  {allow break out}
end;

{***********************************************************************
 ***                                                                 ***
 ***                     PROGRESS BOX UTILS                          ***
 ***                                                                 ***
 ***********************************************************************}
procedure TBarView.Update;
begin
	if (NPerc>100) then Perc := 100
	else if NPerc<0 then Perc := 0
	else Perc := NPerc;

	ArrowPos := (Perc * Size.X) div 100;
end;

procedure TBarView.Draw;
var
	B: TDrawBuffer;

begin
	MoveChar(B, ' ', GetColor(1), Size.X);
	MoveChar(B, #205,GetColor(2), ArrowPos);
	MoveChar(B[ArrowPos], #16, GetColor(2), 1);
	MoveStr(B[Size.X div 2], N2Str(Perc)+'%', GetColor(2));	{% Done to appear in middle of bar}

	WriteLine(0, 0, Size.X, Size.Y, B);
end;

		{----Bar and % Done------}
{			DotLength := (trunc(propdone) * (Size.X-1) div 100);
			if DotLength<(Size.X-2) then begin
				writechar(1+Dotlength,Size.Y-1, #16, 2, 1);             {arrow}
{				writechar(2+DotLength,Size.Y-1, #32, 2, Size.X - DotLength-3); {Space out rest}
{			end;

{		end;



{***********************************************************************
 ***                                                                 ***
 ***                     PROGRESS BOX                                ***
 ***                                                                 ***
 ***********************************************************************}

constructor TProgressBox.Init;
var R : TRect;
begin
	if Message = '' then Message := space(13)+'Preparing...'+space(13);  {Minimum width & default starting message}
	if NHelpCtx = hcNoContext then NHelpCtx := hcProgressBox;

	inherited Init(NTitle,Message,mfOptions, NHelpCtx);
	SetState(sfActive, True);
	DisplayOptions := $FF;

	MinWidth := 40; {minimum width}

	Timer.Start;

	EFT.Clear; {Expected time to take}
	LastEFTTimer.SetToNow;
	LastEFTPerc := 0;
	PercDone := 0;

	{Timer}
	R.Assign(1,Size.Y-2, 11, Size.Y-1);
	New(TimerView, init(R, '00:00:00'));
	TimerView^.GrowMode := gfGrowLoY + gfGrowHiY; {stick to bottom left}
	Insert(TimerView);

	{EFT}
	R.Assign(Size.X-13, Size.Y-2, Size.X-1, Size.Y-1);
	New(EFTView, init(R,'EFT 00:00:00'));
	EFTView^.GrowMode := gfGrowLoX + gfGrowHiX + gfGrowLoY + gfGrowHiY; {stick to bottom right}
	Insert(EFTView);

	{Prop Bar}
	R.XYLD(1, Size.Y-1, Size.X-2, 1);
	New(BarView, init(R));
	BarView^.GrowMode := gfGrowHiX + gfGrowHiY + gfGrowLoY;
	Insert(BarView);
end;


{========= PROGRESS BOX DRAW ==================}
procedure TProgressBox.Draw;
begin
	if ((DisplayOptions and bpBar)=0) and (BarView<>nil) then begin
		dispose(BarView, done);
		BarView := nil;
	end;

	if EFT.Blank then
		EFTView^.Hide
	else
		EFTView^.Show; {but whatever set eft must also set eftview}

	inherited Draw;
end;


procedure TProgressBox.ResetTime;
begin
	Timer.Start;
	LastEFTTimer.SetToNow;
	EFT.Clear;
end;




{=== CALL THIS WHEN CHANGING MESSAGE OR NUMBER DONE ==========}
procedure TProgressBox.Update;
begin
	if Desktop=nil then begin
		if NNoTotal>0 then write(NNoDone *100 div NNoTotal,'%'+#13)
	end else begin
		NoDone := NNoDone; NoTotal := NNototal;
		if NoTotal>0 then PercDone:=(NoDone * 100)/NoTotal else PercDone := 0;		{proportion done}

		{---Expected finish time----}
		if trunc(PercDone)>trunc(LastEFTPerc) then
			CalcEFT
		else
			if PercDone<LastEFTPerc then begin
				LastEFTPerc := PercDone; {progress box values has been restarted without resetting timers}
				LastEFTTimer.SetTo(TimeNow);
			end;

		{---Timer---}
		{don't need to dispose() then NewStr as .digit8 is always same size as
		timerview originally had created}
		TimerView^.Text^ := Timer.Digit8; {set text}

		{---Bar-----}
		if (BarView<>nil) and (PercDone>0) then BarView^.Update(trunc(PercDone));

		{---Message--}
		if (DisplayOptions and bpCounter)>0 then
			if NoTotal>0 then
				Message := Message + N2Str(NoDone)+' of '+N2Str(NoTotal)
			else
				if NoDone>0 then Message := Message + 'at '+N2Str(NoDone);

		SetMessage(MEssage); {and draw}

		Redraw;

		Gasp;
	end;
end;

{Calculate expected finish time by looking at the time it took to do
the last percentage point}
procedure TProgressBox.CalcEFT;
var Secs,S100 : longint;
		C : char;
begin
	S100 := TimeNow.inS100 - LastEFTTimer.inS100;

{	if S100<100 then begin
		{big change in short time, on the other hand accuracy not required}

	Secs := trunc((S100/(PercDone-LastEFTPerc)) {100th seconds per %point}
										 * (100-PercDone)) 		{x number % points still to do}
										 div 100;							{convert to seconds}

	LastEFTTimer.SetTo(TimeNow); {set in case it slows down and we need to start calc after change>5%}
	LastEFTPerc := PercDone;

	if Secs<>0 then begin
		if Secs<EFT.Secs then C := #25 else if Secs>EFT.Secs then C := #24 else C := #18;
		if EFT.Blank then
			EFT.SetToSecs(Secs)
		else
			EFT.SetToSecs((EFT.Secs + Secs) div 2); {average with last}

		EFTView^.Text^ := 'EFT'+C+EFT.Digit8; {update eft timer view}
	end;
end;



procedure TProgressBox.Gasp;
var Event : TEvent;
begin
	{Force getevent, etc - do after above in case of closing}
	GetEvent(Event);
	HandleEvent(Event);
end;

{*************************************************************
 ***               STANDARD PROCEDURES                     ***
 *************************************************************}

{**********************************
 ***            MESSAGE         ***
 **********************************}
function MessageBox(const Title, Message : TMessageStr; const mfOptions : longint; const HelpCtx : word) : word;
var Box : PMessageBox;
		E : Tevent;
begin

{	if (mfOptions = mfWarning)>0 then Title := Title + ' WARNING';
	if (mfOptions = mfError)>0 then Title := Title + ' ERROR';
	if (mfOptions = mfCOnfirmation)>0 then Title := Title + ' CONFIRM';
	if (mfOptions = mfInformation)>0 then Title := Title + ' INFORMATION';{}

	if Desktop = nil then begin {not a fancy application}
		writeln(ucase(Title));
		writeln(Message);
		repeat until Keypressed; ReadKey; {Press any key}
		MessageBox := 0;
	end else begin
		{construct & execute message box}
		if (mfOptions and (mfError or mfWarning))>0 then IdleOff := True;
		Desktop^.GetEvent(E);
		New(Box, Init(Title,Message, mfOptions, HelpCtx));
		MessageBox := DeskTop^.ExecView(Box);
		Dispose(Box, Done);
		Desktop^.PutEvent(E);
		if (mfOptions and (mfError or mfWarning))>0 then IdleOff := False;
	end;
end;


function NewMessageBox;
begin
	Desktop^.Insert(New(PMessageBox, init(Title, Message, mfOptions, HelpCtx)));
	NewMessageBox := PmessageBox(Desktop^.Current);
end;


{===== STANDARD SHORTCUTS ==========}
procedure PauseMessage(const Title, Message : TMessageStr; const HelpCtx : word);
begin
	MessageBox(Title,Message, mfInformation+mfContinueButton, HelpCtx);
end;


procedure ProgramError(const Message : Tmessagestr; const HelpCtx : word);
begin
	MessageBox('PROGRAM ERROR',Message,mfError or mfErrorBleep, HelpCtx);
	RecordError('PROGRAM ERROR',Message,'');
end;

procedure ProgramWarning(const Message : Tmessagestr; const HelpCtx : word);
begin
	MessageBox('WARNING',Message,mfWarning or mfWarningBleep, HelpCtx);
	RecordError('PROGRAM WARNING',Message,'');
end;


 {Field not valid, etc}
function InputWarning(const Message : string; HelpCtx : word) : word;
begin
	if HelpCtx = hcNoContext then HelpCtx:= hcInputWarningMsg;
	MessageBox('INPUT ERROR', Message, mfWarning + mfOKButton+mfWarningBleep, HelpCtx);
end;





{**********************************
 ***       PASSING MESSAGE      ***
 **********************************}
{function NewMessageBox;
var Box : PMessageBox;
		Bounds : TRect;
		I : integer;
begin
	New(Box, Init('MESSAGE',S1,S2,mfInformation));
	Box^.Options := Box^.Options and not ofSelectable; {Don't select - just for message}
{	Desktop^.Insert(Box);                          {Display on desktop}
{	NewMessageBox := Box;                                {Return pointer to box}
{end;{}

{**********************************
 ***       PROGRESS MESSAGE     ***
 **********************************}
function NewProgressBox;
var Box : PProgressBox;
begin
	New(Box, Init(Title, Message, mfOptions, HelpCtx));
	Box^.Options := Box^.Options and not ofSelectable; {Don't select - just for message}
	if Desktop<>nil then
		Desktop^.Insert(Box)                          {Display on desktop}
	else begin
		Writeln(ucase(Title));
		writeln(Message);
	end;

	NewProgressBox := Box;                                {Return pointer to box}
end;

{**********************************
 ***       DOS PROGRESS BOX     ***
 **********************************}
{Opens up box with window for dos output}
{function NewDosProgress;
var Box : PProgressBox;
		Bounds : TRect;

begin
	New(Box, Init(NTitle, S1, S2));
	Box^.Options := Box^.Options and not ofSelectable; {Don't select - just for message}

{	Box^.GrowTo(70, Box^.Size.Y + 12); {Make room for dos window}

{	Desktop^.Insert(Box);                          {Display on desktop}

	{Create display window}
{	Box^.Owner^.MakeGlobal(Box^.Origin, Bounds.A);
	Bounds.B.X := Bounds.A.X + Box^.Size.X -3; {Fit into frame}
{	Bounds.B.Y := Bounds.A.Y + 10; {Grown space above}
{	Bounds.Move(2,Box^.Size.Y - 10); {Move off messages}

{	Window(Bounds.A.X, Bounds.A.Y, Bounds.B.X, Bounds.B.Y);
	clrscr;
{}
{	NewDosProgress := Box;                                {Return pointer to box}
{end;



{**********************************
 ***       THINKING BOX         ***
 **********************************}
type
	PTinyMessageBox = ^TTinyMessageBox;
	TTinyMessageBox = object(TDialog)
		Previous : PTinyMessageBox;
		constructor Init(Bounds : TRect; NPrev : PTinyMessageBox);
	end;

	constructor TTinyMessageBox.Init;
	begin
		inherited Init(Bounds, '');
		Previous := NPrev;
	end;

var ThinkBox : PTinyMessageBox; {most recent message}

procedure TitledThinkingOn(const Title,Message : TMEssageStr);
var	Bounds : TRect;
begin
	if Desktop=nil then begin
		writeln(Title+': '+Message);
		exit;
	end;

	{set size & location}
	if length(Message)<11 then Bounds.Assign(0,0,15,5) else Bounds.Assign(0,0,length(Message)+4,5);
	Bounds.Move(DeskTop^.Size.X-length(Message)-8, Desktop^.Size.Y*7 div 10);   {Move to bottom right}

	New(ThinkBox, Init(Bounds, ThinkBox));

	{Overwrite title because standard one has so much line to each side - gets rather big}
	InsTextCX(ThinkBox, 0, Title);

	InsTextCX(ThinkBox, 2,Message);

	ThinkBox^.Options := ThinkBox^.Options and not ofSelectable; {Don't select - just for message}
	Desktop^.Insert(ThinkBox);                          {Display on desktop}
end;

procedure ThinkingOn(const Message : TMessageStr);
begin
	if not ThinkingAllowed then exit;  {No thinking allowed! eg in speed critical places, no display}

	if Desktop <> nil then
		TitledThinkingOn('Thinking...', Message)
	else
		write(Message+'...');   {No desktop}
end;

procedure ThinkingOff;
var P :pointer;
begin
	if not ThinkingAllowed then exit;

	if Desktop= nil then
		writeln('...done')
	else
		if ThinkBox<>nil then begin
			P := ThinkBox^.Previous;
			{delete most recent message}
			Dispose(ThinkBox, done);
			{Move next ones down}
			ThinkBox := P;
		end;
end;




{***********************************
 ***        CONFIRM BOX          ***
 ***********************************}
{function ConfirmMessage;
var Box : PMEssageBox;
		PEvent, Event : TEvent;

begin
	Desktop^.GetEvent(PEvent); {store pending event}
{	New(Box, Init('Confirm',S1,S2, mfConfirmation + mfYesNo));
	Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{	ConfirmMessage := DeskTop^.ExecView(Box);
	Dispose(Box, Done);
	Desktop^.PutEvent(PEvent);
end;



{**********************************
 ***        DBASE WARNING       ***
 **********************************}
{Problem noticed but fixed/bypassed}
{function DBaseWarning(S1, S2 : string) : word;
var Box : PMessageBox;
		Event : TEvent;
begin
	WarningBleep;
	RecordError('DBase Warning: ',S1,S2);

	if Desktop = nil then begin
		writeln('DATABASE WARNING:');
		if S1<>'' then writeln('  '+S1);
		if S2<>'' then writeln('  '+S2);
		repeat until Keypressed; ReadKey; {Press any key}
{	end else begin
		New(Box, Init('DATABASE WARNING', S1,S2,mfWarning + mfContinueButton));
		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{		DBaseWarning := Desktop^.ExecView(Box);
		Dispose(Box, done);
	end;
end;

{**********************************
 ***      PROGRAM WARNING       ***
 **********************************}
{Problem noticed but fixed/bypassed}
{function ProgramWarning(S1, S2 : string) : word;
var Box : PMessageBox;
		Event : TEvent;
begin
	WarningBleep;
	RecordError('Program Warning: ',S1,S2);

	if Desktop = nil then begin
		writeln('WARNING:');
		if S1<>'' then writeln('  '+S1);
		if S2<>'' then writeln('  '+S2);
		repeat until Keypressed; ReadKey; {Press any key}
{	end else begin
		New(Box, Init('WARNING', S1,S2,mfWarning + mfContinueButton));
		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{		ProgramWarning := Desktop^.ExecView(Box);
		Dispose(Box, done);
	end;
end;

{**********************************
 ***      LOW MEMORY WARNING       ***
 **********************************}
{Problem noticed but fixed/bypassed}
{function LowMemoryWarning(S1 : string) : word;
var Box : PMessageBox;
		Event : TEvent;
begin
	WarningBleep;
	RecordError('Low Memory Warning: ',S1,'');

	if Desktop = nil then begin
		writeln('LOW MEMORY WARNING:');
		if S1<>'' then writeln('  '+S1);
		repeat until Keypressed; ReadKey; {Press any key}
{	end else begin
		New(Box, Init('WARNING', 'LOW MEMORY! $'+hex(MemAvail),S1,mfWarning + mfOKButton + mfCancelButton));
		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{		LowMemoryWarning := Desktop^.ExecView(Box);
		Dispose(Box, done);
	end;
end;

{**********************************
 ***       LOCKED WARNING       ***
 **********************************}
{Locked - cancel, override, retry}
{function LockWarning(S1, S2 : string; L : longint) : word;
var Box : PMessageBox;
		Command : word;
		C : char;
		Event : TEvent;
begin
	if L<>0 then S1 := S1 + ' In Use (Terminal '+N2Str(L)+')';

	if Desktop = nil then begin   {no desktop exists}
{		writeln('LOCK WARNING:');
		writeln(S1);
		writeln(S2);
		writeln('c - cancel, o - override, r - retry');
		WarningBleep;

		C := ReadKey;
		if C = 'c' then Command := cmCancel
		else if C = 'o' then Command := cmOverride
				 else Command := cmRetry;

	end else begin
		if length(S1)<30 then S1 := PadSpaceR(S1,30);         {widen so that box is minimum size}
{		New(Box, Init('LOCK WARNING',S1,S2,mfWarning+mfCancelOverRetry));

		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
		{$IFDEF Solitaire}
{			if L<>TerminalNo then Desktop^.DisableCommands([cmOverride]); {don't allow override if not locked by own terminal...}
		{$ENDIF}
{		WarningBleep;

		Command := Desktop^.ExecView(Box);
		Desktop^.EnableCommands([cmOverride]); {restore ability to override}
{		Dispose(Box, done);
	end;

	RecordError('Lock Warning: ',S1,S2+' Response:'+N2Str(Command));

	LockWarning := Command;
end;

{**********************************
 ***       LOCKED PAUSE         ***
 **********************************}
{Inform its locked, but can continue with provisio
(eg sentence codes - can still accept but no other changes}
{function LockPause(S1, S2 : string; L : longint) : word;
var Box : PMessageBox;
		Command : word;
		Event : TEvent;
begin
{$IFDEF SingleUser}
{	LockPause := cmOVerride;
{$ELSE}
{	WarningBleep;
	if L<>0 then S1 := '   '+S1 + ' In Use (Terminal '+N2Str(L)+')   ';
	New(Box, Init('LOCK WARNING',S1,S2,mfWarning + mfOKOverRetry));

	Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{	Command := Desktop^.ExecView(Box);
	RecordError('Lock Warning: ',S1,S2+' Response:'+N2Str(Command));
	LockPause := Command;
	Dispose(Box, done);
{$ENDIF}
{end;


{--- STORE ERROR ON FILE ---}
procedure RecordError(const S1,S2,S3 : string);
var ErrorFile : text;
		IOR : integer;
begin
{$I-}
	assign(ErrorFile, 'ERRORS');       {Set name}
	append(ErrorFile);                 {Open with append}
{$I+}
	IOR := IOResult;										{Read and clear IOResult}
	if IOR=2 then rewrite(ErrorFile);  {Assume file not found}
	Today.SetToToday; TimeNow.SetToNow;    {Initialise when}
	if IOR=0 then begin
		writeln(ErrorFile, S1+' '+Today.Digit10+ ' '+TimeNow.Digit8);  {Store what and when}
		writeln(ErrorFile, S2+', '+S3);         {and more details}
		close(ERrorFile);
	end;

	Debug.Writeln(S1+' '+S2+CRLF+S3);
end;

{replace with stuff in debug unit}
procedure DebugNote(const S1 : string);
var ErrorFile : text;
		IOR : integer;
begin
{$I-}
	assign(ErrorFile, 'DEBUG.TXT');       {Set name}
	append(ErrorFile);                 {Open with append}
{$I+}
	if IOResult=2 then rewrite(ErrorFile);  {Assume file not found}
	if IOResult=0 then begin
		writeln(ErrorFile, S1);  {Store what and when}
		close(ERrorFile);
	end;
end;


{*********************************
 ***      DBASE ERROR          ***
 *********************************}
{NASTY}                                  {Untyped pointer to avoid circular unit references}
{function DBaseError(Stream : PDataStream; S1, S2 : string) : word;
var Box : PMessageBox;
		Event : TEvent;
		Title, FName : string;

begin
	Title := 'DATABASE ERROR';
	if Stream<>nil then
		Title := Title 	+ ' '+GetFileName(Stream^.FileName)
										+ ' '+N2Str(Stream^.Status)+'/'+N2Str(Stream^.ErrorInfo);

	ErrorBleep;
	RecordError(Title,S1,S2);

	if DeskTop<>nil then begin
		while length(S1)<40 do S1 := ' '+S1+' ';  {widen box, make sure all of title in}
{		New(Box, Init(Title,S1,S2,mfError+mfContinueButton));
		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); 		{Clear next event in case it closes box}
{		DBaseError := Desktop^.ExecView(Box);
		Dispose(Box, done);
	end else begin
		writeln(Title);
		writeln('  '+S1);
		writeln('  '+S2);
		repeat until Keypressed; ReadKey; {Press any key}
{	end;
	if Stream<>nil then Stream^.Reset; {Stream^.CheckStatus('');    {Additional info & reset if nec}
{end;

{*********************************
 ***      PROGRAM ERROR        ***
 *********************************}
{NASTY}
{function ProgramError(S1, S2 : string) : word;
var Box : PMessageBox;
		Event : TEvent;
begin
	ErrorBleep;
	RecordError('PROGRAM ERROR',S1,S2);

	if DeskTop<>nil then begin
		New(Box, Init('PROGRAM ERROR',S1,S2,mfError + mfOKButton));
		Desktop^.ClearEvent(Event); Desktop^.PutEvent(Event); {so we just have to clear it}
{		ProgramError := Desktop^.ExecView(Box);
		Dispose(Box, done);
	end else begin
		writeln('PROGRAM ERROR:');
		writeln('  '+S1);
		writeln('  '+S2);
		repeat until Keypressed; Readkey;
	end;
end;{}


begin
{$IFDEF fixit}	writeln('Initialising TuiMsgs unit'); {$ENDIF}

	ThinkBox := nil;
	ThinkingAllowed := True;
end.


