PmDialogues.icl 32 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2 3 4 5 6
implementation module PmDialogues

import StdArray, StdFunc, StdMisc, StdTuple
import StdFileSelect,StdPStClass,StdWindow
import PmTypes, PmProject, PmPath, UtilStrictLists
import tabcontrol, ExtListBox, ioutil, IdeState
Diederik van Arkel's avatar
Diederik van Arkel committed
7
import ExtNotice, UtilIO
Diederik van Arkel's avatar
Diederik van Arkel committed
8

Diederik van Arkel's avatar
Diederik van Arkel committed
9
import Platform, morecontrols
Diederik van Arkel's avatar
Diederik van Arkel committed
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76

:: PO_LS =
	{ ao	:: !ApplicationOptions
	, cgo	:: !CodeGenOptions
	, paths	:: !List String
	, lo	:: !LinkOptions
	, xp	:: !String						// exepath
	, sl	:: !StaticLibInfo
	}

projectOptions :: !(PSt General) -> PSt General
projectOptions ps
	= projectDialog True ps

projectDefaults :: !(PSt General) -> PSt General
projectDefaults ps
	= projectDialog False ps
	
projectDialog :: !Bool !(PSt General) -> PSt General
projectDialog actualProject ps`
	# ((err,ret),ps)		= (if actualProject actualOpenOptionsDialog actualOpenDefaultsDialog) ps
	| NoError == err && isJust ret
		# ret				= fromJust ret
		// need to differentiate here between options and defaults...
		| actualProject
			// actualProject
			# prj			= PR_SetApplicationOptions ret.ao project
			# prj			= PR_SetCodeGenOptions ret.cgo prj
			# prj			= PR_SetLinkOptions prj ret.lo
			#(dp,ps)		= getCurrentPaths ps
			# prj			= PR_SetPaths False dp ret.paths prj
			# (appPath,ps)	= getStup ps
			# (prjPath,ps)	= getPath ps
			# prjPath		= RemoveFilename prjPath
			# prj			= PR_SetExecPath ret.xp prj
			# prj			= PR_SetStaticLibsInfo ret.sl prj
			# (xxId,ps)		= getPWX ps
			# ps			= setFlexTexts [(xxId,ret.xp)] ps
			= setProject prj ps
		// prefs
		# (prfs,ps)			= getPrefs ps
		# prfs				= {prfs & cgenopts = ret.cgo}
		# prfs				= {prfs & linkopts = ret.lo}
		# prfs				= {prfs & applopts = ret.ao}
		= setPrefs prfs ps
	= ps
where
	actualOpenOptionsDialog :: !(PSt General) ->  (!(!ErrorReport,!Maybe PO_LS),!PSt General)
	actualOpenOptionsDialog ps = openModalDialog inils
									(Dialog "Project Options"
									(panesOptions :+: buttons)
									[WindowClose cancelfun
									,WindowOk okId
									,WindowCancel cancelId
									,WindowId dlogId
									]) ps
	actualOpenDefaultsDialog :: !(PSt General) ->  (!(!ErrorReport,!Maybe PO_LS),!PSt General)
	actualOpenDefaultsDialog ps = openModalDialog inils
									(Dialog "Project Defaults"
									(panesDefaults :+: buttons)
									[WindowClose cancelfun
									,WindowOk okId
									,WindowCancel cancelId
									,WindowId dlogId
									]) ps
	// actualProject
	(project,ps0)	= getProject ps`
Diederik van Arkel's avatar
Diederik van Arkel committed
77 78
	([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,r1id,c2id,c3id,c4id,xpId,rsrcsId,symbolsId:_],ps1)
					= openIds 17 ps0
Diederik van Arkel's avatar
Diederik van Arkel committed
79 80 81 82 83 84
	(lbpadId,ps2)	= openExtListBoxId ps1
	(lbobjId,ps3)	= openExtListBoxId ps2
	(lbdlibId,ps4)	= openExtListBoxId ps3
	(lbslibId,ps5)	= openExtListBoxId ps4
	(ap,ps6)		= getStup ps5
	(pp,ps7)		= fix (getPath ps6) where fix (l,r) = (RemoveFilename l,r)
Diederik van Arkel's avatar
Diederik van Arkel committed
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
	(prefs,ps)		= PlatformDependant
						(getPrefs ps7)	// Win
						(getPrefs ps9)	// Mac
// mac only...
	(fontNames`, ps8)
					= accPIO (accScreenPicture getFontNames) ps7		// filteren naar alleen fixed width fonts....
//	(fixed,ps9)		= seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames`) ps8
	(fixed,ps9)		= accPIO (accScreenPicture (seqList (map lisFixedWidth fontNames`))) ps8
	fontNames		= lfilter fixed fontNames`
	fontSizes		= [7, 8, 9, 10, 12, 14, 18, 24 ]
	inifn			= ao.fn
	inifs			= ao.fs
	fontfun name (ls,ps)
		# ls		= {ls & ao.fn = name}
		= (ls,ps)
	sizefun size (ls,ps)
		# ls		= {ls & ao.fs = size}
		= (ls,ps)
// ...mac only
Diederik van Arkel's avatar
Diederik van Arkel committed
104 105 106 107 108 109 110 111 112 113 114 115 116
 	ao				= if actualProject (PR_GetApplicationOptions project) prefs.applopts
	cgo				= if actualProject (PR_GetCodeGenOptions project) prefs.cgenopts
	lo				= if actualProject (PR_GetLinkOptions project) prefs.linkopts
	paths			= PR_GetPaths project
	sl				= PR_GetStaticLibsInfo project 
	root_path		= PR_GetRootPath project
	inils			= {ao=ao,cgo=cgo,paths=paths,lo=lo,xp=fulexepath,sl=sl}
	
	// generic...
	panesOptions = TabControl
							(	applicationPane
							:+: profilingPane
							:+: diagnosticsPane
Diederik van Arkel's avatar
Diederik van Arkel committed
117
							:+: pathsPane ap pp paths False 200 lbpadId c1id r1id root_path
Diederik van Arkel's avatar
Diederik van Arkel committed
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
							:+: linkerPane
							:+: objectsPane
							:+: slibsPane
							:+: dlibsPane
							) [ControlPos (Left,zero)]
	panesDefaults = TabControl
							(	applicationPane
							:+: profilingPane
							:+: diagnosticsPane
							:+: linkerPane
							) [ControlPos (Left,zero)]
	buttons
		=	ButtonControl "OK"
			[ControlFunction okfun,ControlPos (Right,zero), ControlId okId]
		:+: ButtonControl "Cancel"
			[ControlFunction cancelfun, ControlPos (LeftOfPrev,zero), ControlId cancelId]

	okfun (ls,ps)
		#	(wdef,ps)	= accPIO (getWindow dlogId) ps
		| isNothing wdef = abort "Fatal error in Project Options Dialog"
		#	wdef		= fromJust wdef
Diederik van Arkel's avatar
Diederik van Arkel committed
139 140
			[(ok1,hs),(ok2,ss),(ok3,hm),(ok4,ih),(ok5,mh):_]	= getControlTexts [hsId,ssId,hmId,ihId,mhId] wdef
		| not (ok1 && ok2 && ok3 && ok4 && ok5)
Diederik van Arkel's avatar
Diederik van Arkel committed
141
			= abort "More fatal stuff in Project Options dialog"
Diederik van Arkel's avatar
Diederik van Arkel committed
142
		| (isNothing hs) || (isNothing ss) || (isNothing hm) || (isNothing ih) || (isNothing mh)
Diederik van Arkel's avatar
Diederik van Arkel committed
143 144 145 146 147
			= abort "Yet more fatal stuff in Project Options dialog"
		# ls = { ls	& ao =
				{ls.ao
				& hs								= MemSizeToInt (fromJust hs)
				, ss								= MemSizeToInt (fromJust ss)
Diederik van Arkel's avatar
Diederik van Arkel committed
148
//				, em								= MemSizeToInt (fromJust em)
Diederik van Arkel's avatar
Diederik van Arkel committed
149 150 151 152
				, heap_size_multiple				= StringToFixedPoint (fromJust hm)
				, initial_heap_size					= MemSizeToInt (fromJust ih)
				, memoryProfilingMinimumHeapSize	= MemSizeToInt (fromJust mh)
				}}
Diederik van Arkel's avatar
Diederik van Arkel committed
153
		# ls = PlatformDependant ls (macstuff ls wdef)
Diederik van Arkel's avatar
Diederik van Arkel committed
154
		= (ls, closeWindow dlogId ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
155 156 157 158 159 160
	where
		macstuff ls wdef
			# (ok,em)= getControlText emId wdef
			| not ok || isNothing em = abort "Fatal mac specific"
			# ls = {ls & ao.em = MemSizeToInt (fromJust em)}
			= ls
Diederik van Arkel's avatar
Diederik van Arkel committed
161 162 163 164 165 166 167 168 169 170 171

	cancelfun (ls,ps) = (inils,closeWindow dlogId ps)

	fulexepath	= PR_GetExecPath project
	symexepath	= symPath ap pp fulexepath

	setexe (ls,ps)
		# (prjPath,ps)	= getPath ps
		# prjName		= RemovePath prjPath
		# prjPath		= RemoveFilename prjPath
		# (exename,ps)	= PlatformDependant
172
							(selectOutputFile` "Executable" "*.exe" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
173 174 175 176 177 178 179 180 181 182 183 184 185
							(selectOutputFile "Executable" prjName ps)	// mac
		| isNothing exename
			= (ls,ps)
		# exename		= fromJust exename
		# (appPath,ps)	= getStup ps
		# exename		= symPath appPath prjPath exename
		# ls			= {ls & xp = exename}
		# ps			= appPIO (setControlText xpId ("Executable produced as: "+++exename)) ps
		= (ls,ps)

	applicationPane = Pane "Application"
		// heap size
		(	TextControl "Application Options" []
186 187 188 189 190
		:+:	EditControl (IntToMemSize ao.hs) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId hsId
			, ControlActivate (noLS (appPIO (setEditControlSelection hsId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
191 192
		:+: TextControl "Maximum Heap Size" []
		// stack size
193 194 195 196 197
		:+: EditControl (IntToMemSize ao.ss) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId ssId
			, ControlActivate (noLS (appPIO (setEditControlSelection ssId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
198
		:+: TextControl "Stack Size" []
Diederik van Arkel's avatar
Diederik van Arkel committed
199 200 201
		:+: PlatformDependant	// extra memory (want only on mac...)
			(NilLS)			// win
			(				// mac
202 203 204 205 206
				EditControl (IntToMemSize ao.em) (PixelWidth 100) 1
					[ ControlPos (Left,zero)
					, ControlId emId
					, ControlActivate (noLS (appPIO (setEditControlSelection emId 1 0)))
					]
Diederik van Arkel's avatar
Diederik van Arkel committed
207 208
			:+: TextControl "Extra Memory" []
			)
Diederik van Arkel's avatar
Diederik van Arkel committed
209
		// next heap size factor
210 211 212 213 214
		:+: EditControl (FixedPointToString ao.heap_size_multiple) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId hmId
			, ControlActivate (noLS (appPIO (setEditControlSelection hmId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
215 216
		:+: TextControl "Next Heap Size Factor" []
		// initial heap size
217 218 219 220 221
		:+: EditControl (IntToMemSize ao.initial_heap_size) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId ihId
			, ControlActivate (noLS (appPIO (setEditControlSelection ihId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
222 223 224
		:+: TextControl "Initial Heap Size" []
		// marking collector
		:+: CheckControl
Diederik van Arkel's avatar
Diederik van Arkel committed
225 226 227 228 229 230
			[	( "Enable dynamics"
				, Nothing
				, if (lo.method == LM_Static) NoMark Mark
				, noPS (\l->{l & lo = {l.lo & method = if (l.lo.method == LM_Static) LM_Dynamic LM_Static}})
				)
			,	( "Use Marking Garbage Collector"	
Diederik van Arkel's avatar
Diederik van Arkel committed
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
				, Nothing
				, toMark ao.marking_collection
				, noPS (\l->{l & ao = {l.ao & marking_collection = not l.ao.marking_collection}})
				)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			]
		// console type
		:+: TextControl "Console"
			[ ControlPos (Left,OffsetVector {zero & vy = 10})
			]
		:+: RadioControl
			[ ("Basic Values Only"	,Nothing,noPS (\l->{l & ao = {l.ao & o = BasicValuesOnly}}))
			, ("Show Constructors"	,Nothing,noPS (\l->{l & ao = {l.ao & o = ShowConstructors}}))
246
			, ("No Return Type"		,Nothing,noPS (\l->{l & ao = {l.ao & o = NoReturnType}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
247 248 249 250 251 252
			, ("No Console"			,Nothing,noPS (\l->{l & ao = {l.ao & o = NoConsole}}))
			]
			(Columns 1)
			(case ao.o of
				BasicValuesOnly			-> 1
				ShowConstructors		-> 2
253 254
				NoReturnType			-> 3
				NoConsole				-> 4
Diederik van Arkel's avatar
Diederik van Arkel committed
255 256 257
			)
			[ ControlPos (Left,zero)
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
258 259 260
		:+:	PlatformDependant
			NilLS
			(FontNameSizeControl inifn inifs fontNames fontSizes fontfun sizefun [])
Diederik van Arkel's avatar
Diederik van Arkel committed
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
		// .exe name and location
		:+: TextControl ("Executable produced as: "+++symexepath) [ControlId xpId,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		:+: ButtonControl "Set executable..." [ControlFunction setexe,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		)
	profilingPane = Pane "Profiling"
		(	TextControl "Profiling Options" []
		:+:	RadioControl
			[ ("Time Profile and Stack Trace",Nothing,noPS (\l->{l & ao = {l.ao & profiling = True, stack_traces = False}}))
			, ("Stack Trace only",Nothing,noPS (\l->{l & ao = {l.ao & profiling = True, stack_traces = True}}))
			, ("No Time Profiling",Nothing,noPS (\l->{l & ao = {l.ao & profiling = False, stack_traces = False}}))
			]
			(Columns 1)
			(if ao.profiling
				(if ao.stack_traces
					2
					1
				)
				3
			)
			[ControlPos (Left,zero)]
		:+: CheckControl
			[("Heap Profile",Nothing,toMark ao.memoryProfiling, noPS (\l->{l & ao = {l.ao & memoryProfiling = not l.ao.memoryProfiling}}))]
			(Columns 1) [ControlPos (Left,zero)]
284 285 286 287 288
		:+: EditControl (IntToMemSize ao.memoryProfilingMinimumHeapSize) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId mhId
			, ControlActivate (noLS (appPIO (setEditControlSelection mhId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307
		:+: TextControl "Minimum Profile Heap" []
		)
	diagnosticsPane = Pane "Diagnostics"
		(	TextControl "Diagnostics Options" []
		:+:	CheckControl
			[ ("Show Execution Time"		,Nothing, toMark ao.set,noPS (\l->{l & ao = {l.ao & set = not l.ao.set}}))
			, ("Show Garbage Collections"	,Nothing, toMark ao.sgc,noPS (\l->{l & ao = {l.ao & sgc = not l.ao.sgc}}))
			, ("Print Stack Size"			,Nothing, toMark ao.pss,noPS (\l->{l & ao = {l.ao & pss = not l.ao.pss}}))
			, ("Write stderr to file"		,Nothing, toMark ao.write_stderr_to_file,noPS (\l->{l & ao = {l.ao & write_stderr_to_file = not l.ao.write_stderr_to_file}}))
			, ("Check Stacks"				,Nothing, toMark cgo.cs, noPS (\l->{l & cgo = {l.cgo &  cs = not l.cgo.cs}}))
			, ("Check Indices"				,Nothing, toMark cgo.ci, noPS (\l->{l & cgo = {l.cgo &  ci = not l.cgo.ci}}))
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			]
		:+: TextControl "Stack Tracing can be set in the profiling panel." [ControlPos (Left,zero)]
		)
	linkerPane = Pane "Linker"
		(	TextControl "Linker Options" []
Diederik van Arkel's avatar
Diederik van Arkel committed
308
/*
Diederik van Arkel's avatar
Diederik van Arkel committed
309 310 311
		:+:	TextControl "Link Method" [ControlPos (Left,zero)]
		:+:	RadioControl
			[("Static"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Static}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
312
//			,("Eager"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Eager}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
313 314 315 316 317 318 319 320
			,("Lazy"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Dynamic}}))
			]
			(Rows 1) inilinkmethod
			[ ControlPos (Left,zero)
			]
		:+: TextControl "Link Options"				
			[ ControlPos (Left,OffsetVector {zero & vy = 10})
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
321
*/
Diederik van Arkel's avatar
Diederik van Arkel committed
322 323 324
		:+: CheckControl
			[ ("Generate Relocations"				,Nothing,toMark lo.generate_relocations,noPS (\ls -> {ls & lo = {ls.lo & generate_relocations = not ls.lo.generate_relocations}}))
			, ("Generate Link Map"					,Nothing,toMark lo.generate_link_map,noPS (\ls -> {ls & lo = {ls.lo & generate_link_map = not ls.lo.generate_link_map}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
325
			: PlatformDependant			
Diederik van Arkel's avatar
Diederik van Arkel committed
326
// winOnly
Diederik van Arkel's avatar
Diederik van Arkel committed
327
			[ ("Generate DLL"						,Nothing,toMark lo.generate_dll,noPS (\ls -> {ls & lo = {ls.lo & generate_dll = not ls.lo.generate_dll}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
328 329
			, ("Use Standard Runtime Environment"	,Nothing,toMark ao.standard_rte,noPS (\l->{l & ao = {l.ao & standard_rte = not l.ao.standard_rte}}))
			, ("Include Resource Section"			,Nothing,toMark lo.link_resources,noPS (\ls->{ls & lo = {ls.lo & link_resources = not ls.lo.link_resources}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
330 331
			]
// macOnly
Diederik van Arkel's avatar
Diederik van Arkel committed
332 333
//			[ ("Add 'carb' Resource"				,Nothing,toMark lo.add_carb_resource,noPS (\ls -> {ls & lo.add_carb_resource = not ls.lo.add_carb_resource}))
			[]
Diederik van Arkel's avatar
Diederik van Arkel committed
334 335 336
			] (Columns 1)
			[ ControlPos (Left,zero)
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
337 338
		:+: PlatformDependant
// winOnly
Diederik van Arkel's avatar
Diederik van Arkel committed
339
		// .exe name and location
Diederik van Arkel's avatar
Diederik van Arkel committed
340
		(	TextControl ("Source of resource section: "+++lo.resource_source)
Diederik van Arkel's avatar
Diederik van Arkel committed
341 342 343 344 345 346 347 348 349
			[ControlId rsrcsId,ControlPos (Left,zero)]
		:+: ButtonControl "Set resource source..."
			[ControlFunction setrsrcs,ControlPos (Left,zero)]
		// .dll symbol source
		:+: TextControl ("Source of dll symbols: "+++lo.dll_export_list_name)
			[ControlId symbolsId,ControlPos (Left,zero)]
		:+: ButtonControl "Set dll symbol source..."
			[ControlFunction setsymbols,ControlPos (Left,zero)]
		)
Diederik van Arkel's avatar
Diederik van Arkel committed
350 351
		NilLS
		)
Diederik van Arkel's avatar
Diederik van Arkel committed
352
/*
Diederik van Arkel's avatar
Diederik van Arkel committed
353 354 355
	where			
		inilinkmethod = case lo.method of
			LM_Static	-> 1
Diederik van Arkel's avatar
Diederik van Arkel committed
356 357 358
			LM_Dynamic	-> 2
*/
/*
Diederik van Arkel's avatar
Diederik van Arkel committed
359 360
			LM_Eager	-> 2
			LM_Dynamic	-> 3
Diederik van Arkel's avatar
Diederik van Arkel committed
361
*/
Diederik van Arkel's avatar
Diederik van Arkel committed
362 363
	setrsrcs (ls,ps)
		# (rsrcname,ps)	= PlatformDependant
364
							(selectOutputFile` "Resource source" "*.exe" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
365 366 367 368 369 370 371 372 373 374 375 376 377 378
							(selectOutputFile "Resource source" "" ps)		// mac
		| isNothing rsrcname
			= (ls,ps)
		# rsrcname		= fromJust rsrcname
		# (appPath,ps)	= getStup ps
		# (prjPath,ps)	= getPath ps
		# prjPath		= RemoveFilename prjPath
		# rsrcname		= symPath appPath prjPath rsrcname
		# ls			= {ls & lo = {ls.lo & resource_source = rsrcname}}
		# ps			= appPIO (setControlText rsrcsId ("Source of resource section: "+++rsrcname)) ps
		= (ls,ps)

	setsymbols (ls,ps)
		# (symbname,ps)	= PlatformDependant
379
							(selectOutputFile` "DLL symbol source" "*" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
							(selectOutputFile "DLL symbol source" "" ps)	// mac
		| isNothing symbname
			= (ls,ps)
		# symbname		= fromJust symbname
		# (appPath,ps)	= getStup ps
		# (prjPath,ps)	= getPath ps
		# prjPath		= RemoveFilename prjPath
		# symbname		= symPath appPath prjPath symbname
		# ls			= {ls & lo = {ls.lo & dll_export_list_name = symbname}}
		# ps			= appPIO (setControlText symbolsId ("Source of dll symbols: "+++symbname)) ps
		= (ls,ps)

	objectsPane = Pane "Extra Objects"
		{addLS = inifull
		,addDef
		=	TextControl "Object Paths" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addObject
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remObject
				, ControlWidth buttonWidth
				]
			) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
		:+: lbobj
		:+: CheckControl
			[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			, ControlId c2id
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo.extraObjectModules))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbobjId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addObject ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & lo = {tg.lo & extraObjectModules = Append tg.lo.extraObjectModules pathname}}
				ps					= appendExtListBoxItems lbobjId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remObject ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbobjId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & lo = {tg.lo & extraObjectModules = RemoveMembers tg.lo.extraObjectModules (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}}
				ps					= closeExtListBoxItems lbobjId indexsel ps
				ps					= setExtListBoxSelection lbobjId [] ps
			= ((full,tg),ps)
440
		showFullPaths ((full,tg=:{lo}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
441 442 443
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c2id) ps
				ps		= closeAllExtListBoxItems lbobjId ps
444
				ps		= appendExtListBoxItems lbobjId (zip3 (FullPaths full ap pp (StrictListToList lo.extraObjectModules))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
			= ((full,tg),ps)
	slibsPane = Pane "Static Libraries"
		{addLS = inifull
		,addDef = TextControl "Static Libraries" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addSlib
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remSlib
				, ControlWidth buttonWidth
				]
			) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
		:+: lbobj
		:+: CheckControl
			[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			, ControlId c3id
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList (SL_Libs sl)))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbslibId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addSlib ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & sl = SL_Add pathname tg.sl}
				ps					= appendExtListBoxItems lbslibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remSlib ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbslibId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & sl = SL_Rem pathsel ap pp sl}
				ps					= closeExtListBoxItems lbslibId indexsel ps
				ps					= setExtListBoxSelection lbslibId [] ps
			= ((full,tg),ps)
493
		showFullPaths ((full,tg=:{sl}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
494 495 496
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c3id) ps
				ps		= closeAllExtListBoxItems lbslibId ps
497
				ps		= appendExtListBoxItems lbslibId (zip3 (FullPaths full ap pp (StrictListToList (SL_Libs sl)))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545
			= ((full,tg),ps)
	dlibsPane = Pane "Dynamic Libraries"
		{addLS = inifull
		,addDef = TextControl "Dynamic Libraries" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addDlib
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remDlib
				, ControlWidth buttonWidth
				]
			) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
		:+: lbobj
		:+: CheckControl
			[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			, ControlId c4id
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo.libraries))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbdlibId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addDlib ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & lo = {tg.lo & libraries = Append tg.lo.libraries pathname}}
				ps					= appendExtListBoxItems lbdlibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remDlib ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbdlibId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & lo = {tg.lo & libraries = RemoveMembers tg.lo.libraries (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}}
				ps					= closeExtListBoxItems lbdlibId indexsel ps
				ps					= setExtListBoxSelection lbdlibId [] ps
			= ((full,tg),ps)
546
		showFullPaths ((full,tg=:{lo}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
547 548 549
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c4id) ps
				ps		= closeAllExtListBoxItems lbdlibId ps
550
				ps		= appendExtListBoxItems lbdlibId (zip3 (FullPaths full ap pp (StrictListToList lo.libraries))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
551 552
			= ((full,tg),ps)

Diederik van Arkel's avatar
Diederik van Arkel committed
553
pathsPane ap pp paths inifull height lbpadId c1id r1id root_path
Diederik van Arkel's avatar
Diederik van Arkel committed
554 555 556 557 558 559 560 561 562 563 564 565
  = Pane "Project Paths"
	{addLS = inifull
	,addDef = TextControl "Project Paths" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction addPath
			, ControlWidth buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos (Left,zero)
			, ControlFunction removePath
			, ControlWidth buttonWidth
Diederik van Arkel's avatar
Diederik van Arkel committed
566 567
			, ControlId r1id
			, ControlSelectState Unable
Diederik van Arkel's avatar
Diederik van Arkel committed
568
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
569 570
		:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
		:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
Diederik van Arkel's avatar
Diederik van Arkel committed
571 572 573 574 575 576 577 578 579 580 581 582 583 584
		) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
	:+: lbpad
	:+: CheckControl
		[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
		]
		(Columns 1)
		[ ControlPos (Left,zero)
		, ControlId c1id
		]
	}
where
	lbpad = ExtListBoxControl
  				(zip3(FullPaths inifull ap pp (StrictListToList paths))(repeat id)(repeat id))
  				[] // initial selection
Diederik van Arkel's avatar
Diederik van Arkel committed
585 586 587 588
  				(\sel ps->case sel of
  					[]	-> appPIO (disableControl r1id) ps
  					_	-> appPIO (enableControl r1id) ps
  				)						// selection update function
Diederik van Arkel's avatar
Diederik van Arkel committed
589
  				lbpadId
Diederik van Arkel's avatar
Diederik van Arkel committed
590
  				[ControlViewSize {h=height,w=300}]
Diederik van Arkel's avatar
Diederik van Arkel committed
591
	buttonWidth = ContentWidth "Append..."
Diederik van Arkel's avatar
Diederik van Arkel committed
592 593 594 595 596 597 598 599 600 601 602 603
	lbUp ((full,tg),ps)
		# lo = tg.paths
		# (_,(lo,ps)) = upSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# tg = {tg & paths = lo}
		= ((full,tg),ps)
	lbDn ((full,tg),ps)
		# lo = tg.paths
		# (_,(lo,ps)) = dnSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# tg = {tg & paths = lo}
		= ((full,tg),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623
	addPath ((full,tg),ps)
		#	(fs,ps)				= selectDirectory` ps
		| isNothing fs = ((full,tg),ps)
		#	pathname			= fromJust fs
			tg					= {tg & paths = Append tg.paths pathname}
			ps					= appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
		= ((full,tg),ps)
	removePath ((full,tg),ps)
		#	((ok,sel),ps)		= getExtListBoxSelection lbpadId ps
		| not ok || isEmpty sel
			= ((full,tg),ps)
		#	(pathsel,indexsel)	= unzip sel
			pathsel				= ListToStrictList [fulPath ap pp s \\ s <- pathsel]
		| StringOccurs root_path pathsel
			#! ps				= okNotice ["Removing path to main module not allowed."] ps
			= ((full,tg),ps)
		#	tg					= {tg & paths = RemoveMembers tg.paths pathsel}
			ps					= closeExtListBoxItems lbpadId indexsel ps
			ps					= setExtListBoxSelection lbpadId [] ps
		= ((full,tg),ps)
624
	showFullPaths ((full,tg=:{paths}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
625 626 627
		#	full	= not full
			ps		= appPIO (setCheckControlMark full c1id) ps
			ps		= closeAllExtListBoxItems lbpadId ps
628
			ps		= appendExtListBoxItems lbpadId (zip3 (FullPaths full ap pp (StrictListToList paths))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
629 630 631 632 633 634 635
		= ((full,tg),ps)

setCheckControlMark full id io
	= case full of
		True	-> markCheckControlItems id [1] io
		False	-> unmarkCheckControlItems id [1] io

636
doPathsDialog :: !String !Pathname !Pathname !(List Pathname) ((List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661
doPathsDialog titlestring ap pp lo set ps
	#	(wid,ps)	= openId ps
		(okid,ps)	= openId ps
		(cancelid,ps)	= openId ps
		buttonwidth = ContentWidth "Append..."
		(siz,ps)	= controlSize (LayoutControl
						(	ButtonControl "Append..."
							[ ControlWidth buttonwidth
							]
						:+:	ButtonControl "Remove"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						:+:	ButtonControl "Up"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						:+:	ButtonControl "Dn"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0])
						True
						Nothing Nothing Nothing ps
		(lb1Id,ps) = openExtListBoxId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
662
		(r1id,ps) = openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
663 664 665
		lbpad = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo))(repeat id)(repeat id))
	  				[] // initial selection
Diederik van Arkel's avatar
Diederik van Arkel committed
666 667 668 669
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r1id) ps
	  					_	-> appPIO (enableControl r1id) ps
	  				)						// selection update function
Diederik van Arkel's avatar
Diederik van Arkel committed
670 671
	  				lb1Id
	  				[ControlViewSize {h=siz.Size.h,w=300}]
Diederik van Arkel's avatar
Diederik van Arkel committed
672
		(_,ps) = openModalDialog (lo,inifull) (ddef wid okid cancelid lbpad lb1Id r1id siz) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
673 674 675
	= ps
where
	inifull = False
Diederik van Arkel's avatar
Diederik van Arkel committed
676
	ddef wid okId cancelId lb1 lb1Id r1id siz = Dialog "Paths"
Diederik van Arkel's avatar
Diederik van Arkel committed
677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701
			(title :+: left :+: buttons)
			[WindowId wid, WindowOk okId, WindowCancel cancelId, WindowClose cancel]
	where
		title
			=	TextControl titlestring [ControlPos (Center,zero)]
		buttons
			=	ButtonControl "Cancel" [ControlFunction cancel, ControlPos (Left,zero), ControlId cancelId]
			:+: ButtonControl "OK" [ControlFunction okfun, ControlId okId]
		cancel (ls,ps)
			# ps = closeWindow wid ps
			= (ls, ps)
		okfun ((lo,full),ps)
			#	ps = set lo ps
				ps = closeWindow wid ps
			= ((lo,full), ps)

		left = LayoutControl
				(TextControl "Paths" []
				:+: LayoutControl
					(	ButtonControl "Append..." 
						[ ControlFunction addPath
						]
					:+: ButtonControl "Remove"
						[ ControlPos (Left,zero)
						, ControlFunction removePath
Diederik van Arkel's avatar
Diederik van Arkel committed
702 703
						, ControlSelectState Unable
						, ControlId r1id
Diederik van Arkel's avatar
Diederik van Arkel committed
704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744
						]
						:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
						:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
					) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
				:+: lb1
				:+: CheckControl
					[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				)
				[ControlPos (Left,zero)]
		where
			lbUp ((lo,full),ps)
				# (_,(lo,ps)) = upSelItem lb1Id (StrictListToList lo,ps)
				= ((ListToStrictList lo,full),ps)
			lbDn ((lo,full),ps)
				# (_,(lo,ps)) = dnSelItem lb1Id (StrictListToList lo,ps)
				= ((ListToStrictList lo,full),ps)
			addPath ((lo,full),ps)
				#	(fs,ps)				= selectDirectory` ps
				| isNothing fs = ((lo,full),ps)
				#	pathname			= fromJust fs
				#	lo					= Append lo pathname
				#	ps					= appendExtListBoxItems lb1Id (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
				= ((lo,full),ps)
			removePath ((lo,full),ps)
				#	((ok,sel),ps)		= getExtListBoxSelection lb1Id ps
				| not ok || isEmpty sel = ((lo,full),ps)
				#	(pathsel,indexsel)	= unzip sel
					lo					= seq [RemoveStringFromList (fulPath ap pp s) \\ s <- pathsel] lo
					ps					= closeExtListBoxItems lb1Id indexsel ps
					ps					= setExtListBoxSelection lb1Id [] ps
				= ((lo,full),ps)
			showFullPaths ((lo,full),ps)
				#	full				= not full
					ps					= closeAllExtListBoxItems lb1Id ps
					ps					= appendExtListBoxItems lb1Id (zip3 (FullPaths full ap pp (StrictListToList lo))(repeat id)(repeat id)) ps
				= ((lo,full),ps)
		
745
doCompilerOptionsDialog :: !String !CompilerOptions (CompilerOptions (PSt .l) -> (PSt .l)) !(PSt .l) -> (PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853
doCompilerOptionsDialog titlestring ini set ps
	# (wid,ps) = accPIO openId ps
	# (cid,ps) = accPIO openId ps
	# (okId,ps) = accPIO openId ps
	# (_,ps) = openModalDialog ini (ddef okId wid cid) ps
	= ps
where
	ddef okId wid cancelId = Dialog titlestring
			(title :+: left :+: right :+: buttons)
			[WindowId wid
			,WindowOk okId
			,WindowClose cancel
			,WindowCancel cancelId
			]
	where
		title = TextControl titlestring [ControlPos (Center,zero)]
		left = LayoutControl
				(TextControl "Program Analysis" []
				:+: CheckControl
					[ ("Strictness Analyzer",Nothing,toMark ini.sa,noPS (\l->{l & sa = not l.sa}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				:+: TextControl "Code Generation"
					[ ControlPos (Left,OffsetVector {zero & vy = 10})
					]
				:+: CheckControl
					[ ("Generate Comments",Nothing,toMark ini.gc,noPS (\l->{l & gc = not l.gc}))
					, ("Reuse Unique Nodes",Nothing,toMark ini.reuseUniqueNodes,noPS (\l->{l & reuseUniqueNodes = not l.reuseUniqueNodes}))
					, ("Never Time Profile",Nothing,toMark ini.neverTimeProfile,noPS (\l->{l & neverTimeProfile = not l.neverTimeProfile}))
//					, ("Never Memory Profile",Nothing,toMark ini.neverMemoryProfile,noPS (\l->{l & neverMemoryProfile = not l.neverMemoryProfile}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				)
				[ControlPos (Left,zero)]
		right = LayoutControl
				(TextControl "Diagnostics" []
				:+: CheckControl
					[ ("Give Warnings",Nothing,toMark ini.gw,noPS (\l->{l & gw = not l.gw}))
					, ("Be Verbose",Nothing,toMark ini.bv,noPS (\l->{l & bv = not l.bv}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				:+: TextControl "List Types"
					[ ControlPos (Left,OffsetVector {zero & vy = 10})
					]
				:+: RadioControl
					[ ("No Types",Nothing,noPS (\l->{l & listTypes = NoTypes}))
					, ("Inferred Types",Nothing,noPS (\l->{l & listTypes = InferredTypes}))
					, ("Strict Export Types",Nothing,noPS (\l->{l & listTypes = StrictExportTypes}))
					, ("All Types",Nothing,noPS (\l->{l & listTypes = AllTypes}))
					]
					(Columns 1)
					(case ini.listTypes of
						NoTypes				-> 1
						InferredTypes		-> 2
						StrictExportTypes	-> 3
						AllTypes			-> 4
					)
					[ ControlPos (Left,zero)
					]
				:+: CheckControl
					[ ("Show Attributes",Nothing,toMark ini.attr,noPS (\l->{l & attr = not l.attr}))
					]
					(Columns 1)
					[ControlPos (Left,zero)
					]
				)
				[]
		buttons
			=	ButtonControl "Cancel"
				[ ControlWidth (ContentWidth "Cancel")
				, ControlFunction cancel
				, ControlPos (Left,zero)
				, ControlId cancelId
				]
			:+: ButtonControl "OK"
				[ ControlWidth (ContentWidth "Cancel")
				, ControlFunction okfun
				, ControlId okId
				]
		cancel (ls,ps)
			# ps = closeWindow wid ps
			= (ls, ps)
		okfun (ls,ps)
			# ps = closeWindow wid ps
			  ps = set ls ps
			= (ls, ps)

//---

// 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 
Diederik van Arkel's avatar
Diederik van Arkel committed
854 855
		mega		= mem rem Mega  == 0;
		kilo		= mem rem Kilo  == 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958
		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);
	
// Converts a string into a number

StringToInt	:: !String -> Int;
StringToInt string =  TextToNumber string 0;

TextToNumber :: !String !Int -> Int;
TextToNumber ""	n				=  n;
TextToNumber s	n	| isdigit	=  number;
								=  n;
	where 
	number		= TextToNumber (s % (1, dec (size s))) ( 10 * n  + d);
	(isdigit,d)	= Digit (s .[ 0]);
	

Digit :: !Char -> (!Bool, !Int);
Digit '0'  =  (True, 0); 	  Digit '1' =  (True, 1);
Digit '2'  =  (True, 2); 	  Digit '3' =  (True, 3);
Digit '4'  =  (True, 4); 	  Digit '5' =  (True, 5);
Digit '6'  =  (True, 6); 	  Digit '7' =  (True, 7);
Digit '8'  =  (True, 8);	  Digit '9' =  (True, 9);
Digit c	   =  (False,0);

	
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];

StringToFixedPoint :: !String -> Int
StringToFixedPoint s
	| n<512+128
		= 512+128;
	| n>100<<8
		= 100<<8;
		= n;
where
		n=string_to_fixed_point 0 0 s;
		
		string_to_fixed_point i v s
			| i>= size s
				= v<<8;
			| char>='0' && char<='9'
				= string_to_fixed_point (inc i) (v*10+(toInt char-48)) s;
			| char=='.'
				= (v<<8)+fraction (inc i) s;
				= v<<8;
		where
				char=s.[i];
			
		fraction i s
			| i>= size s || char1<'0' || char1>'9'
				= 0;
			| inc i>= size s || char2<'0' || char2>'9'
				= ((toInt char1-48)<<8) / 10;
				= (((toInt char1-48)*10+(toInt char2-48))<<8)/100;
		where
			char1=s.[i];
			char2=s.[inc i];

FixedPointToString :: !.Int -> String
FixedPointToString n
	| n<512+128
		= "2.5";
	| n>100<<8
		= "100";
	| second_digit<>0
		= toString (n>>8)+++"."+++toString first_digit+++toString second_digit;
	| first_digit<>0
		= toString (n>>8)+++"."+++toString first_digit;
		= toString (n>>8);
where
		first_digit=fraction / 10;
Diederik van Arkel's avatar
Diederik van Arkel committed
959
		second_digit=fraction rem 10;
Diederik van Arkel's avatar
Diederik van Arkel committed
960 961 962 963 964 965 966 967 968 969 970 971
		fraction=toInt (toReal (n bitand 255) * 100.0 / 256.0);

//-- path fiddling utils

FullPath True _ _ l = l
FullPath False ap pp l = symPath ap pp l

FullPaths True _ _ l = l
FullPaths False ap pp l
	#	l = map (symPath ap pp) l
	#	l = map (symPath ap pp) l
	= l