StdWindow.icl 77.5 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
implementation module StdWindow


//	Clean Object I/O library, version 1.2


7
8
9
10
11
12
import	StdBool, StdFunc, StdList, StdMisc, StdTuple
import	ossystem, ostypes, oswindow
import	StdControlClass
from	StdId				import getParentId
from	StdPSt				import appPIO, accPIO
from	StdSystem			import maxScrollWindowSize
13
import	commondef, controlpos, iostate, scheduler, windowaccess, windowcreate, windowdevice, windowhandle, windowupdate, wstate
14
15
16
17
18
19
20
21
22
23
24
25
from	controlinternal		import enablecontrols, disablecontrols
from	controllayout		import layoutControls
from	controlrelayout		import relayoutControls
from	controlvalidate		import controlIdsAreConsistent
from	keyfocus			import getCurrentFocusItem
from	StdWindowAttribute	import	isWindowCursor,   getWindowCursorAtt,
									isWindowId,       getWindowIdAtt, 
									isWindowHMargin,  getWindowHMarginAtt,
									isWindowItemSpace,getWindowItemSpaceAtt,
									isWindowKeyboard, getWindowKeyboardAtt,
									isWindowMouse,    getWindowMouseAtt,
									isWindowVMargin,  getWindowVMarginAtt
Peter Achten's avatar
Peter Achten committed
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
from	windowclipstate	import validateWindowClipState, forceValidWindowClipState
from	windowdispose	import disposeWindow
from	windowdraw		import drawinwindow, drawwindowlook
from	windowvalidate	import validateWindowId, validateViewDomain, exactWindowPos, exactWindowSize


//	General functions:

StdWindowFatalError :: String String -> .x
StdWindowFatalError function error
	= FatalError function "StdWindow" error

//	Use these two macros to identify windows and dialogues.
windowtype	:==	"Window"
dialogtype	:== "Dialog"

class Windows wdef where
43
44
	openWindow		:: .ls !(wdef .ls (PSt .l)) !(PSt .l)	-> (!ErrorReport,!PSt .l)
	getWindowType	::      (wdef .ls .pst)					-> WindowType
Peter Achten's avatar
Peter Achten committed
45
46

class Dialogs wdef where
47
48
49
	openDialog		:: .ls !(wdef .ls (PSt .l)) !(PSt .l)	-> (  !ErrorReport,            !PSt .l)
	openModalDialog	:: .ls !(wdef .ls (PSt .l)) !(PSt .l)	-> (!(!ErrorReport,!Maybe .ls),!PSt .l)
	getDialogType	::      (wdef .ls .pst)					-> WindowType
Peter Achten's avatar
Peter Achten committed
50
51

instance Windows (Window c) | Controls c where
52
	openWindow :: .ls !(Window c .ls (PSt .l)) !(PSt .l) -> (!ErrorReport,!PSt .l) | Controls c
Peter Achten's avatar
Peter Achten committed
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
	openWindow ls (Window title controls atts) pState
		# pState				= WindowFunctions.dOpen pState
		# (isZero,pState)		= accPIO checkZeroWindowBound pState
		| isZero
			= (ErrorViolateDI,pState)
		# maybe_id				= getWindowIdAttribute atts
		# (maybe_okId,pState)	= accPIO (validateWindowId maybe_id) pState
		| isNothing maybe_okId
			= (ErrorIdsInUse,pState)
		# (cs,pState)			= controlToHandles controls pState
		# (rt,ioState)			= IOStGetReceiverTable pState.io
		# (it,ioState)			= IOStGetIdTable ioState
		# (ioId,ioState)		= IOStGetIOId ioState
		  itemHs				= map ControlStateToWElementHandle cs
		  okId					= fromJust maybe_okId
		  (ok,itemHs,rt,it)		= controlIdsAreConsistent ioId okId itemHs rt it
		  it					= if ok (snd (addIdToIdTable okId {idpIOId=ioId,idpDevice=WindowDevice,idpId=okId} it)) it
		# ioState				= IOStSetIdTable it ioState
		# ioState				= IOStSetReceiverTable rt ioState
		# pState				= {pState & io=ioState}
		| not ok
			= (ErrorIdsInUse,pState)
		| otherwise
			# wH				= initWindowHandle title Modeless IsWindow (WindowInfo undef) itemHs atts
			# pState			= openwindow okId {wlsState=ls,wlsHandle=wH} pState
			# pState			= appPIO decreaseWindowBound pState
			= (NoError,pState)
	
	getWindowType :: (Window c .ls .pst) -> WindowType | Controls c
	getWindowType _
		= windowtype

instance Dialogs (Dialog c) | Controls c where
86
	openDialog :: .ls !(Dialog c .ls (PSt .l)) !(PSt .l) -> (!ErrorReport,!PSt .l) | Controls c
Peter Achten's avatar
Peter Achten committed
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
	openDialog ls (Dialog title controls atts) pState
		# pState				= WindowFunctions.dOpen pState
		# maybe_id				= getWindowIdAttribute atts
		# (maybe_okId,pState)	= accPIO (validateWindowId maybe_id) pState
		| isNothing maybe_okId
			= (ErrorIdsInUse,pState)
		# (cs,pState)			= controlToHandles controls pState
		# (rt,ioState)			= IOStGetReceiverTable pState.io
		# (it,ioState)			= IOStGetIdTable ioState
		# (ioId,ioState)		= IOStGetIOId ioState
		  itemHs				= map ControlStateToWElementHandle cs
		  okId					= fromJust maybe_okId
		  (ok,itemHs,rt,it)		= controlIdsAreConsistent ioId okId itemHs rt it
		  it					= if ok (snd (addIdToIdTable okId {idpIOId=ioId,idpDevice=WindowDevice,idpId=okId} it)) it
		# ioState				= IOStSetIdTable it ioState
		# ioState				= IOStSetReceiverTable rt ioState
		# pState				= {pState & io=ioState}
		| not ok
			= (ErrorIdsInUse,pState)
		| otherwise
			# wH				= initWindowHandle title Modeless IsDialog NoWindowInfo itemHs atts
			= (NoError,openwindow okId {wlsState=ls,wlsHandle=wH} pState)
	
110
	openModalDialog :: .ls !(Dialog c .ls (PSt .l)) !(PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l) | Controls c
Peter Achten's avatar
Peter Achten committed
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
	openModalDialog ls (Dialog title controls atts) pState
		# pState				= WindowFunctions.dOpen pState
		# maybe_id				= getWindowIdAttribute atts
		# (maybe_okId,pState)	= accPIO (validateWindowId maybe_id) pState
		| isNothing maybe_okId
			= ((ErrorIdsInUse,Nothing),pState)
		# (cs,pState)			= controlToHandles controls pState
		# (rt,ioState)			= IOStGetReceiverTable pState.io
		# (it,ioState)			= IOStGetIdTable ioState
		# (ioId,ioState)		= IOStGetIOId ioState
		  itemHs				= map ControlStateToWElementHandle cs
		  okId					= fromJust maybe_okId
		  (ok,itemHs,rt,it)		= controlIdsAreConsistent ioId okId itemHs rt it
		  it					= if ok (snd (addIdToIdTable okId {idpIOId=ioId,idpDevice=WindowDevice,idpId=okId} it)) it
		# ioState				= IOStSetIdTable it ioState
		# ioState				= IOStSetReceiverTable rt ioState
		# pState				= {pState & io=ioState}
		| not ok
			= ((ErrorIdsInUse,Nothing),pState)
		| otherwise
			# wH				= initWindowHandle title Modal IsDialog NoWindowInfo itemHs atts
			# (errorReport,finalLS,pState)
								= openmodalwindow okId {wlsState=ls,wlsHandle=wH} pState
			= ((errorReport,finalLS),pState)
	
	getDialogType :: (Dialog c .ls .pst) -> WindowType | Controls c
	getDialogType _
		= dialogtype


getWindowIdAttribute :: ![WindowAttribute .pst] -> Maybe Id
getWindowIdAttribute atts
	# (hasIdAtt,idAtt)	= Select isWindowId undef atts
	| hasIdAtt			= Just (getWindowIdAtt idAtt)
	| otherwise			= Nothing


/*	closeWindow closes the indicated window.
*/
150
closeWindow :: !Id !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
151
152
153
closeWindow id pState
	= disposeWindow (toWID id) pState

154
closeActiveWindow :: !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
155
156
157
158
159
160
161
162
163
164
closeActiveWindow pState
	# (maybeId,pState)	= accPIO getActiveWindow pState
	| isNothing maybeId
		= pState
	| otherwise
		= closeWindow (fromJust maybeId) pState


/*	setActiveWindow activates the given window.
*/
165
setActiveWindow :: !Id !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
166
setActiveWindow wId pState
167
168
169
170
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice pState.io
	| not found
		= {pState & io=ioState}
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
171
172
173
174
175
176
177
178
179
	  (exists,windows)			= hasWindowHandlesWindow wid windows
	| not exists				// Indicated window does not exist
		= {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
	# (activeWIDS,windows)		= getWindowHandlesActiveWindow windows
	| isNothing activeWIDS		// There are no windows, so skip it
		= {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
	# wids						= fromJust activeWIDS
	| exists && wids.wId==wId	// If already active, then skip
		= {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
180
	# (wHs,windows)				= getWindowHandlesWindows windows
Peter Achten's avatar
Peter Achten committed
181
182
	  (modal,modeless)			= Uspan ismodalwindow wHs
	  (isModal,modal)			= UContains (identifyWindowStateHandle wid) modal
183
	| isModal					// Modal windows should not be activated
Peter Achten's avatar
Peter Achten committed
184
185
		= {pState & io=IOStSetDevice (WindowSystemState {windows & whsWindows=modal++modeless}) ioState}
	# (osdInfo,ioState)			= IOStGetOSDInfo ioState
186
187
188
189
	  isSDI						= getOSDInfoDocumentInterface osdInfo==SDI
	  (framePtr,clientPtr)		= case (getOSDInfoOSInfo osdInfo) of
	  								Just info -> (info.osFrame,info.osClient)
	  								_         -> (OSNoWindowPtr,OSNoWindowPtr)
Peter Achten's avatar
Peter Achten committed
190
191
192
193
194
195
196
	| isEmpty modal				// There are no modal windows, so put activated window in front
		# (_,wsH,others)		= URemove (identifyWindowStateHandle wid) undef modeless
		  (shown,wsH)			= getWindowStateHandleShow wsH
		# (wids,wsH)			= getWindowStateHandleWIDS wsH
		  activatePtr			= if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr		// Do not activate SDI client, but SDI frame
		  showAction			= if shown id (snd o OSshowWindow activatePtr True)
		# ioState				= IOStSetDevice (WindowSystemState {windows & whsWindows=[wsH:others]}) ioState
197
198
199
200
201
//		# (delayinfo,ioState)	= accIOToolbox (OSactivateWindow osdInfo activatePtr o showAction) ioState
		# (tb,ioState)			= getIOToolbox ioState
		# pState				= {pState & io=ioState}
		# (delayinfo,pState,tb)	= OSactivateWindow osdInfo activatePtr handleOSEvent pState (showAction tb)
		# ioState				= setIOToolbox tb pState.io
Peter Achten's avatar
Peter Achten committed
202
203
204
205
206
207
208
209
210
211
212
		# ioState				= bufferDelayedEvents delayinfo ioState
		= {pState & io=ioState}
	| otherwise					// There are modal windows, so put activated window behind last modal
		# (befModals,lastModal)	= InitLast modal
		  (modalWIDS,lastModal)	= getWindowStateHandleWIDS lastModal
		  (_,wsH,others)		= URemove (identifyWindowStateHandle wid) undef modeless
		  (shown,wsH)			= getWindowStateHandleShow wsH
		  (modelessWIDS,wsH)	= getWindowStateHandleWIDS wsH
		  activatePtr			= if (isSDI && modelessWIDS.wPtr==clientPtr) framePtr modelessWIDS.wPtr	// Do not activate SDI client, but SDI frame
		  showAction			= if shown id (snd o OSshowWindow activatePtr True)
		# ioState				= IOStSetDevice (WindowSystemState {windows & whsWindows=befModals++[lastModal,wsH:others]}) ioState
213
214
215
216
217
218
//		# ioState				= appIOToolbox (showAction o OSstackWindow activatePtr modalWIDS.wPtr) ioState
		# (tb,ioState)			= getIOToolbox ioState
		# pState				= {pState & io=ioState}
		# (delayinfo,pState,tb)	= OSstackWindow activatePtr modalWIDS.wPtr handleOSEvent pState (showAction tb)
		# ioState				= setIOToolbox tb pState.io
		# ioState				= bufferDelayedEvents delayinfo ioState
Peter Achten's avatar
Peter Achten committed
219
220
221
222
		= {pState & io=ioState}
where
	wid							= toWID wId
	
223
	ismodalwindow :: !(WindowStateHandle .pst) -> *(!Bool,!WindowStateHandle .pst)
Peter Achten's avatar
Peter Achten committed
224
225
226
227
	ismodalwindow wsH
		# (mode,wsH)			= getWindowStateHandleWindowMode wsH
		= (mode==Modal,wsH)

228

Peter Achten's avatar
Peter Achten committed
229
230
/*	getActiveWindow returns the Id of the currently active window.
*/
231
getActiveWindow :: !(IOSt .l) -> (!Maybe Id, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
232
getActiveWindow ioState
233
234
235
236
237
238
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (activeWIDS,windows)		= getWindowHandlesActiveWindow windows
	# ioState					= IOStSetDevice (WindowSystemState windows) ioState
Peter Achten's avatar
Peter Achten committed
239
240
241
242
243
	= (mapMaybe (\{wId}->wId) activeWIDS,ioState)


/*	setActiveControl makes the indicated control active only if its parent window is already active.
*/
244
setActiveControl :: !Id !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
245
setActiveControl controlId pState=:{io}
246
	# (parentId,ioState)		= getParentId controlId io
Peter Achten's avatar
Peter Achten committed
247
248
	| isNothing parentId
		= {pState & io=ioState}
249
	# (activeId,ioState)		= getActiveWindow ioState
Peter Achten's avatar
Peter Achten committed
250
251
	| isNothing activeId
		= {pState & io=ioState}
252
253
	# parentId					= fromJust parentId
	# activeId					= fromJust activeId
Peter Achten's avatar
Peter Achten committed
254
255
	| parentId<>activeId
		= {pState & io=ioState}
256
257
258
259
260
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= {pState & io=ioState}
	# windows					= WindowSystemStateGetWindowHandles wDevice
	# (found,wsH,windows)		= getWindowHandlesWindow (toWID activeId) windows
Peter Achten's avatar
Peter Achten committed
261
262
263
	| not found
		= StdWindowFatalError "setActiveControl" "parent window could not be located"
	| otherwise
264
265
266
267
268
269
		# (tb,ioState)			= getIOToolbox ioState
		# (delayinfo,wsH,tb)	= setactivecontrol controlId wsH tb
		# ioState				= setIOToolbox tb ioState
		  windows				= setWindowHandlesWindow wsH windows
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
		# ioState				= bufferDelayedEvents delayinfo ioState
Peter Achten's avatar
Peter Achten committed
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
		= {pState & io=ioState}
where
	setactivecontrol :: !Id !(WindowStateHandle .pst) !*OSToolbox -> (![DelayActivationInfo],!WindowStateHandle .pst,!*OSToolbox)
	setactivecontrol controlId wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandle=wH=:{whKeyFocus,whItems}}} tb
		# (found,itemNr,itemPtr,itemHs)	= getWElementHandlesItemNrPtr controlId whItems
		| not found
			= StdWindowFatalError "setActiveControl" "indicated control could not be located"
		| otherwise
		//	# keyfocus					= setNewFocusItem itemNr whKeyFocus
			# (delayinfo,tb)			= OSactivateControl wshIds.wPtr itemPtr tb
			= (delayinfo,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & /*whKeyFocus=keyfocus,*/whItems=itemHs}}},tb)
	where
		getWElementHandlesItemNrPtr :: !Id ![WElementHandle .ls .pst] -> (!Bool,!Int,!OSWindowPtr,![WElementHandle .ls .pst])
		getWElementHandlesItemNrPtr id [itemH:itemHs]
			# (found,itemNr,itemPtr,itemH)	= getWElementHandleItemNrPtr id itemH
			| found
				= (found,itemNr,itemPtr,[itemH:itemHs])
			| otherwise
				# (found,itemNr,itemPtr,itemHs)	= getWElementHandlesItemNrPtr id itemHs
				= (found,itemNr,itemPtr,[itemH:itemHs])
		where
			getWElementHandleItemNrPtr :: !Id !(WElementHandle .ls .pst) -> (!Bool,!Int,!OSWindowPtr,!WElementHandle .ls .pst)
			getWElementHandleItemNrPtr id (WItemHandle itemH=:{wItemNr,wItems,wItemId,wItemPtr})
				| isNothing wItemId || fromJust wItemId<>id
					# (found,itemNr,itemPtr,itemHs)	= getWElementHandlesItemNrPtr id wItems
					= (found,itemNr,itemPtr,WItemHandle {itemH & wItems=itemHs})
				| otherwise
					= (True,wItemNr,wItemPtr,WItemHandle itemH)
			getWElementHandleItemNrPtr itemNr (WListLSHandle itemHs)
				# (found,itemNr,itemPtr,itemHs)		= getWElementHandlesItemNrPtr id itemHs
				= (found,itemNr,itemPtr,WListLSHandle itemHs)
			getWElementHandleItemNrPtr itemNr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
				# (found,itemNr,itemPtr,itemHs)		= getWElementHandlesItemNrPtr id itemHs
				= (found,itemNr,itemPtr,WExtendLSHandle {wExH & wExtendItems=itemHs})
			getWElementHandleItemNrPtr itemNr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
				# (found,itemNr,itemPtr,itemHs)		= getWElementHandlesItemNrPtr id itemHs
				= (found,itemNr,itemPtr,WChangeLSHandle {wChH & wChangeItems=itemHs})
		getWElementHandlesItemNrPtr _ _
			= (False,0,OSNoWindowPtr,[])
	setactivecontrol _ _ _
		= StdWindowFatalError "setActiveControl" "unexpected window placeholder argument"

/*	getActiveControl returns the Id of the currently active control. The Bool result is True only iff the 
	control could be found. In that case, if the control had an Id attribute, then (Just id) is returned,
	Nothing otherwise.
*/
316
getActiveControl :: !(IOSt .l) -> (!(!Bool,!Maybe Id),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
317
318
319
320
321
getActiveControl ioState
	# (activeId,ioState)		= getActiveWindow ioState
	| isNothing activeId
		= ((False,Nothing),ioState)
	# activeId					= fromJust activeId
322
323
324
325
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ((False,Nothing),ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
	# (hasWindow,wsH,windows)	= getWindowHandlesWindow (toWID activeId) windows
	| not hasWindow
		= StdWindowFatalError "getActiveControl" "active window could not be located"
	# (keyfocus,wsH)			= getWindowStateHandleKeyFocus wsH
	  maybeItemNr				= getCurrentFocusItem keyfocus
	| isNothing maybeItemNr
		# windows				= setWindowHandlesWindow wsH windows
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
		= ((False,Nothing),ioState)
	# (foundId,wsH)				= getControlIdFromItemNr (fromJust maybeItemNr) wsH
	  windows					= setWindowHandlesWindow wsH windows
	# ioState					= IOStSetDevice (WindowSystemState windows) ioState
	= (foundId,ioState)
where
	getControlIdFromItemNr :: !Int !(WindowStateHandle .pst) -> (!(!Bool,!Maybe Id),!WindowStateHandle .pst)
	getControlIdFromItemNr itemNr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
		# (_,foundId,itemHs)	= getWElementHandlesIdFromItemNr itemNr whItems
		= (foundId,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
	where
		getWElementHandlesIdFromItemNr :: !Int ![WElementHandle .ls .pst] -> (!Bool,!(!Bool,!Maybe Id),![WElementHandle .ls .pst])
		getWElementHandlesIdFromItemNr itemNr [itemH:itemHs]
			# (found,foundId,itemH)		= getWElementHandleIdFromItemNr itemNr itemH
			| found
				= (found,foundId,[itemH:itemHs])
			| otherwise
				# (found,foundId,itemHs)= getWElementHandlesIdFromItemNr itemNr itemHs
				= (found,foundId,[itemH:itemHs])
		where
			getWElementHandleIdFromItemNr :: !Int !(WElementHandle .ls .pst) -> (!Bool,!(!Bool,!Maybe Id),!WElementHandle .ls .pst)
			getWElementHandleIdFromItemNr itemNr (WItemHandle itemH=:{wItemNr,wItems,wItemId})
				| itemNr<>wItemNr
					# (found,foundId,itemHs)	= getWElementHandlesIdFromItemNr itemNr wItems
					= (found,foundId,WItemHandle {itemH & wItems=itemHs})
				| otherwise
					= (True,(True,wItemId),WItemHandle itemH)
			getWElementHandleIdFromItemNr itemNr (WListLSHandle itemHs)
				# (found,foundId,itemHs)		= getWElementHandlesIdFromItemNr itemNr itemHs
				= (found,foundId,WListLSHandle itemHs)
			getWElementHandleIdFromItemNr itemNr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
				# (found,foundId,itemHs)		= getWElementHandlesIdFromItemNr itemNr itemHs
				= (found,foundId,WExtendLSHandle {wExH & wExtendItems=itemHs})
			getWElementHandleIdFromItemNr itemNr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
				# (found,foundId,itemHs)		= getWElementHandlesIdFromItemNr itemNr itemHs
				= (found,foundId,WChangeLSHandle {wChH & wChangeItems=itemHs})
		getWElementHandlesIdFromItemNr _ _
			= (False,(False,Nothing),[])
	getControlIdFromItemNr _ _
		= StdWindowFatalError "getActiveControl" "unexpected window placeholder argument"


/*	stackWindow changes the stacking order of the current windows.
377
378
379
PA: previous implementation.
stackWindow :: !Id !Id !(PSt .l) -> PSt .l
stackWindow windowId behindId pState=:{io=ioState}
Peter Achten's avatar
Peter Achten committed
380
	| windowId==behindId	// Don't stack a window behind itself
381
		= pState
382
383
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
384
		= {pState & io=ioState}
385
	# windows						= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
386
387
	# (hasBehind,windows)			= hasWindowHandlesWindow (toWID behindId) windows
	| not hasBehind			// Behind window does not exist
388
389
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		= {pState & io=ioState}
Peter Achten's avatar
Peter Achten committed
390
391
	# (hasWindow,wsH,windows)		= getWindowHandlesWindow (toWID windowId) windows
	| not hasWindow			// Stack window does not exist
392
393
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		= {pState & io=ioState}
Peter Achten's avatar
Peter Achten committed
394
395
	# (mode,wsH)					= getWindowStateHandleWindowMode wsH
	| mode==Modal			// Stack window is modal, skip
396
397
		# ioState					= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
		= {pState & io=ioState}
Peter Achten's avatar
Peter Achten committed
398
399
400
401
	| otherwise
		# (_,_,windows)				= removeWindowHandlesWindow (toWID windowId) windows		// remove placeholder window
		# (wids,wsH)				= getWindowStateHandleWIDS wsH
		# (osdInfo,ioState)			= IOStGetOSDInfo ioState
402
403
404
405
		  isSDI						= getOSDInfoDocumentInterface osdInfo==SDI
		  (framePtr,clientPtr)		= case (getOSDInfoOSInfo osdInfo) of
	  									Just info -> (info.osFrame,info.osClient)
	  									_         -> (OSNoWindowPtr,OSNoWindowPtr)
Peter Achten's avatar
Peter Achten committed
406
407
408
409
		  wPtr						= if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr
		# (tb,ioState)				= getIOToolbox ioState
		# (windows,tb)				= stackwindows wsH wPtr behindId windows tb
		# ioState					= setIOToolbox tb ioState
410
411
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		= {pState & io=ioState}
Peter Achten's avatar
Peter Achten committed
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
440
441
442
443
444
445
446
447
448
449
where
/*	stackwindows stackwindow stackptr behindId
		places stackwindow behind the window identified by behindId.
*/
	stackwindows :: !(WindowStateHandle .pst) !OSWindowPtr !Id !(WindowHandles .pst) !*OSToolbox
															-> (!WindowHandles .pst, !*OSToolbox)
	stackwindows wsH wPtr behindId windows=:{whsWindows=wsHs} tb
		# (wsHs,tb)		= stackBehind wsH wPtr behindId wsHs tb
		= ({windows & whsWindows=wsHs},tb)
	where
		stackBehind :: !(WindowStateHandle .pst) !OSWindowPtr !Id ![WindowStateHandle .pst] !*OSToolbox
															  -> (![WindowStateHandle .pst],!*OSToolbox)
		stackBehind wsH wPtr behindId [wsH`:wsHs] tb
			# (wids`,wsH`)	= getWindowStateHandleWIDS wsH`
			| behindId<>wids`.wId
				# (wsHs,tb) = stackBehind wsH wPtr behindId wsHs tb
				= ([wsH`:wsHs],tb)
			# (mode`,wsH`)	= getWindowStateHandleWindowMode wsH`
			| mode`==Modal
				# (wsHs,tb)	= stackBehindLastModal wsH wPtr wids`.wPtr wsHs tb
				= ([wsH`:wsHs],tb)
				with
					stackBehindLastModal :: !(WindowStateHandle .pst) !OSWindowPtr !OSWindowPtr ![WindowStateHandle .pst] !*OSToolbox
																							-> (![WindowStateHandle .pst],!*OSToolbox)
					stackBehindLastModal wsH wPtr behindPtr [wsH`:wsHs] tb
						# (wids`,wsH`)	= getWindowStateHandleWIDS wsH`
						# (mode`,wsH`)	= getWindowStateHandleWindowMode wsH`
						| mode`==Modal
							# (wsHs,tb) = stackBehindLastModal wsH wPtr wids`.wPtr wsHs tb
							= ([wsH`:wsHs],tb)
						| otherwise
							= ([wsH,wsH`:wsHs],OSstackWindow wPtr behindPtr tb)
					stackBehindLastModal wsH wPtr behindPtr _ tb
						= ([wsH],OSstackWindow wPtr behindPtr tb)
			| otherwise
				= ([wsH`,wsH:wsHs],OSstackWindow wPtr wids`.wPtr tb)
		stackBehind _ _ _ _ _
			= StdWindowFatalError "stackBehind" "this alternative should not be reached"
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
493
*/
/*	PA: new implementation of stackWindow. Uses new windowaccess function, improved OSstackWindow.
*/
stackWindow :: !Id !Id !(PSt .l) -> PSt .l
stackWindow windowId behindId pState=:{io=ioState}
	| windowId==behindId	// Don't stack a window behind itself
		= pState
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= {pState & io=ioState}
	# windows						= WindowSystemStateGetWindowHandles wDevice
	# (hasBehind,windows)			= hasWindowHandlesWindow behindWID windows
	| not hasBehind			// Behind window does not exist
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		= {pState & io=ioState}
	# (hasWindow,wsH,windows)		= getWindowHandlesWindow windowWID windows
	| not hasWindow			// Stack window does not exist
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		= {pState & io=ioState}
	# (mode,wsH)					= getWindowStateHandleWindowMode wsH
	| mode==Modal			// Stack window is modal, skip
		# ioState					= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
		= {pState & io=ioState}
	| otherwise
		# (_,_,windows)				= removeWindowHandlesWindow windowWID windows		// remove placeholder window
		# (wids,wsH)				= getWindowStateHandleWIDS wsH
		# (behindWIDS,windows)		= addBehindWindowHandlesWindow behindWID wsH windows
		# ioState					= IOStSetDevice (WindowSystemState windows) ioState
		# (tb,ioState)				= getIOToolbox ioState
		# pState					= {pState & io=ioState}
		# (delayinfo,pState,tb)		= OSstackWindow wids.wPtr behindWIDS.wPtr handleOSEvent pState tb
		# ioState					= setIOToolbox tb pState.io
		# ioState					= bufferDelayedEvents delayinfo ioState
		= {pState & io=ioState}
where
	windowWID						= toWID windowId
	behindWID						= toWID behindId

/*	handleOSEvent turns handleOneEventForDevices into the form required by OSactivateWindow and OSstackWindow.
	(Used by stackWindow, setActiveWindow.)
*/
handleOSEvent :: !OSEvent !(!PSt .l,!*OSToolbox) -> (!PSt .l,!*OSToolbox)
handleOSEvent osEvent (pState,tb)
	= (thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState),tb)
Peter Achten's avatar
Peter Achten committed
494

495
getWindowStack :: !(IOSt .l) -> (![(Id,WindowType)],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
496
getWindowStack ioState
497
498
499
500
501
502
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ([],ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  wsHs						= windows.whsWindows
	  (id_types,wsHs)			= unzip (map getWindowIdType wsHs)
Peter Achten's avatar
Peter Achten committed
503
504
505
506
507
508
509
510
	= (id_types,IOStSetDevice (WindowSystemState {windows & whsWindows=wsHs}) ioState)
where
	getWindowIdType :: !(WindowStateHandle .pst) -> ((Id,WindowType),!WindowStateHandle .pst)
	getWindowIdType wsH
		# (wids,wsH)	= getWindowStateHandleWIDS wsH
		# (kind,wsH)	= getWindowStateHandleWindowKind wsH
		= ((wids.wId,if (kind==IsWindow) windowtype dialogtype),wsH)

511
getWindowsStack :: !(IOSt .l) -> (![Id],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
512
513
514
515
getWindowsStack ioState
	# (id_types,ioState)	= getWindowStack ioState
	= (FilterMap (\(id,wtype)->(wtype==windowtype,id)) id_types,ioState)

516
getDialogsStack :: !(IOSt .l) -> (![Id],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
517
518
519
520
521
522
523
getDialogsStack ioState
	# (id_types,ioState)	= getWindowStack ioState
	= (FilterMap (\(id,wtype)->(wtype==dialogtype,id)) id_types,ioState)


/*	Return layout attributes and default values.
*/
524
getDefaultHMargin :: !Bool !(IOSt .l) -> ((Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
525
526
527
528
529
530
531
getDefaultHMargin isWindow ioState
	| isWindow
		= ((0,0),ioState)
	| otherwise
		# ({osmHorMargin},ioState)	= IOStGetOSWindowMetrics ioState
		= ((osmHorMargin,osmHorMargin),ioState)

532
getDefaultVMargin :: !Bool !(IOSt .l) -> ((Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
533
534
535
536
537
538
539
getDefaultVMargin isWindow ioState
	| isWindow
		= ((0,0),ioState)
	| otherwise
		# ({osmVerMargin},ioState)	= IOStGetOSWindowMetrics ioState
		= ((osmVerMargin,osmVerMargin),ioState)

540
getDefaultItemSpace :: !Bool !(IOSt .l) -> ((Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
541
542
543
544
getDefaultItemSpace _ ioState
	# ({osmHorItemSpace,osmVerItemSpace},ioState)	= IOStGetOSWindowMetrics ioState
	= ((osmHorItemSpace,osmVerItemSpace),ioState)

545
getWindowHMargin :: !Id	!(IOSt .l) -> (!Maybe (Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
546
getWindowHMargin id ioState
547
548
549
550
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows						= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
551
552
553
554
	  (found,wsH,windows)			= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	| otherwise
555
556
		# (wMetrics,ioState)		= IOStGetOSWindowMetrics ioState
		# (marginAtt,wsH)			= gethmargin wMetrics wsH
Peter Achten's avatar
Peter Achten committed
557
558
		= (Just marginAtt,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
where
559
560
561
	gethmargin :: !OSWindowMetrics !(WindowStateHandle .pst) -> ((Int,Int),!WindowStateHandle .pst)
	gethmargin wMetrics wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
		= (getWindowHMargins whKind wMetrics whAtts,wsH)
Peter Achten's avatar
Peter Achten committed
562
563
564
	gethmargin _ _
		= StdWindowFatalError "getWindowHMargin" "unexpected window placeholder argument"

565
getWindowVMargin :: !Id	!(IOSt .l) -> (!Maybe (Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
566
getWindowVMargin id ioState
567
568
569
570
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows						= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
571
572
573
574
	  (found,wsH,windows)			= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	| otherwise
575
576
		# (wMetrics,ioState)		= IOStGetOSWindowMetrics ioState
		# (marginAtt,wsH)			= getvmargin wMetrics wsH
Peter Achten's avatar
Peter Achten committed
577
578
		= (Just marginAtt,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
where
579
580
581
	getvmargin :: !OSWindowMetrics !(WindowStateHandle .pst) -> ((Int,Int),!WindowStateHandle .pst)
	getvmargin wMetrics wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
		= (getWindowVMargins whKind wMetrics whAtts,wsH)
Peter Achten's avatar
Peter Achten committed
582
583
584
	getvmargin _ _
		= StdWindowFatalError "getWindowVMargin" "unexpected window placeholder argument"

585
getWindowItemSpace :: !Id !(IOSt .l) -> (!Maybe (Int,Int),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
586
getWindowItemSpace id ioState
587
588
589
590
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	| otherwise
		# ({osmHorItemSpace,osmVerItemSpace},ioState)
								= IOStGetOSWindowMetrics ioState
		# (marginAtt,wsH)		= getitemspaces (osmHorItemSpace,osmVerItemSpace) wsH
		= (Just marginAtt,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
where
	getitemspaces :: (Int,Int) !(WindowStateHandle .pst) -> ((Int,Int),!WindowStateHandle .pst)
	getitemspaces (defHSpace,defVSpace) wsH=:{wshHandle=Just {wlsHandle={whAtts}}}
		= (getWindowItemSpaceAtt (snd (Select isWindowItemSpace (WindowItemSpace defHSpace defVSpace) whAtts)),wsH)
	getitemspaces _ _
		= StdWindowFatalError "getWindowItemSpace" "unexpected window placeholder argument"


/*	Setting the SelectState of windows.
*/
609
enableWindow :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
610
enableWindow id ioState
611
612
613
614
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
615
616
617
618
619
620
621
622
623
624
625
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	# (curSelectState,wsH)		= getWindowStateHandleSelect wsH
	| curSelectState
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
		# (osdInfo, ioState)	= IOStGetOSDInfo ioState
626
627
628
629
		  isSDI					= getOSDInfoDocumentInterface osdInfo==SDI
		  framePtr				= case (getOSDInfoOSInfo osdInfo) of
		  							Just info -> info.osFrame
		  							_         -> OSNoWindowPtr
Peter Achten's avatar
Peter Achten committed
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (tb,ioState)			= getIOToolbox ioState
		  wsH					= setWindowStateHandleSelect True wsH
		  (wids,wsH)			= getWindowStateHandleWIDS wsH
		  wPtr					= wids.wPtr
		# (wH`,wsH,tb)			= retrieveWindowHandle` wsH tb
		# (wH`,tb)				= enablecontrols [] True wMetrics wPtr wH` tb
		  wsH					= insertWindowHandle` wH` wsH
		  (windowInfo,wsH)		= getWindowStateHandleWindowInfo wsH
		  scrollInfo			= case windowInfo of
		  							WindowInfo info	-> (isJust info.windowHScroll,isJust info.windowVScroll)
		  							other			-> (False,False)
		# tb					= OSenableWindow (if isSDI framePtr wPtr) scrollInfo False tb
		# tb					= OSinvalidateWindow wPtr tb
		# ioState				= setIOToolbox tb ioState
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState

647
disableWindow :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
648
disableWindow id ioState
649
650
651
652
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
653
654
655
656
657
658
659
660
661
662
663
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	# (curSelectState,wsH)		= getWindowStateHandleSelect wsH
	| not curSelectState
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
		# (osdInfo, ioState)	= IOStGetOSDInfo ioState
664
665
666
667
		  isSDI					= getOSDInfoDocumentInterface osdInfo==SDI
		  framePtr				= case (getOSDInfoOSInfo osdInfo) of
		  							Just info -> info.osFrame
		  							_         -> OSNoWindowPtr
Peter Achten's avatar
Peter Achten committed
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (tb,ioState)			= getIOToolbox ioState
		  wsH					= setWindowStateHandleSelect False wsH
		  (wids,wsH)			= getWindowStateHandleWIDS wsH
		  wPtr					= wids.wPtr
		# (wH`,wsH,tb)			= retrieveWindowHandle` wsH tb
		# (wH`,tb)				= disablecontrols [] True wMetrics wPtr wH` tb
		  wsH					= insertWindowHandle` wH` wsH
		/* Mike
		  (maybeWindowInfo,wsH)	= getWindowStateHandleWindowInfo wsH
		  scrollInfo			= case maybeWindowInfo of
		  							Nothing		-> (False,False)
		  							Just info	-> (isJust info.windowHScroll,isJust info.windowVScroll)
		*/
		  (windowInfo,wsH)		= getWindowStateHandleWindowInfo wsH
		  scrollInfo			= case windowInfo of
		  							WindowInfo info	-> (isJust info.windowHScroll,isJust info.windowVScroll)
		  							other			-> (False,False)
		# tb					= OSdisableWindow (if isSDI framePtr wPtr) scrollInfo False tb
		# tb					= OSinvalidateWindow wPtr tb
		# ioState				= setIOToolbox tb ioState
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState

691
enableWindowMouse :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
692
693
694
enableWindowMouse id ioState
	= setWindowMouseSelectState Able id ioState

695
disableWindowMouse :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
696
697
698
disableWindowMouse id ioState
	= setWindowMouseSelectState Unable id ioState

699
setWindowMouseSelectState :: !SelectState !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
700
setWindowMouseSelectState selectState id ioState
701
702
703
704
705
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
706
707
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
708
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
709
710
711
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
712
		# wsH					= setMouseSelectState selectState wsH
Peter Achten's avatar
Peter Achten committed
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setMouseSelectState :: !SelectState !(WindowStateHandle .pst) -> WindowStateHandle .pst
	setMouseSelectState selectState wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
		= {wsH & wshHandle=Just {wlsH & wlsHandle={wH & whAtts=setMouseSelectStateAtt selectState whAtts}}}
	where
		setMouseSelectStateAtt :: !SelectState ![WindowAttribute .pst] -> [WindowAttribute .pst]
		setMouseSelectStateAtt selectState atts
			# (found,mouseAtt,atts)	= Remove isWindowMouse undef atts
			| not found
				= atts
			| otherwise
				# (filter,_,fun)	= getWindowMouseAtt mouseAtt
				= [WindowMouse filter selectState fun:atts]
	setMouseSelectState _ _
		= StdWindowFatalError "setWindowMouseSelectState" "unexpected window placeholder argument"

730
enableWindowKeyboard :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
731
732
733
enableWindowKeyboard id ioState
	= setWindowKeyboardSelectState Able id ioState

734
disableWindowKeyboard :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
735
736
737
disableWindowKeyboard id ioState
	= setWindowKeyboardSelectState Unable id ioState

738
setWindowKeyboardSelectState :: !SelectState !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
739
setWindowKeyboardSelectState selectState id ioState
740
741
742
743
744
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
745
746
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
747
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
748
749
750
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
751
		# wsH					= setKeyboardSelectState selectState wsH
Peter Achten's avatar
Peter Achten committed
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setKeyboardSelectState :: !SelectState !(WindowStateHandle .pst) -> WindowStateHandle .pst
	setKeyboardSelectState selectState wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
		= {wsH & wshHandle=Just {wlsH & wlsHandle={wH & whAtts=setKeyboardSelectStateAtt selectState whAtts}}}
	where
		setKeyboardSelectStateAtt :: !SelectState ![WindowAttribute .pst] -> [WindowAttribute .pst]
		setKeyboardSelectStateAtt selectState atts
			# (found,keyAtt,atts)	= Remove isWindowKeyboard undef atts
			| not found
				= atts
			| otherwise
				# (filter,_,fun)	= getWindowKeyboardAtt keyAtt
				= [WindowKeyboard filter selectState fun:atts]
	setKeyboardSelectState _ _
		= StdWindowFatalError "setWindowKeyboardSelectState" "unexpected window placeholder argument"

769
getWindowSelectState :: !Id !(IOSt .l) -> (!Maybe SelectState,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
770
getWindowSelectState id ioState
771
772
773
774
775
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
776
777
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
778
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
779
780
781
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
782
		# (wSelect,wsH)			= getWindowStateHandleSelect wsH
Peter Achten's avatar
Peter Achten committed
783
784
		= (Just (if wSelect Able Unable),IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

785
getWindowMouseSelectState :: !Id !(IOSt .l) -> (!Maybe SelectState,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
786
getWindowMouseSelectState id ioState
787
788
789
790
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
		# (found,_,select,wsH)	= getWindowMouseAttInfo wsH
		= (if found (Just select) Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

getWindowMouseAttInfo :: !(WindowStateHandle .pst) -> (!Bool,MouseStateFilter,SelectState,!WindowStateHandle .pst)
getWindowMouseAttInfo wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
	# (hasMouseAtt,mouseAtt)	= Select isWindowMouse undef whAtts
	| not hasMouseAtt
		= (False,undef,undef,wsH)
	| otherwise
		# (filter,selectState,_)= getWindowMouseAtt mouseAtt
		= (True,filter,selectState,wsH)
getWindowMouseAttInfo _
	= StdWindowFatalError "getWindowMouseAttInfo" "unexpected window placeholder argument"

812
getWindowKeyboardSelectState :: !Id !(IOSt .l) -> (!Maybe SelectState,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
813
getWindowKeyboardSelectState id ioState
814
815
816
817
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
		# (found,_,select,wsH)	= getWindowKeyboardAttInfo wsH
		= (if found (Just select) Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

getWindowKeyboardAttInfo :: !(WindowStateHandle .pst) -> (!Bool,KeyboardStateFilter,SelectState,!WindowStateHandle .pst)
getWindowKeyboardAttInfo wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
	# (hasKeyAtt,keyAtt)		= Select isWindowKeyboard undef whAtts
	| not hasKeyAtt
		= (False,undef,undef,wsH)
	| otherwise
		# (filter,selectState,_)= getWindowKeyboardAtt keyAtt
		= (True,filter,selectState,wsH)
getWindowKeyboardAttInfo _
	= StdWindowFatalError "getWindowKeyboardAttInfo" "unexpected window placeholder argument"

839
getWindowMouseStateFilter :: !Id !(IOSt .l) -> (!Maybe MouseStateFilter,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
840
getWindowMouseStateFilter id ioState
841
842
843
844
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
845
846
847
848
849
850
851
852
853
854
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
		# (found,filter,_,wsH)	= getWindowMouseAttInfo wsH
		= (if found (Just filter) Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

855
getWindowKeyboardStateFilter :: !Id !(IOSt .l) -> (!Maybe KeyboardStateFilter,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
856
getWindowKeyboardStateFilter id ioState
857
858
859
860
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
861
862
863
864
865
866
867
868
869
870
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
		# (found,filter,_,wsH)	= getWindowKeyboardAttInfo wsH
		= (if found (Just filter) Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

871
setWindowMouseStateFilter :: !Id !MouseStateFilter !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
872
setWindowMouseStateFilter id filter ioState
873
874
875
876
877
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
878
879
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
880
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
881
882
883
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
884
		# wsH					= setMouseFilter filter wsH
Peter Achten's avatar
Peter Achten committed
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setMouseFilter :: !MouseStateFilter !(WindowStateHandle .pst) -> WindowStateHandle .pst
	setMouseFilter filter wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
		= {wsH & wshHandle=Just {wlsH & wlsHandle={wH & whAtts=setMouseStateFilterAtt filter whAtts}}}
	where
		setMouseStateFilterAtt :: !MouseStateFilter ![WindowAttribute .pst] -> [WindowAttribute .pst]
		setMouseStateFilterAtt filter atts
			# (found,mouseAtt,atts)	= Remove isWindowMouse undef atts
			| not found
				= atts
			| otherwise
				# (_,select,fun)	= getWindowMouseAtt mouseAtt
				= [WindowMouse filter select fun:atts]
	setMouseFilter _ _
		= StdWindowFatalError "setWindowMouseStateFilter" "unexpected window placeholder argument"

902
setWindowKeyboardStateFilter :: !Id !KeyboardStateFilter !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
903
setWindowKeyboardStateFilter id filter ioState
904
905
906
907
908
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows						= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)			= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
909
910
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
911
	# (wKind,wsH)					= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
912
913
914
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
915
		# wsH						= setKeyboardFilter filter wsH
Peter Achten's avatar
Peter Achten committed
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setKeyboardFilter :: !KeyboardStateFilter !(WindowStateHandle .pst) -> WindowStateHandle .pst
	setKeyboardFilter filter wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whAtts}}}
		= {wsH & wshHandle=Just {wlsH & wlsHandle={wH & whAtts=setKeyboardStateFilterAtt filter whAtts}}}
	where
		setKeyboardStateFilterAtt :: !KeyboardStateFilter ![WindowAttribute .pst] -> [WindowAttribute .pst]
		setKeyboardStateFilterAtt filter atts
			# (found,keyAtt,atts)	= Remove isWindowKeyboard undef atts
			| not found
				= atts
			| otherwise
				# (_,select,fun)	= getWindowKeyboardAtt keyAtt
				= [WindowKeyboard filter select fun:atts]
	setKeyboardFilter _ _
		= StdWindowFatalError "setWindowKeyboardStateFilter" "unexpected window placeholder argument"


//	Operations that are concerned with the background/look of a window. 

936
appWindowPicture:: !Id !.(IdFun *Picture) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
937
938
939
appWindowPicture id drawf ioState
	= snd (drawInWindow "appWindowPicture" id (\p->(undef,drawf p)) ioState)

940
accWindowPicture:: !Id !.(St *Picture .x) !(IOSt .l) -> (!Maybe .x,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
941
942
943
accWindowPicture id drawf ioState
	= drawInWindow "accWindowPicture" id drawf ioState

944
drawInWindow :: String !Id !.(St *Picture .x) !(IOSt .l) -> (!Maybe .x,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
945
drawInWindow functionname id drawf ioState
946
947
948
949
950
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
951
952
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
953
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
954
955
956
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
957
958
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# ((x,wsH),ioState)		= accIOToolbox (drawinwindow` wMetrics drawf wsH) ioState
Peter Achten's avatar
Peter Achten committed
959
960
961
962
963
964
965
966
967
968
969
		= (Just x,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
where
	drawinwindow` :: !OSWindowMetrics !.(St *Picture .x) !(WindowStateHandle .pst) !*OSToolbox
												 -> (!(.x,!WindowStateHandle .pst),!*OSToolbox)
	drawinwindow` wMetrics drawf wsH=:{wshIds={wPtr},wshHandle=Just wlsH=:{wlsHandle=wH}} tb
		# (wH,tb)			= validateWindowClipState wMetrics False wPtr wH tb
		# (x,wH,tb)			= drawinwindow wMetrics wPtr drawf wH tb
		= ((x,{wsH & wshHandle=Just {wlsH & wlsHandle=wH}}),tb)
	drawinwindow` _ _ _ _
		= StdWindowFatalError functionname "unexpected window placeholder argument"

970
updateWindow :: !Id !(Maybe ViewFrame) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
971
updateWindow id maybeViewFrame ioState
972
973
974
975
976
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
977
978
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
979
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
980
981
982
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
983
984
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (wsH,ioState)			= accIOToolbox (updateWindowBackground wMetrics maybeViewFrame wsH) ioState
Peter Achten's avatar
Peter Achten committed
985
986
987
988
989
990
991
992
993
994
995
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	updateWindowBackground :: !OSWindowMetrics !(Maybe ViewFrame) !(WindowStateHandle .pst) !*OSToolbox
															   -> (!WindowStateHandle .pst, !*OSToolbox)
	updateWindowBackground wMetrics maybeViewFrame wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandle=wH}} tb
		| IsEmptyRect updArea
			= (wsH,tb)
		| otherwise
			# (wH,tb)					= updatewindow wMetrics updInfo wH tb
			= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
	where
Peter Achten's avatar
Peter Achten committed
996
		whSize							= wH.whSize
Peter Achten's avatar
Peter Achten committed
997
998
		info							= getWindowInfoWindowData wH.whWindowInfo
		(origin,domainRect,hasScrolls)	= (info.windowOrigin,info.windowDomain,(isJust info.windowHScroll,isJust info.windowVScroll))
Peter Achten's avatar
Peter Achten committed
999
1000
		visScrolls						= OSscrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
		contentRect						= getWindowContentRect wMetrics visScrolls (SizeToRect whSize)
Peter Achten's avatar
Peter Achten committed
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
		updArea							= case maybeViewFrame of
											Nothing		-> contentRect
											Just rect	-> IntersectRects (RectangleToRect (subVector (toVector origin) rect)) contentRect
		updInfo							= {	updWIDS			= wshIds
										  ,	updWindowArea	= updArea
										  ,	updControls		= []
										  ,	updGContext		= Nothing
										  }
	updateWindowBackground _ _ _ _
		= StdWindowFatalError "updateWindow" "unexpected window placeholder argument"

1012
setWindowLook :: !Id !Bool !(!Bool,!Look) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
1013
setWindowLook wId redraw (sysLook,lookFun) ioState
1014
1015
1016
1017
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID wId) windows
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (wsH,ioState)			= accIOToolbox (setwindowlook wMetrics redraw (sysLook,lookFun) wsH) ioState
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setwindowlook :: !OSWindowMetrics !Bool !(!Bool,!Look) !(WindowStateHandle .pst) !*OSToolbox -> (!WindowStateHandle .pst,!*OSToolbox)
	setwindowlook wMetrics redraw (sysLook,lookFun) wsH=:{wshIds={wPtr},wshHandle=Just wlsH=:{wlsHandle=wH}} tb
		#! lookInfo				= {lookInfo & lookFun=lookFun,lookSysUpdate=sysLook}
		#! info					= {windowInfo & windowLook=lookInfo}
		#! wH					= {wH & whWindowInfo=WindowInfo info}
		| not redraw
			= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
		| otherwise
			#! (wH,tb)			= validateWindowClipState wMetrics False wPtr wH tb
			#! (wH,tb)			= drawwindowlook wMetrics wPtr id updState wH tb
			=  ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
	where
		whSize					= wH.whSize
	//	windowInfo				= fromJust wH.whWindowInfo	Mike: fromJust changed to getWindowInfoWindowData
		windowInfo				= getWindowInfoWindowData wH.whWindowInfo
		lookInfo				= windowInfo.windowLook
		domainRect				= windowInfo.windowDomain
		origin					= windowInfo.windowOrigin
		hasScrolls				= (isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
		visScrolls				= OSscrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
		contentRect				= getWindowContentRect wMetrics visScrolls (SizeToRect whSize)
		wFrame					= PosSizeToRectangle origin (RectSize contentRect)
		updState				= RectangleToUpdateState wFrame
	setwindowlook _ _ _ _ _
		= StdWindowFatalError "setWindowLook" "unexpected window placeholder argument"

1055
getWindowLook :: !Id !(IOSt .l) -> (!Maybe (Bool,Look),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
1056
getWindowLook id ioState
1057
1058
1059
1060
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows						= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
	  (found,wsH,windows)			= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	# (wKind,wsH)					= getWindowStateHandleWindowKind wsH
	| wKind<>IsWindow
		= (Nothing,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
	| otherwise
		# (windowInfo,wsH)			= getWindowStateHandleWindowInfo wsH
	//	  {lookFun,lookSysUpdate}	= (fromJust windowInfo).windowLook	Mike: fromJust changed into getWindowInfoWindowData
		  {lookFun,lookSysUpdate}	= (getWindowInfoWindowData windowInfo).windowLook
		= (Just (lookSysUpdate,lookFun),IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)


//	Operations that are concerned with the position of windows/dialogues.

1076
setWindowPos :: !Id !ItemPos !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
1077
setWindowPos id pos ioState
1078
1079
1080
1081
1082
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
1083
1084
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
1085
	# (wMode,wsH)				= getWindowStateHandleWindowMode wsH
Peter Achten's avatar
Peter Achten committed
1086
1087
	| wMode==Modal
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
1088
	# (okId,pos,windows)		= validateRelativeId id pos windows
Peter Achten's avatar
Peter Achten committed
1089
1090
1091
	| not okId
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
		# (wids, wsH)			= getWindowStateHandleWIDS wsH
		  (wSize,wsH)			= getWindowStateHandleSize wsH
		  (wKind,wsH)			= getWindowStateHandleWindowKind wsH
		  windows				= setWindowHandlesWindow wsH windows
		# (osdInfo, ioState)	= IOStGetOSDInfo ioState
		  isSDI					= getOSDInfoDocumentInterface osdInfo==SDI
		  (framePtr,clientPtr)	= case (getOSDInfoOSInfo osdInfo) of
		  							Just info -> (info.osFrame,info.osClient)
		  							_         -> (OSNoWindowPtr,OSNoWindowPtr)
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (tb,ioState)			= getIOToolbox ioState
		# (pos,windows,tb)		= exactWindowPos wMetrics wSize (Just pos) wKind Modeless windows tb
		# tb					= OSsetWindowPos (if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr) (toTuple pos) True True tb
		# ioState				= setIOToolbox tb ioState
Peter Achten's avatar
Peter Achten committed
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
		= IOStSetDevice (WindowSystemState windows) ioState
where
	// validateRelativeId checks the validity of the ItemPos. 
	// It assumes that the WindowHandles argument is not empty (containing atleast the target window).
	validateRelativeId :: !Id !ItemPos !(WindowHandles .pst) -> (!Bool,!ItemPos,!WindowHandles .pst)
	validateRelativeId id itemPos=:(itemLoc,itemOffset) windows
		| isRelative
			# (exists,windows)	= hasWindowHandlesWindow (toWID relativeId) windows
			= (exists,itemPos,windows)
		| isRelativePrev
			# wsHs				= windows.whsWindows
			  (widsstack,wsHs)	= unzip (map getWindowStateHandleWIDS wsHs)
			  windows			= {windows & whsWindows=wsHs}
			  (found,prevId)	= findPrevId (toWID id) widsstack
			  itemLoc			= if (not found) itemLoc
			  					 (case itemLoc of
									LeftOfPrev  -> LeftOf  prevId
									RightToPrev -> RightTo prevId
									AbovePrev   -> Above   prevId
									BelowPrev   -> Below   prevId
								 )
			= (found,(itemLoc,itemOffset),windows)
			with
				findPrevId :: !WID ![WIDS] -> (!Bool,Id)
				findPrevId wid [_]
					= (False,undef)
				findPrevId wid [wid`:wids=:[wid``:_]]
					| identifyWIDS wid wid``	= (True,wid`.wId)
					| otherwise					= findPrevId wid [wid``:wids]
		| otherwise
			= (True,itemPos,windows)
	where
		(isRelative,relativeId)	= case itemLoc of
									LeftOf  id  -> (True,id)
									RightTo id  -> (True,id)
									Above   id  -> (True,id)
									Below   id  -> (True,id)
									_           -> (False,undef)
		isRelativePrev			= case itemLoc of
									LeftOfPrev  -> True
									RightToPrev -> True
									AbovePrev   -> True
									BelowPrev   -> True
									_           -> False

1151
getWindowPos :: !Id !(IOSt .l) -> (!Maybe Vector2,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
1152
getWindowPos id ioState
1153
1154
1155
1156
1157
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
1158
1159
1160
	| not found
		= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
	| otherwise
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
		# (osdInfo,ioState)		= IOStGetOSDInfo ioState
		  di					= getOSDInfoDocumentInterface osdInfo
		  isSDI					= di==SDI
		  isMDI					= di==MDI
		  (framePtr,clientPtr,getParentPos)
		  						= case (getOSDInfoOSInfo osdInfo) of
		  							Just info -> (info.osFrame,info.osClient,if isMDI (OSgetWindowPos info.osClient) (return (0,0)))
							  		nothing   -> (OSNoWindowPtr, OSNoWindowPtr,return (0,0))
		# (wids,wsH)			= getWindowStateHandleWIDS wsH
		# (tb,ioState)			= getIOToolbox ioState
		# ((wx,wy),tb)			= OSgetWindowPos (if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr) tb
		# ((fx,fy),tb)			= getParentPos tb
		# ioState				= setIOToolbox tb ioState
		# ioState				= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
Peter Achten's avatar
Peter Achten committed
1175
1176
1177
1178
1179
		= (Just {vx=wx-fx,vy=wy-fy},ioState)


//	Operations that are concerned with the ViewFrame of a window.

1180
moveWindowViewFrame :: !Id Vector2 !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
1181
moveWindowViewFrame id v ioState
1182
1183
1184
1185
1186
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
1187
1188
	| not found
		= IOStSetDevice (WindowSystemState windows) ioState
1189
	# (wKind,wsH)				= getWindowStateHandleWindowKind wsH
Peter Achten's avatar
Peter Achten committed
1190
1191
1192
	| wKind<>IsWindow
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
	| otherwise
1193
1194
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (wsH,ioState)			= accIOToolbox (movewindowviewframe` wMetrics v wsH) ioState
Peter Achten's avatar
Peter Achten committed
1195
1196
1197
1198
1199
1200
1201
1202
1203
		= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	movewindowviewframe` :: !OSWindowMetrics !Vector2 !(WindowStateHandle .pst) !*OSToolbox -> (!WindowStateHandle .pst,!*OSToolbox)
	movewindowviewframe` wMetrics v wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandle=wH}} tb
		# (wH,tb)			= movewindowviewframe wMetrics v wshIds wH tb
		= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
	movewindowviewframe` _ _ _ _
		= StdWindowFatalError "moveWindowViewFrame" "unexpected window placeholder argument"

1204
getWindowViewFrame :: !Id !(IOSt .l) -> (!ViewFrame,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
1205
getWindowViewFrame id ioState
1206
1207
1208
1209
1210
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (zero,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
Peter Achten's avatar
Peter Achten committed
1211
1212
1213
	| not found
		= (zero,IOStSetDevice (WindowSystemState windows) ioState)
	| otherwise
1214
1215
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (viewFrame,wsH)		= getwindowviewframe wMetrics wsH
Peter Achten's avatar
Peter Achten committed
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
		= (viewFrame,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)

//	getwindowviewframe is also used by getWindowOuterSize.
getwindowviewframe :: !OSWindowMetrics !(WindowStateHandle .pst) -> (!ViewFrame,!WindowStateHandle .pst)
getwindowviewframe wMetrics wsH=:{wshIds={wPtr},wshHandle=Just wlsH=:{wlsHandle=wH}}
	| wKind==IsWindow
		= (RectToRectangle contentRect,wsH)
	| otherwise
		= (SizeToRectangle wSize,wsH)
where
	wSize		= wH.whSize
	wKind		= wH.whKind
	(origin,domainRect,hasHScroll,hasVScroll)
				= case wH.whWindowInfo of
					WindowInfo info	-> (info.windowOrigin,info.windowDomain,isJust info.windowHScroll,isJust info.windowVScroll)
					other			-> StdWindowFatalError "getWindowViewFrame" "Window has no WindowInfo"
	visScrolls	= OSscrollbarsAreVisible wMetrics domainRect (toTuple wSize)