implementation module EdPath;

/* OS dependent operations on filenames for the powermacintosh */

import StdClass,StdString, deltaSystem, StdChar, StdBool, StdChar,StdInt, StdMisc,StdArray;
import deltaFont, deltaIOSystem;
import EdTypes, EdConstants;

EmptyPathname	:== "";
DirSeparatorString:==":";

ExampleChar		:== 'W';
CharWidth		:== 32;
ListBoxMargin	:== 10.0;

RemovePath	:: !Pathname -> String;
RemovePath path
	| found	= path % (inc position, last);
			= path;
	where {
		(found,position)= FindLastChar DirSeparator path last;
		last			= dec (size path);
	};

RemoveSuffix :: !Pathname -> String;
RemoveSuffix path
	| not found		= path;
	| not suffix	= path;
					= path % (0, dec position);
	where {
		(found, position)	= FindLastChar '.' path last;
		suf					= path % (position, last);
		suffix				= suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".prj";
		last				= dec (size path);
	};
		
RemoveFilename :: !Pathname -> Pathname;
RemoveFilename path 
	| found
		= path % (0, dec position);
		= path;
	where {
		(found,position)	= FindLastChar DirSeparator path (dec (size path));
	};
			
IsDefPathname :: !Pathname -> Bool;
IsDefPathname name =  equal_suffix ".dcl" name;

IsImpPathname :: !Pathname -> Bool;
IsImpPathname name =  equal_suffix ".icl" name;
	
IsPrjPathname :: !Pathname -> Bool;
IsPrjPathname name =  equal_suffix ".prj" name;

IsFullPathname :: !Pathname -> Bool;
IsFullPathname name = LastChar DirSeparator name (dec (size name)) >= 0;

MakeDefPathname	:: !String -> Pathname;
MakeDefPathname name =  RemoveSuffix name  +++ ".dcl";

MakeImpPathname	:: !String -> Pathname;
MakeImpPathname name = RemoveSuffix name  +++ ".icl";
			
MakeABCPathname	:: !String -> Pathname;
MakeABCPathname name = RemoveSuffix name  +++ ".abc";

ObjectSuffix :: Processor -> String;
ObjectSuffix CurrentProcessor
	=	".o";
ObjectSuffix MC68000
	=	".obj0";
ObjectSuffix MC68020
	=	".obj1";
ObjectSuffix MC68020_and_68881
	=	".obj2";

MakeObjPathname	:: !Processor !String -> Pathname;
MakeObjPathname processor name
	=	RemoveSuffix name  +++ ObjectSuffix processor;

MakeMiraPathname :: !String -> Pathname;
MakeMiraPathname name = RemoveSuffix name  +++ ".m";
	
MakeTextPathname :: !String -> Pathname;
MakeTextPathname name = name;
	
MakeProjectPathname	:: !String -> Pathname;
MakeProjectPathname name = RemoveSuffix name   +++ ".prj";

MakeExecPathname :: !String -> Pathname;
MakeExecPathname name = RemoveSuffix name;
	
MakeTempPathname :: !Pathname -> Pathname;
MakeTempPathname name = name;
	
MakeABCSystemPathname :: !Pathname !*Files -> (!Pathname, !*Files);
MakeABCSystemPathname abcname files
	= (directory_name_plus_system_dir +++ sep +++ file +++ ".abc",files);
	{
		directory_name_plus_system_dir
			| equal_suffix SystemDir dir
				= dir;
				= dir +++ sep +++ SystemDir;
		dir		= RemoveFilename abcname;
		sep		= toString DirSeparator;
		file	= RemovePath (RemoveSuffix abcname);
	};
	
MakeObjSystemPathname :: !Processor !Pathname !*Files -> (!Pathname,!*Files);
MakeObjSystemPathname processor name files
	=	files_and_path (ObjectSuffix processor);
	{
		files_and_path extension = (directory_name_plus_system_dir +++ sep +++ file+++extension,files);
		directory_name_plus_system_dir
			| equal_suffix SystemDir dir
				= dir;
				= dir +++ sep +++ SystemDir;
		dir		= RemoveFilename name;
		sep		= toString DirSeparator;
		file	= RemovePath (RemoveSuffix name);
	};
	
MakeFullPathname :: !Pathname !Modulename -> Pathname;
MakeFullPathname path modname =  path +++ toString DirSeparator +++ modname;
	
GetModuleName :: !Pathname -> Modulename;
GetModuleName name =  RemoveSuffix (RemovePath name);

MakeProjectDirName :: !Bool !String !String !String -> String;
MakeProjectDirName long home appl file
	| long
		= Truncate file;
	| home==file
		= Truncate "{Project}";
	| equal_path_prefix home file
		= Truncate "{Project}" +++  DirSeparatorString +++ file % (inc (size home), dec (size file));
		= MakeDefDirName False appl file;

MakeDefDirName	:: !Bool !String !String -> String;
MakeDefDirName long appl file
	| long
		= Truncate file;
	| appl==file
		= Truncate "{Application}";
	| equal_path_prefix appl file
		= Truncate "{Application}" +++ DirSeparatorString +++ file % (inc (size appl), dec (size file));
		= Truncate file;
	
MatchProjectDirName :: !Bool !Pathname !String !String !(List Pathname) -> Pathname;
MatchProjectDirName long home appl select Nil
	=  EmptyPathname;
MatchProjectDirName long home appl select (path:!paths)
	| select == MakeProjectDirName long home appl path
		=  path;
		=  MatchProjectDirName long home appl select paths;
	
MatchDefDirName	:: !Bool !Pathname !String !(List Pathname) -> Pathname;
MatchDefDirName long appl select Nil
	=  EmptyPathname;
MatchDefDirName long appl select (path:!paths)
	| select == path`
		=  path;
		=  MatchDefDirName long appl select paths;
	where {
		path` = MakeDefDirName long appl path;
	};
	
ListBoxWidth :: Measure;
ListBoxWidth
	= Pixel ( CharWidth * FontCharWidth ExampleChar font + MMToHorPixels ListBoxMargin );
	where {
	(_,font)	= SelectFont fn [] fs;
	(fn,_,fs)	= DefaultFont;
	}; 

replace_prefix_path	:: !Pathname !Pathname !Pathname -> Pathname;
replace_prefix_path old_prefix_path new_prefix_path path
	| old_prefix_path==path
		= new_prefix_path;
	| equal_path_prefix old_prefix_path path
		= new_prefix_path +++ DirSeparatorString +++ path % (inc (size old_prefix_path), dec (size path));
		= path;
	
/* Auxilary functions */
	
equal_suffix	:: !String !String -> Bool;
equal_suffix suffix string
	| lengths < lengthsuf
		= False;
		= string % (lengths - lengthsuf,lengths) == suffix;
	where {
		lengths		= dec (size string);
		lengthsuf	= dec (size suffix);
	};
	
equal_path_prefix	:: !String !String -> Bool;
equal_path_prefix prefix string
	| lengths<=lengthpre
		= False;
		= string.[inc lengthpre]==DirSeparator && string % (0,lengthpre)==prefix;
	where {
		lengths		= dec (size string);
		lengthpre	= dec (size prefix);
	};

LastChar :: !Char !String !Int -> Int;
LastChar c s i
	| i <= 0		= -1;
	| c ==  s.[i]	= i;
					= LastChar c s (dec i);

FindLastChar :: !Char !String !Int -> (!Bool, !Int);
FindLastChar c s i
	| i <= 0			= (False,0);
	| c ==  s.[i]		= (True, i);
						= FindLastChar c s (dec i);
					
Truncate :: !String -> String;
Truncate s =  MaxWidth font pixelwidth len s;
	where {
	len			= size s;
	pixelwidth	= CharWidth *  FontCharWidth ExampleChar font ;
	(_,font)	= SelectFont fn [] fs;
	(fn,_,fs)	= DefaultFont;
	}; 

MaxWidth :: !Font !Int !Int !String -> String;
MaxWidth font pixelwidth truncated s
	| truncated <= 1	= s;
	| ok				= s;
						= MaxWidth font pixelwidth (dec truncated) s;
	where {
	ok=  FontStringWidth (s % (0, dec truncated)) font  < pixelwidth;
	};
