Platform.icl 6.83 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2
implementation module Platform

3 4
import code from library "platform_kernel_library"

5
import StdArray, StdEnum, StdList, StdClass, StdBool, StdMisc
6
import ArgEnv
7
import logfile, set_return_code
Diederik van Arkel's avatar
Diederik van Arkel committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32

PlatformDependant win mac :== win

cl_args =: getCommandLine

filter_opts [] = []
filter_opts [h:t]
	| h.[0] == '-'	= filter_opts (drop 1 t)
	= [h:filter_opts t]

get_arg n
	= get_arg n [a \\ a <-: cl_args]
where
	get_arg n [] = (False,"")
	get_arg n [h:t]
		| h == n = case t of [] -> (True,""); [h:_] -> (True,h)
		= get_arg n t

get_env n
	# e = getEnvironmentVariable n
	= case e of
		EnvironmentVariableUndefined	-> (False,"")
		EnvironmentVariable v			-> (True,v)

get_ini file section key default`
33 34 35 36 37 38 39 40 41 42 43 44 45
	# (size,buffer,tb) = GetPrivateProfileString section key default` (createArray 256 '\0') 256 file []
	= buffer % (0,size-1)

GetPrivateProfileString :: !String !String !String !*{#Char} !Int !String !*state -> (!Int,!{#Char},!*state)
GetPrivateProfileString appName keyName default returnedString returnedStringSize fileName state = code {
	push_a 0
	update_a 2 1
	update_a 3 2
	update_a 4 3
	update_a 5 4
	update_a 3 5
	ccall GetPrivateProfileStringA@24 "PssssIs:I:AA"
}
Diederik van Arkel's avatar
Diederik van Arkel committed
46

47
batchOptions :: !*World -> (!Bool,Bool,String,*File,!*World)
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
batchOptions world
	=	case [arg \\ arg <-: getCommandLine] of
			[_, "--batch-build", prj]
				-> batch False prj world
			[_, "--batch-force-build", prj]
				-> batch True prj world
			_
				->	(True, abort "force_update", abort "project file", abort "logfile", world)
where
	batch force_update prj world
		# (ok,logfile,world)	= openLogfile prj world
		| not ok
			=   (False, force_update, prj, logfile, wAbort ("--batch-build failed while opening logfile.\n") world)
			=	(False, force_update, prj, logfile, world)

wAbort :: !String !*World -> *World
wAbort message world
	# stderr	= fwrites message stderr
66
	# (_,world)	= fclose stderr world
67 68 69
	# world		= set_return_code_world (-1) world
	= world

Diederik van Arkel's avatar
Diederik van Arkel committed
70 71
//====

72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
get_module_file_name :: !*state -> (!{#Char},!Int,!*state)
get_module_file_name state
	= get_module_file_name 261 state
where
	get_module_file_name :: !Int !*state -> (!{#Char},!Int,!*state)
	get_module_file_name file_name_size state
		# (file_name_size_result,file_name,state)
			= GetModuleFileName 0 (createArray file_name_size '\0') state
		| file_name_size_result<file_name_size
			= (file_name,file_name_size_result,state)
		# (last_error,state) = GetLastError state
		| last_error==0/*ERROR_SUCCESS*/
			= (file_name,file_name_size_result,state)
		| last_error==122/*ERROR_INSUFFICIENT_BUFFER*/
			= get_module_file_name (file_name_size+file_name_size) state
			= abort "get_module_file_name failed"

GetModuleFileName :: !Int !*{#Char} !*state -> (!Int,!{#Char},!*state)
GetModuleFileName hModule file_name_buffer state = code {
	push_a 0
	push_a 0
	push_arraysize CHAR 0 1
	push_b 1
	update_b 1 2
	updatepop_b 0 1
	ccall GetModuleFileNameA@12 "PpsI:I:AA"
}

GetLastError :: !*state -> (!Int,*state)
GetLastError state = code {
	ccall GetLastError@0 "P:I:A"
}

Diederik van Arkel's avatar
Diederik van Arkel committed
105
inifilename
106 107
	# (file_name_buffer,file_name_size,state) = get_module_file_name []
	=: file_name_buffer % (0,file_name_size-4)+++"ini\0"
Diederik van Arkel's avatar
Diederik van Arkel committed
108 109

section =: "Paths\0"
110
tooltempkey =: "tooltemp\0"
Diederik van Arkel's avatar
Diederik van Arkel committed
111 112 113
envskey =: "envsdir\0"
prefskey =: "prefsdir\0"

114
tooltempdefault	=: StartUpDir +++. "\\Temp\0"
Diederik van Arkel's avatar
Diederik van Arkel committed
115 116 117
envsdefault		=: StartUpDir +++. "\\Config\0"
prefsdefault	=: StartUpDir +++. "\\Config\0"

Diederik van Arkel's avatar
Diederik van Arkel committed
118 119
TempDir :: String
TempDir =:
Diederik van Arkel's avatar
Diederik van Arkel committed
120
	let
Diederik van Arkel's avatar
Diederik van Arkel committed
121 122
		(has_arg,arg) = get_arg "-tempdir"
		(has_env,env) = get_env "TEMPDIR"
123
		ini = get_ini inifilename section tooltempkey tooltempdefault
Diederik van Arkel's avatar
Diederik van Arkel committed
124 125 126
	in if has_arg arg (if has_env env ini)

EnvsDir :: String
Diederik van Arkel's avatar
Diederik van Arkel committed
127 128 129 130
EnvsDir =:
	let
		(has_arg,arg) = get_arg "-envsdir"
		(has_env,env) = get_env "ENVSDIR"
Diederik van Arkel's avatar
Diederik van Arkel committed
131
		ini = get_ini inifilename section envskey envsdefault
Diederik van Arkel's avatar
Diederik van Arkel committed
132 133 134
	in if has_arg arg (if has_env env ini)

PrefsDir :: String
Diederik van Arkel's avatar
Diederik van Arkel committed
135 136 137 138
PrefsDir =:
	let
		(has_arg,arg) = get_arg "-prefsdir"
		(has_env,env) = get_env "PREFSDIR"
Diederik van Arkel's avatar
Diederik van Arkel committed
139
		ini = get_ini inifilename section prefskey prefsdefault
Diederik van Arkel's avatar
Diederik van Arkel committed
140 141
	in if has_arg arg (if has_env env ini)

Diederik van Arkel's avatar
Diederik van Arkel committed
142
StartUpDir :: String
Diederik van Arkel's avatar
Diederik van Arkel committed
143 144 145 146 147 148 149 150 151 152 153 154 155 156
StartUpDir =: expand_8_3_names_in_path (RemoveFileName WinGetModulePath)

RemoveFileName :: !String -> String;
RemoveFileName path
	| found	= (path % (0, dec position));
			= path;
where 
	(found,position)	= LastColon path last;
	last				= dec (size path);
		
LastColon :: !String !Int -> (!Bool, !Int);
LastColon s i
	| i <= 0
		= (False,0);
157
	| DirSeparator==s.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
	 	= (True, i);
		= LastColon s (dec i);

//-- expand_8_3_names_in_path

FindFirstFile :: !String -> (!Int,!String);
FindFirstFile file_name
	# find_data = createArray 318 '\0';
	# handle = FindFirstFile_ file_name find_data;
	= (handle,find_data);

FindFirstFile_ :: !String !String -> Int;
FindFirstFile_ file_name find_data
	= code {
		ccall FindFirstFileA@8 "Pss:I"
	}

FindClose :: !Int -> Int;
FindClose handle = code {
		ccall FindClose@4 "PI:I"
	}

find_null_char_in_string :: !Int !String -> Int;
find_null_char_in_string i s
	| i<size s && s.[i]<>'\0'
		= find_null_char_in_string (i+1) s;
		= i;

find_data_file_name find_data
	# i = find_null_char_in_string 44 find_data;
	= find_data % (44,i-1);

190
find_first_file_and_close :: !{#Char} -> (!Bool,!{#Char});
Diederik van Arkel's avatar
Diederik van Arkel committed
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
find_first_file_and_close file_name
	# (handle,find_data) = FindFirstFile file_name;
	| handle <> (-1)
		# r = FindClose handle;
		| r==r
			= (True,find_data);
			= (False,find_data);
		= (False,"");

find_last_backslash_in_string i s
	| i<0
		= (False,-1);
	| s.[i]=='\\'
		= (True,i);
		= find_last_backslash_in_string (i-1) s;

expand_8_3_names_in_path :: !{#Char} -> {#Char};
expand_8_3_names_in_path path_and_file_name
	# (found_backslash,back_slash_index) = find_last_backslash_in_string (size path_and_file_name-1) path_and_file_name;
	| not found_backslash
		= path_and_file_name;
	# path = expand_8_3_names_in_path (path_and_file_name % (0,back_slash_index-1));
	# file_name = path_and_file_name % (back_slash_index+1,size path_and_file_name-1);
	# path_and_file_name = path+++"\\"+++file_name;
	# (ok,find_data) = find_first_file_and_close (path_and_file_name+++"\0");
	| ok
		= path+++"\\"+++find_data_file_name find_data;
		= path_and_file_name;

WinGetModulePath ::  {#Char}
WinGetModulePath
222 223
	# (file_name_buffer,file_name_size,state) = get_module_file_name []
	= file_name_buffer % (0,file_name_size-1)
Diederik van Arkel's avatar
Diederik van Arkel committed
224

225 226
onOSX	:: Bool
onOSX
227 228 229
	= False

application_path :: !String -> String // same as applicationpath in StdSystem
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
application_path fname
	# (module_directory_path,_) = get_module_directory_path []
	= module_directory_path+++fname

skip_file_name_at_end :: !Int !{#Char} -> Int
skip_file_name_at_end i s
	| i>=0
		# c=s.[i]
		| c=='\\' || c=='/' || c==':'
			= i
			= skip_file_name_at_end (i-1) s
		= i

get_module_directory_path :: !*state -> (!{#Char},!*state)
get_module_directory_path state
	# (file_name_buffer,file_name_size,state) = get_module_file_name state
	# separator_index = skip_file_name_at_end (file_name_size-1) file_name_buffer
	// remove "\\\\?\\" ?
	= (file_name_buffer % (0,separator_index),state)