implementation module EdDialogs;

import StdClass,StdInt,StdString,StdChar,StdArray,StdBool;
import deltaIOSystem, deltaDialog, deltaWindow, deltaControls, deltaTimer, deltaFont;
import deltaFileSelect, deltaPicture;


import EdProgramState, EdPath, EdMyIO;
from EdLists import StringToInt;

EdSelectInputFile :: !*ProgState !*(IOState *ProgState) -> *(Bool,{#Char},*ProgState,*IOState *ProgState);
EdSelectInputFile s io
	=	SelectInputFile s io;

EdSelectOutputFile :: !.{#Char} !.{#Char} !*ProgState !*(IOState *ProgState) -> *(Bool,{#Char},*ProgState,*IOState *ProgState);
EdSelectOutputFile n p s io = SelectOutputFile n p s io;

EdSelectDir :: !*ProgState !*(IOState *ProgState) -> *(Bool,{#Char},*ProgState,*IOState *ProgState);
EdSelectDir s io = SelectDir s io;


//	When the Help file is selected the following alert will be shown:

HelpFileAlert :: !ProgState !IO -> (!ProgState, !IO);
HelpFileAlert ps io 
	=  AlertDialog [	"The Help file \"" +++  HelpFile +++ "\"" ,
						"cannot be opened."] ps io;

AlertDialog	:: ![String] !ProgState !IO -> (!ProgState, !IO );
AlertDialog mes ps io = (ps`, io`);
	where {
		(_,ps`,io`)= OpenNotice (Notice mes (NoticeButton 1 "OK") []) ps io;
	};

//	Alert flashes the window as a kind of alert

Alert :: !IO -> IO;
Alert io =  Beep io;

//	ShowInfo shows information (a String List) in a dialog box  depending on 1st arg.

TextWidth	:== 390;
NrTextItems	:== 7;
TimeToWait	:== 300;

ShowInfo :: !Bool !Bool ![String] !ProgState !IO -> ProgIO;
ShowInfo verbose wait [] prog io
	= (prog, io);
ShowInfo verbose wait [header : comment] prog=:{editor={defaults={Defaults | dproject={eo}}}} io
	| not verbose		= (prog, io);
	| wait && present	= (prog, OpenTimer timerdef ioa);
	| wait				= (prog, OpenTimer timerdef iob);
	| present			= (prog, ioa);
						= (prog, iob);
	where {
	dialog				= CommandDialog DInfoID "Messages" [] 1 dialogdef;
	dialogdef			= MakeDynamicStrings eo header comment;
	dialogchange		= ChangeDynamicStrings eo header comment;
	timerdef			= Timer 3 Able TimeToWait CloseAfteraWhile;
	ioa					= ChangeDialog DInfoID dialogchange io1;
	iob					= OpenDialog dialog io1;
	(present, _, io1)	= GetDialogInfo DInfoID io;
	};

CloseAfteraWhile :: !TimerState !ProgState !IO -> ProgIO;
CloseAfteraWhile timerstate prog io
	= (prog, CloseInfo io);
	
MakeDynamicStrings :: !EditOptions !String ![String] -> [DialogItem ProgState IO];
MakeDynamicStrings {EditOptions | fontname,fontsize} header comment
	=	[	DialogIconButton 1 Left ((0,0),(TextWidth,height)) string Unable ButIdle
		:	MakeIconButtons	(dec NrTextItems) 2 margin comment offset height rfont
		];
	where {
	(_,rfont)		= SelectFont fontname style fontsize;
	(_,style,_)		= DefaultFont;
	offset			= at + ld;
	height			= at + dt + ld;
	(at,dt,_,ld)	= FontMetrics rfont;
	margin			= 4 * FontCharWidth 'W' rfont;
	string state	= DrawDynamicString offset height rfont 0 header;
	};
	
MakeIconButtons :: !Int !Int !Int ![String] !Int !Int !Font -> [DialogItem ProgState IO];
MakeIconButtons 0 id margin lines offset height font
	= [ DialogButton id Right "Cancel" Able CloseInfoButton ];
MakeIconButtons cnt id margin [] offset height font
	=	[	DialogIconButton id (YOffset (dec id) (MM 1.0)) ((0,0),(TextWidth,height)) string Unable ButIdle
		:	MakeIconButtons (dec cnt) (inc id) margin [] offset height font
		];
	where {
	string state = [];
	};
MakeIconButtons cnt id margin [f:r] offset height font
	=	[	DialogIconButton id (YOffset (dec id) (MM 1.0)) ((0,0),(TextWidth,height)) string Unable ButIdle
		:	MakeIconButtons (dec cnt) (inc id) margin r offset height font
		];
	where {
	string state = DrawDynamicString offset height font margin f;
	};
	
ChangeDynamicStrings :: !EditOptions !String ![String] -> [DialogChange ProgState];
ChangeDynamicStrings {EditOptions | fontname,fontsize} header comment
	| not_empty	= [ChangeIconLook 1 string : rest];
				= rest;
	where {
	(_,rfont)		= SelectFont fontname style fontsize;
	(_,style,_)		= DefaultFont;
	offset			= at + ld;
	height			= at + dt + ld;
	(at,dt,_,ld)	= FontMetrics rfont;
	margin			= 4 * FontCharWidth 'W' rfont;
	rest			= ChangeIconButtons (dec NrTextItems) 2 margin comment offset height rfont;
	not_empty		= size header <> 0;
	string state	= DrawDynamicString offset height rfont 0 header;
	};
	
ChangeIconButtons :: !Int !Int !Int ![String] !Int !Int !Font -> [DialogChange ProgState];
ChangeIconButtons 0 id margin lines offset height font
	= [];
ChangeIconButtons cnt id margin [] offset height font
	= [];
ChangeIconButtons cnt id margin [f:r] offset height font
	| not_empty	=	[	ChangeIconLook id string
					:	rest
					];
				=	rest;
	where {
	string state	= DrawDynamicString offset height font margin f;
	not_empty		= size f <> 0;
	rest			= ChangeIconButtons (dec cnt) (inc id) margin r offset height font;
	};
	
DrawDynamicString :: !Int !Int !Font !Int !String -> [Picture -> Picture];
DrawDynamicString offset height font margin line
	= [	SetFont font,
		EraseRectangle ((0,0),(TextWidth,height)),
		MovePenTo (margin,offset),
		DrawString line ];
			
CloseInfoButton	:: !DialogInfo !ProgState !IO -> ProgIO;
CloseInfoButton dialog prog io =  (prog, CloseInfo io);
		
// CloseInfo closes the info dialog box
		
CloseInfo :: !IO -> IO;
CloseInfo io
	= ActivateCurrentWindow (CloseDialog DInfoID (CloseTimer 3 io));
	
//	Conversion from booleans to MarkState/SelectState and back

MarkToBool :: !MarkState -> Bool;
MarkToBool Mark     =  True;
MarkToBool nomark	=  False;

BoolToMark :: !Bool -> MarkState;
BoolToMark mark	| mark	= Mark
						= NoMark;

SelectToBool :: !SelectState -> Bool;
SelectToBool Able	=  True;
SelectToBool unable	=  False;

BoolToSelect :: !Bool -> SelectState;
BoolToSelect select	| select	= Able;
								= Unable;

// Conversion from memory size to strings and back
    
Mega	:== 1048576;
Kilo	:== 1024;

IntToMemSize :: !Int -> String;
IntToMemSize mem
	| mega && mem <> 0
		=  megamemstr;
	| kilo && mem <> 0
		=  kilomemstr;
		=  memstr;
	where {
		mega		= mem rem Mega  == 0;
		kilo		= mem rem Kilo  == 0;
		megamemstr	= toString (mem / Mega)  +++ "M";
		kilomemstr	= toString (mem / Kilo)  +++ "K";
		memstr		= toString mem;
	};

MemSizeToInt :: !String -> Int;
MemSizeToInt size =  scale * scaleless;
	where {
		scale		= GetScale size;
		scaleless	= StringToInt (RemoveScale size);
	};
	
GetScale :: !String -> Int;
GetScale num
	| lennum == 0
		=  0;
	| last == 'k' || last == 'K'
		=  Kilo;
	| last == 'm' || last == 'M'
		=  Mega;
		=  1;
	where {
		last	= num .[dec lennum];
		lennum	= size num;
	};
		
RemoveScale	:: !String -> String;
RemoveScale num
	| lennum < 2
		=  num;
	| last == 'k' || last == 'K' || last == 'm'	|| last == 'M'
		=  num % (0, lennum - 2);
		= num;
	where {
		lennum	= size num;
		last	= num.[dec lennum];
	};

//	Idle Dialog Function
	
DFIdle	:: !DialogInfo !(DialogState *prog (IOState *prog)) -> DialogState *prog (IOState *prog);
DFIdle ddef dstate =  dstate;

//	Idle Button Function

ButIdle :: !DialogInfo !*prog !(IOState *prog) -> (*prog, IOState *prog);
ButIdle ddef prog io =  (prog,io);

//	Cancel Button Function
	
Cancel :: !DialogInfo !ProgState !IO -> ProgIO;
Cancel dialog prog io = (prog, ActivateCurrentWindow (CloseActiveDialog io));

//	Activates the current window, if any
	
ActivateCurrentWindow :: !IO -> IO;
ActivateCurrentWindow io
	| present	= ActivateWindow wdid io1;
				= io1;
	where {
		(present,wdid,io1)	= GetActiveWindow io;
	};

//	Show/Change the items of the Font and Size dialogs

FoxWid	:== 260;
FoxHgt	:== 32;
FoxDim	:== (FoxWid, FoxHgt);    

LazyFox	:: !FontName !FontSize !SelectState -> [DrawFunction];
LazyFox font size abty
	=  [SetFont rfont, MovePenTo (0,base), DrawString "The quick brown dog jumps over the lazy fox"];
	where {
	(_,rfont)				= SelectFont font [] size;
	base | ascent > middle	= ascent;
							= middle;
	(ascent,_,_,_)			= FontMetrics rfont;
	middle					= FoxHgt / 2;
	};
	
ChangeSizesList	:: !Int !Int !EditOptions !(DialogState ProgState IO) -> DialogState ProgState IO;
ChangeSizesList foxid sizeid {EditOptions | fontname,fontsize} dstate
	= 	ChangeIconLook foxid (LazyFox fontname (StringToInt sstr)) dstate``;
	where {
	sstr			= GetScrollingListItem sizeid info;
	(info,dstate``)	= DialogStateGetDialogInfo dstate`;
	dstate`			= ChangeScrollingList sizeid (toString fontsize) (MakeSizeItems fontname) dstate;
	};

ChangeLazyFox :: !Int !EditOptions !(DialogState ProgState IO) -> DialogState ProgState IO;
ChangeLazyFox foxid {EditOptions | fontname, fontsize} dstate
	=  ChangeIconLook foxid (LazyFox fontname fontsize) dstate;

//	Create the items of the Font and Size pop-up menus
MakeFontItems :: [ItemTitle];
MakeFontItems = SortStr FontNames;

MakeSizeItems :: !FontName -> [ItemTitle];
MakeSizeItems font =  CreateSizeItems (FontSizes font);

CreateSizeItems	:: ![FontSize] -> [ItemTitle];
CreateSizeItems [size : rest]	=  [toString size : CreateSizeItems rest];
CreateSizeItems []				=  [];

// Miscellaneous functions

SortStr	:: ![String] -> [String];
SortStr [hd : tl]	=  [first : SortStr rest];
	where {
		(first,rest)= RemoveFirstString hd tl;
	};
SortStr []			=  [];

RemoveFirstString :: !String ![String] -> (!String, ![String]);
RemoveFirstString first [str : rest]
	| first < str	= (first1, [str : rest1]);
	| first == str	= (first1, rest1);
					= (first2, [first : rest2]);
	where {
		(first1,rest1)= RemoveFirstString first rest;
		(first2,rest2)= RemoveFirstString str   rest;
	};
RemoveFirstString first []
					=  (first, []);
					
//
//	Makes message explaining why the executable file is out of date
//	link		: some .obj files are younger than executable
//	exec_exists	: executable exists
//	a_opt		: application options has been modified
//

MakeExecOutOfDateMessage :: !Pathname !Bool !Bool !Bool -> [String];
MakeExecOutOfDateMessage path exec exec_exists a_opt
	= lines`;
	where {
	lines` | exec || a_opt	= ["" : lines2];
							= [];
	lines2 | exec			= [linea : lines1];
							= lines1;
	lines1 | a_opt 			= [lineb];
							= [];
	linea | exec_exists		= "'" +++ path +++ "' is older than .obj files";
							= "'" +++ path +++ "' does not exist";
	lineb					= "'" +++ path +++ "' was linked with different application options";
	};
					
//
//	MakeABCOutOfDateMessage message explaining why the .abc file at hand is out of date.
//	abc			: .abc file is younger than .obj file
//	abcexists	: .abc file exists
//	objexists	: .obj file exists
//	cgo			: paths/code gen options modified
	
MakeABCOutOfDateMessage :: !Modulename !Bool !Bool !Bool !Bool -> [String];
MakeABCOutOfDateMessage mn abc abcexists objexists cgo
	= lines`;
	where {
	lines` | abcexists	= ["" : lines2];
						= [];
	lines2 | abc || not objexists	= [linea : lines1];
									= lines1;
	lines1 | cgo		= [lineb];
						= [];
	linea | objexists	= "'" +++ mn +++ ".obj' is older than .abc file";
						= "'" +++ mn +++ ".obj' does not exist";
	lineb				= "new paths or new code generator options set";
	};

//
//	MakeSourceOutOfDateMessage message explaining why the source file (.icl) at hand is out of date.
//	dcl			: .dcl file has been modified since last compilation
//	icl			: .icl file has been modified since last compilation
//	imports		: imported .dcl has been modified since last compilation
//	abc_exists	: .abc file exists
//	obj_exists	: .obj exists
//	co			: paths has been changed since last compilation
//	options		: .abc file exists but compiler options it was generated with conflicts with current
//					main module compiler options
//	sys			: .abc file exists and is system file
//	stack		: .abc file exists and does not contain sequential stack info
//	options		: .abc exists and was compiled with a different compiler version
//

MakeSourceOutOfDateMessage ::	!Modulename
								!Bool !Bool !Bool !Bool !Bool !Bool !Bool !Bool !Bool !Bool
								-> [String];
MakeSourceOutOfDateMessage mn dcl icl imports abc_exists obj_exists co sys stack options version
	= lines`;
	where {
	lines` | dcl || icl || imports || co || stack || options || version
											= ["" : lines6];
											= [];
	lines6 | (dcl || icl)					= [linea : lines5];
											= lines5;
	lines5 | imports && not dcl && not icl	= [lineb : lines4]
											= lines4;
	lines4 | version						= [linec : lines3];
											= lines3;
	lines3 | options						= [lined : lines2];
											= lines2;
	lines2 | stack							= [linee : lines1];
											= lines1;
	lines1 | co								= [linef];
											= [];
	
	linea	| sys			= "'" +++ mn +++ suffix +++ " conflict(s) with .abc file";
			| exists		= "'" +++ mn +++ abc_obj +++ "' is older than corresponding " +++ suffix;
							= "'" +++ mn +++ ".abc & .obj' files do not exist";
	lineb	| sys			= "'" +++ mn +++ ".abc' conflicts with imported .dcl files";
			| obj_exists	= "'" +++ mn +++ abc_obj +++ "' is older than imported .dcl files";
							= "'" +++ mn +++ ".obj' does not exist";
	linec					= "'" +++ mn +++ ".icl' was compiled with a different compiler version";
	lined					= "'" +++ mn +++ ".icl' was compiled with different compiler options";
	linee					= "'" +++ mn +++ ".abc' has no sequential stack info";
	linef					= "new paths set";
	suffix	| dcl && icl	= ".dcl & .icl' files";
			| dcl			= ".dcl' file";
							= ".icl' file";
	abc_obj	| abc_exists	= ".abc";
							= ".obj";
	exists					= abc_exists || obj_exists;
	};

