StdControl.icl 26.7 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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
implementation module StdControl


//	Clean Object I/O library, version 1.2

//	Operations to change controls using their Ids only.


import	StdBool, StdList, StdMisc, StdTuple
import	commondef, controlaccess, controlinternal, id, iostate, windowaccess, wstate
from	windowclipstate	import invalidateWindowClipState`
from	wstateaccess	import iswindowitemspace`, getwindowitemspace`,
								iswindowhmargin`,  getwindowhmargin`,
								iswindowvmargin`,  getwindowvmargin`
from	ostoolbox	import OSNewToolbox


/*	The function isOkControlId can be used to filter out the proper IdParent records.
*/
isOkControlId :: !SystemId !(.x,!Maybe IdParent) -> (!Bool,(.x,Id))
isOkControlId ioId (x,Just {idpIOId,idpDevice,idpId})
	= (ioId==idpIOId && idpDevice==WindowDevice,(x,idpId))
isOkControlId _ _
	= (False,undef)

/*	gatherWindowIds collects all first Ids (ControlId) that belong to the same second Id (WindowId).
	gatherWindowIds` does the same, except that not only ControlIds are collected, but also their data item.
*/
gatherWindowIds :: ![(Id,Id)] -> [([Id],Id)]
gatherWindowIds [(cId,wId):ids]
	= [([cId:cIds],wId):cIds_wIds]
where
	(cIds,ids`)	= gatherControlsIds wId ids
	cIds_wIds	= gatherWindowIds ids`
	
	gatherControlsIds :: !Id ![(Id,Id)] -> ([Id],[(Id,Id)])
	gatherControlsIds wId [(cId,wId`):ids]
		| wId==wId`	= ([cId:cIds],ids`)
		| otherwise	= (cIds,[(cId,wId`):ids`])
	where
		(cIds,ids`)	= gatherControlsIds wId ids
	gatherControlsIds _ _
		= ([],[])
gatherWindowIds []
	= []

gatherWindowIds` :: ![((Id,.x),Id)] -> [([(Id,.x)],Id)]
gatherWindowIds` [((cId,x),wId):ids]
	= [([(cId,x):cIds],wId):cIds_wIds]
where
	(cIds,ids`)	= gatherControlsIds wId ids
	cIds_wIds	= gatherWindowIds` ids`
	
	gatherControlsIds :: !Id ![((Id,.x),Id)] -> ([(Id,.x)],[((Id,.x),Id)])
	gatherControlsIds wId [((cId,x),wId`):ids]
		| wId==wId`	= ([(cId,x):cIds],ids`)
		| otherwise	= (cIds,[((cId,x),wId`):ids`])
	where
		(cIds,ids`)	= gatherControlsIds wId ids
	gatherControlsIds _ _
		= ([],[])
gatherWindowIds` []
	= []


//	The WState window representation record:

::	WState
	=	{	wIds	:: !WIDS
		,	wRep	:: !WindowHandle`
		,	wTb		:: !.OSToolbox
		,	wMetrics:: !OSWindowMetrics
		}


76
getWindow :: !Id !(IOSt .l) -> (!Maybe WState, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
77
getWindow windowId ioState
78
79
80
81
82
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID windowId) windows
Peter Achten's avatar
Peter Achten committed
83
84
85
	| not found
		= (Nothing,ioState)
	| otherwise
86
87
88
89
90
91
92
		# (tb,ioState)			= getIOToolbox ioState
		# (wsH`,wsH,tb)			= retrieveWindowHandle` wsH tb
		# (wids,wsH)			= getWindowStateHandleWIDS wsH
		  windows				= setWindowHandlesWindow wsH windows
		# ioState				= setIOToolbox tb ioState
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
Peter Achten's avatar
Peter Achten committed
93
94
		= (Just {wIds=wids,wRep=wsH`,wTb=OSNewToolbox,wMetrics=wMetrics},ioState)

95
getParentWindow :: !Id !(IOSt .l) -> (!Maybe WState, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
96
97
98
99
100
101
102
103
104
105
106
107
getParentWindow controlId ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	  maybeParent		= getIdParent controlId idtable
	| isNothing maybeParent
		= (Nothing,ioState)
	# parent			= fromJust maybeParent
	# (ioId,ioState)	= IOStGetIOId ioState
	| ioId==parent.idpIOId && parent.idpDevice==WindowDevice
		= getWindow parent.idpId ioState
	| otherwise
		= (Nothing,ioState)

108
setWindow :: !Id !(IdFun *WState) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
109
setWindow windowId f ioState
110
111
112
113
114
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= WindowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID windowId) windows
Peter Achten's avatar
Peter Achten committed
115
116
117
	| not found
		= ioState
	| otherwise
118
119
120
121
122
123
124
125
126
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (tb,ioState)			= getIOToolbox ioState
		# (wsH`,wsH,tb)			= retrieveWindowHandle` wsH tb
		# (wids,wsH)			= getWindowStateHandleWIDS wsH
		# {wRep=wsH`,wTb=tb}	= f {wIds=wids,wRep=wsH`,wTb=tb,wMetrics=wMetrics}
		  wsH					= insertWindowHandle` wsH` wsH
		  windows				= setWindowHandlesWindow wsH windows
		# ioState				= setIOToolbox tb ioState
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
Peter Achten's avatar
Peter Achten committed
127
128
129
130
131
		= ioState


//	Show/Hide controls.

132
showControls :: ![Id] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
133
134
135
136
137
138
139
140
showControls ids ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  cIds_wIds			= FilterMap (isOkControlId ioId) (zip2 ids (getIdParents ids idtable))
	  cIds_wIds			= gatherWindowIds cIds_wIds
	| isEmpty cIds_wIds	= ioState
	| otherwise			= StrictSeq [setWindow wId (setControlsShowState` True cIds) \\ (cIds,wId)<-cIds_wIds] ioState

141
showControl :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
142
143
showControl id ioState = showControls [id] ioState

144
hideControls :: ![Id] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
145
146
147
148
149
150
151
152
hideControls ids ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  cIds_wIds			= FilterMap (isOkControlId ioId) (zip2 ids (getIdParents ids idtable))
	  cIds_wIds			= gatherWindowIds cIds_wIds
	| isEmpty cIds_wIds	= ioState
	| otherwise			= StrictSeq [setWindow wId (setControlsShowState` False cIds) \\ (cIds,wId)<-cIds_wIds] ioState

153
hideControl :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
154
155
156
hideControl id ioState = hideControls [id] ioState

setControlsShowState` :: !Bool ![Id] !*WState -> *WState
157
158
setControlsShowState` show ids wState=:{wIds,wRep,wTb,wMetrics}
	# (wH,tb)	= setcontrolsshowstate ids show wMetrics wIds wRep wTb
Peter Achten's avatar
Peter Achten committed
159
160
161
162
163
164
	  wH		= invalidateWindowClipState` wH
	= {wState & wRep=wH,wTb=tb}


/*	Enabling/Disabling of controls.
*/
165
enableControls :: ![Id] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
166
167
168
169
170
171
172
173
174
175
176
177
178
enableControls ids ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  cIds_wIds			= FilterMap (isOkControlId ioId) (zip2 ids (getIdParents ids idtable))
	  cIds_wIds			= gatherWindowIds cIds_wIds
	| isEmpty cIds_wIds	= ioState
	| otherwise			= StrictSeq [setWindow wId (enableControls` cIds) \\ (cIds,wId)<-cIds_wIds] ioState
where
	enableControls` :: ![Id] !*WState -> *WState
	enableControls` ids wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)		= enablecontrols ids False wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}

179
enableControl :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
180
181
enableControl id ioState = enableControls [id] ioState

182
disableControls :: ![Id] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
183
184
185
186
187
188
189
190
191
192
193
194
195
disableControls ids ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  cIds_wIds			= FilterMap (isOkControlId ioId) (zip2 ids (getIdParents ids idtable))
	  cIds_wIds			= gatherWindowIds cIds_wIds
	| isEmpty cIds_wIds	= ioState
	| otherwise			= StrictSeq [setWindow wId (disableControls` cIds) \\ (cIds,wId)<-cIds_wIds] ioState
where
	disableControls` :: ![Id] !*WState -> *WState
	disableControls` ids wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)		= disablecontrols ids False wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}

196
disableControl :: !Id !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
197
198
199
200
201
disableControl id ioState = disableControls [id] ioState


//	Marking/Unmarking of check controls.

202
markCheckControlItems :: !Id ![Index] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
203
204
205
markCheckControlItems cId indexs ioState
	= setControlsMarkState Mark cId indexs ioState

206
unmarkCheckControlItems :: !Id ![Index] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
207
208
209
unmarkCheckControlItems cId indexs ioState
	= setControlsMarkState NoMark cId indexs ioState

210
setControlsMarkState :: !MarkState !Id ![Index] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
setControlsMarkState mark cId indexs ioState
	| isEmpty indexs	= ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (setControlsMarkState` mark cId indexs) ioState
where
	setControlsMarkState` :: !MarkState !Id ![Index] !*WState -> *WState
	setControlsMarkState` mark id indexs wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)		= setcontrolsmarkstate id mark indexs wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}


//	Selecting/Unselecting a radio control.

228
selectRadioControlItem :: !Id !Index !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
selectRadioControlItem cId index ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (selectRadioControlItem` cId index) ioState
where
	selectRadioControlItem` :: !Id !Index !*WState -> *WState
	selectRadioControlItem` id index wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)	= selectradiocontrol id index wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}


//	Select a pop up menu item.

245
selectPopUpControlItem :: !Id !Index !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
selectPopUpControlItem cId index ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (selectPopUpControlItem` cId index) ioState
where
	selectPopUpControlItem` :: !Id !Index !*WState -> *WState
	selectPopUpControlItem` id index wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)		= selectpopupitem id index wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}


//	Move the orientation of a CompoundControl.

262
moveControlViewFrame :: !Id Vector2 !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
moveControlViewFrame cId v ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (moveControlViewFrame` cId v) ioState
where
	moveControlViewFrame` :: !Id Vector2 !*WState -> *WState
	moveControlViewFrame` id v wState=:{wIds,wRep,wTb,wMetrics}
		# (wH,tb)	= movecontrolviewframe id v wMetrics wIds wRep wTb
		  wH		= invalidateWindowClipState` wH
		= {wState & wRep=wH,wTb=tb}


//	Set a new view domain of a CompoundControl.

280
setControlViewDomain :: !Id ViewDomain !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
setControlViewDomain cId newDomain ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (setControlViewDomain` cId newDomain) ioState
where
	setControlViewDomain` :: !Id !ViewDomain !*WState -> *WState
	setControlViewDomain` id newDomain wState=:{wIds,wRep,wTb,wMetrics}
		# (wH,tb)	= setcontrolviewdomain id newDomain wMetrics wIds wRep wTb
		= {wState & wRep=wH,wTb=tb}


//	Set the ScrollFunction of a CompoundControl.

297
setControlScrollFunction :: !Id Direction ScrollFunction !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
setControlScrollFunction cId direction scrollFun ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
		= ioState
	| otherwise
		= setWindow (fromJust maybeParent).idpId (setControlScrollFunction` cId direction scrollFun) ioState
where
	setControlScrollFunction` :: !Id !Direction ScrollFunction !*WState -> *WState
	setControlScrollFunction` id direction scrollFun wState=:{wRep}
		# wH			= setcontrolscrollfun id direction scrollFun wRep
		= {wState & wRep=wH}


//	Change the text of (Text/Edit/Button)Control.

315
setControlTexts :: ![(Id,String)] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
316
317
318
319
320
321
322
323
324
325
326
327
328
329
setControlTexts cid_texts ioState
	# (idtable,ioState)			= IOStGetIdTable ioState
	# (ioId,ioState)			= IOStGetIOId ioState
	  (cids,_)					= unzip cid_texts
	  cid_texts_wIds			= FilterMap (isOkControlId ioId) (zip2 cid_texts (getIdParents cids idtable))
	  cid_texts_wIds			= gatherWindowIds` cid_texts_wIds
	| isEmpty cid_texts_wIds	= ioState
	| otherwise					= StrictSeq [setWindow wId (setControlTexts` cid_texts) \\ (cid_texts,wId)<-cid_texts_wIds] ioState
where
	setControlTexts` :: ![(Id,String)] !*WState -> *WState
	setControlTexts` texts wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)	= setcontroltexts texts wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}

330
setControlText :: !Id !String !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
331
332
333
334
335
setControlText id text ioState = setControlTexts [(id,text)] ioState


//	Set the cursor position of an EditControl.

336
setEditControlCursor :: !Id !Int !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
setEditControlCursor cId pos ioState
	# (idtable,ioState)	= IOStGetIdTable ioState
	# (ioId,ioState)	= IOStGetIOId ioState
	  maybeParent		= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
						= ioState
	| otherwise			= setWindow (fromJust maybeParent).idpId (setEditControlCursor` cId pos) ioState
where
	setEditControlCursor` :: !Id !Int !*WState -> *WState
	setEditControlCursor` id pos wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)	= seteditcontrolcursor id pos wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}


/*	Change the Look of the corresponding (Custom(Button)/Compound)Controls and redraw
	only if the first Boolean is True.
*/
354
setControlLooks :: ![(Id,Bool,(Bool,Look))] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
setControlLooks cid_looks ioState
	# (idtable,ioState)			= IOStGetIdTable ioState
	# (ioId,ioState)			= IOStGetIOId ioState
	  cid_looks					= [(cid,(redraw,look)) \\ (cid,redraw,look)<-cid_looks]
	  (cids,_)					= unzip cid_looks
	  cid_looks_wIds			= FilterMap (isOkControlId ioId) (zip2 cid_looks (getIdParents cids idtable))
	  cid_looks_wIds			= gatherWindowIds` cid_looks_wIds
	| isEmpty cid_looks_wIds	= ioState
	| otherwise					= StrictSeq [	setWindow wId (setControlLooks` [(cid,redraw,look) \\ (cid,(redraw,look))<-cid_looks])
											\\	(cid_looks,wId)<-cid_looks_wIds
											]	ioState
where
	setControlLooks` :: ![(Id,Bool,(Bool,Look))] !*WState -> *WState
	setControlLooks` looks wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)	= setcontrolslook looks wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}

372
setControlLook :: !Id !Bool (Bool,Look) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
373
374
375
376
377
setControlLook id redraw newlook ioState = setControlLooks [(id,redraw,newlook)] ioState


//	Change the SliderState and redraw the settings of the SliderControls.

378
setSliderStates :: ![(Id,IdFun SliderState)] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
379
380
381
382
383
384
385
386
387
388
389
390
391
392
setSliderStates cid_fs ioState
	# (idtable,ioState)		= IOStGetIdTable ioState
	# (ioId,ioState)		= IOStGetIOId ioState
	  (cids,_)				= unzip cid_fs
	  cid_funs_wIds			= FilterMap (isOkControlId ioId) (zip2 cid_fs (getIdParents cids idtable))
	  cid_funs_wIds			= gatherWindowIds` cid_funs_wIds
	| isEmpty cid_funs_wIds	= ioState
	| otherwise				= StrictSeq [setWindow wId (setSliderStates` cid_funs) \\ (cid_funs,wId)<-cid_funs_wIds] ioState
where
	setSliderStates` :: ![(Id,IdFun SliderState)] !*WState -> *WState
	setSliderStates` id_fs wState=:{wIds={wPtr},wRep,wTb,wMetrics}
		# (wH,tb)	= setsliderstates id_fs wMetrics wPtr wRep wTb
		= {wState & wRep=wH,wTb=tb}

393
setSliderState :: !Id (IdFun SliderState) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
394
395
396
397
398
setSliderState id fun ioState = setSliderStates [(id,fun)] ioState


//	Change the thumb value of the SliderState of a SliderControl. 

399
setSliderThumbs :: ![(Id,Int)] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
400
401
402
setSliderThumbs cid_thumbs ioState
	= setSliderStates (map (\(cid,thumb)->(cid,\state->{state & sliderThumb=thumb})) cid_thumbs) ioState

403
setSliderThumb :: !Id Int !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
404
405
406
407
408
setSliderThumb id thumb ioState = setSliderThumbs [(id,thumb)] ioState


//	Draw in a (Custom(Button)/Compound)Control.

409
appControlPicture :: !Id !.(IdFun *Picture) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
410
411
412
appControlPicture cId drawfun ioState
	= snd (accControlPicture cId (\p->(undef,drawfun p)) ioState)

413
accControlPicture :: !Id !.(St *Picture .x) !(IOSt .l) -> (!Maybe .x,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
414
415
416
417
418
419
accControlPicture cId drawfun ioState
	# (idtable,ioState)			= IOStGetIdTable ioState
	# (ioId,ioState)			= IOStGetIOId ioState
	  maybeParent				= getIdParent cId idtable
	| not (fst (isOkControlId ioId (cId,maybeParent)))
		= (Nothing,ioState)
420
421
422
	# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
Peter Achten's avatar
Peter Achten committed
423
	| otherwise
424
		# windows				= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
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
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
494
495
496
497
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
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
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
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
		  wId					= (fromJust maybeParent).idpId
		  (_,wsH,windows)		= getWindowHandlesWindow (toWID wId) windows
		# (wMetrics,ioState)	= IOStGetOSWindowMetrics ioState
		# (tb,ioState)			= getIOToolbox ioState
		# (wsH`,wsH,tb)			= retrieveWindowHandle` wsH tb
		# (wids,wsH)			= getWindowStateHandleWIDS wsH
		# (maybe_result,wsH`,tb)= drawincontrol cId drawfun wMetrics wids.wPtr wsH` tb
		  wsH					= insertWindowHandle` wsH` wsH
		  windows				= setWindowHandlesWindow wsH windows
		# ioState				= setIOToolbox tb ioState
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
		= (maybe_result,ioState)


//	Access operations on WState:

getWStateControls :: !WState -> [WElementHandle`]
getWStateControls {wRep={whItems`}}
	= whItems`

getControlTypes :: !WState -> [(ControlType,Maybe Id)]
getControlTypes wstate
	= getcontrolstypes (getWStateControls wstate)

getCompoundTypes :: !Id !WState -> [(ControlType,Maybe Id)]
getCompoundTypes id wstate
	= getcompoundstypes id (getWStateControls wstate)


// snd3thd3	:: !(.a,.b,.c) -> (.b,.c)								// (t2,t3) of (t1,t2,t3)
snd3thd3 tuple :== (t2,t3) where (_,t2,t3) = tuple

getControlLayouts :: ![Id] !WState -> [(Bool,(Maybe ItemPos,Vector2))]
getControlLayouts ids wstate
	= map snd3thd3 (snd (getcontrolslayouts (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= (Nothing,zero)

getControlLayout :: !Id !WState -> (Bool,(Maybe ItemPos,Vector2))
getControlLayout id wstate = hd (getControlLayouts [id] wstate)

getControlViewSizes :: ![Id] !WState -> [(Bool,Size)]
getControlViewSizes ids wstate=:{wMetrics}
	= map snd3thd3 (snd (getcontrolsviewsizes wMetrics (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= zero

getControlViewSize :: !Id !WState -> (Bool,Size)
getControlViewSize id wstate = hd (getControlViewSizes [id] wstate)

getControlOuterSizes :: ![Id] !WState -> [(Bool,Size)]
getControlOuterSizes ids wstate=:{wMetrics}
	= map snd3thd3 (snd (getcontrolsoutersizes wMetrics (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= zero

getControlOuterSize :: !Id !WState -> (Bool,Size)
getControlOuterSize id wstate = hd (getControlOuterSizes [id] wstate)

getControlSelectStates :: ![Id] !WState -> [(Bool,SelectState)]
getControlSelectStates ids wstate
	= map snd3thd3 (snd (getcontrolsselects (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Able

getControlSelectState :: !Id !WState -> (Bool,SelectState)
getControlSelectState id wstate = hd (getControlSelectStates [id] wstate)

getControlShowStates :: ![Id] !WState -> [(Bool,Bool)]
getControlShowStates ids wstate
	= map snd3thd3 (snd (getcontrolsshowstates (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= False

getControlShowState :: !Id !WState -> (Bool,Bool)
getControlShowState id wstate = hd (getControlShowStates [id] wstate)

getControlTexts :: ![Id] !WState -> [(Bool,Maybe String)]
getControlTexts ids wstate
	= map snd3thd3 (snd (getcontrolstexts (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlText :: !Id !WState -> (Bool,Maybe String)
getControlText id wstate = hd (getControlTexts [id] wstate)

getControlNrLines :: ![Id] !WState -> [(Bool,Maybe NrLines)]
getControlNrLines ids wstate
	= map snd3thd3 (snd (getcontrolsnrlines (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlNrLine :: !Id !WState -> (Bool,Maybe NrLines)
getControlNrLine id wstate = hd (getControlNrLines [id] wstate)

getControlLooks :: ![Id] !WState -> [(Bool,Maybe (Bool,Look))]
getControlLooks ids wstate
	= map snd3thd3 (snd (getcontrolslooks (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlLook :: !Id !WState -> (Bool,Maybe (Bool,Look))
getControlLook id wstate = hd (getControlLooks [id] wstate)

getControlMinimumSizes :: ![Id] !WState -> [(Bool,Maybe Size)]
getControlMinimumSizes ids wstate
	= map snd3thd3 (snd (getcontrolsminsizes (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlMinimumSize :: !Id !WState -> (Bool,Maybe Size)
getControlMinimumSize id wstate = hd (getControlMinimumSizes [id] wstate)

getControlResizes :: ![Id] !WState -> [(Bool,Maybe ControlResizeFunction)]
getControlResizes ids wstate
	= map snd3thd3 (snd (getcontrolsresizes (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlResize :: !Id !WState -> (Bool,Maybe ControlResizeFunction)
getControlResize id wstate = hd (getControlResizes [id] wstate)

getRadioControlItems :: ![Id] !WState -> [(Bool,Maybe [String])]
getRadioControlItems ids wstate
	= map snd3thd3 (snd (getradioitems (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getRadioControlItem :: !Id !WState -> (Bool,Maybe [String])
getRadioControlItem id wstate = hd (getRadioControlItems [id] wstate)

getRadioControlSelections :: ![Id] !WState -> [(Bool,Maybe Index)]
getRadioControlSelections ids wstate
	= map snd3thd3 (snd (getradiocontrolsmarks (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getRadioControlSelection :: !Id !WState -> (Bool,Maybe Index)
getRadioControlSelection id wstate = hd (getRadioControlSelections [id] wstate)

getCheckControlItems :: ![Id] !WState -> [(Bool,Maybe [String])]
getCheckControlItems ids wstate
	= map snd3thd3 (snd (getcheckitems (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getCheckControlItem :: !Id !WState -> (Bool,Maybe [String])
getCheckControlItem id wstate = hd (getCheckControlItems [id] wstate)

getCheckControlSelections :: ![Id] !WState -> [(Bool,Maybe [Index])]
getCheckControlSelections ids wstate
	= map snd3thd3 (snd (getcheckcontrolsmarks (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getCheckControlSelection :: !Id !WState -> (Bool,Maybe [Index])
getCheckControlSelection id wstate = hd (getCheckControlSelections [id] wstate)

getPopUpControlItems :: ![Id] !WState -> [(Bool,Maybe [String])]
getPopUpControlItems ids wstate
	= map snd3thd3 (snd (getpopupitems (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getPopUpControlItem :: !Id !WState -> (Bool,Maybe [String])
getPopUpControlItem id wstate = hd (getPopUpControlItems [id] wstate)

getPopUpControlSelections :: ![Id] !WState -> [(Bool,Maybe Index)]
getPopUpControlSelections ids wstate
	= map snd3thd3 (snd (getselectedpopupitems (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getPopUpControlSelection :: !Id !WState -> (Bool,Maybe Index)
getPopUpControlSelection id wstate = hd (getPopUpControlSelections [id] wstate)

getSliderDirections :: ![Id] !WState -> [(Bool,Maybe Direction)]
getSliderDirections ids wstate
	= map snd3thd3 (snd (getslidersdirections (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getSliderDirection :: !Id !WState -> (Bool,Maybe Direction)
getSliderDirection id wstate = hd (getSliderDirections [id] wstate)

getSliderStates :: ![Id] !WState -> [(Bool,Maybe SliderState)]
getSliderStates ids wstate
	= map snd3thd3 (snd (getslidersstates (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getSliderState :: !Id !WState -> (Bool,Maybe SliderState)
getSliderState id wstate = hd (getSliderStates [id] wstate)

getControlViewFrames :: ![Id] !WState -> [(Bool,Maybe ViewFrame)]
getControlViewFrames ids wstate=:{wMetrics}
	= map snd3thd3 (snd (getcontrolsframes wMetrics (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlViewFrame :: !Id !WState -> (Bool,Maybe ViewFrame)
getControlViewFrame id wstate = hd (getControlViewFrames [id] wstate)

getControlViewDomains :: ![Id] !WState -> [(Bool,Maybe ViewDomain)]
getControlViewDomains ids wstate
	= map snd3thd3 (snd (getcontrolsdomains (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlViewDomain :: !Id !WState -> (Bool,Maybe ViewDomain)
getControlViewDomain id wstate = hd (getControlViewDomains [id] wstate)

getControlScrollFunctions :: ![Id] !WState -> [(Bool,Maybe ((Direction,Maybe ScrollFunction),(Direction,Maybe ScrollFunction)))]
getControlScrollFunctions ids wstate
	= map snd3thd3 (snd (getscrollfunctions (getWStateControls wstate) (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing

getControlScrollFunction :: !Id !WState -> (Bool,Maybe ((Direction,Maybe ScrollFunction),(Direction,Maybe ScrollFunction)))
getControlScrollFunction id wstate = hd (getControlScrollFunctions [id] wstate)

getControlItemSpaces :: ![Id] !WState -> [(Bool,Maybe (Int,Int))]
getControlItemSpaces ids {wRep={whItems`,whAtts`},wMetrics={osmHorItemSpace,osmVerItemSpace}}
	= map snd3thd3 (snd (getcontrolsspaces spaces whItems` (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing
	spaces		= getwindowitemspace` (snd (Select iswindowitemspace` (WindowItemSpace` osmHorItemSpace osmVerItemSpace) whAtts`))

getControlItemSpace :: !Id !WState -> (Bool,Maybe (Int,Int))
getControlItemSpace id wstate = hd (getControlItemSpaces [id] wstate)

getControlMargins :: ![Id] !WState -> [(Bool,Maybe ((Int,Int),(Int,Int)))]
getControlMargins ids {wRep={whKind`,whItems`,whAtts`},wMetrics={osmHorMargin,osmVerMargin}}
	= map snd3thd3 (snd (getcontrolsmargins (hMargins,vMargins) whItems` (ids,map (\id->(id,defaultBool,defaultValue)) ids)))
where
	defaultBool	= False
	defaultValue= Nothing
	(hMargin,vMargin)
				= if (whKind`==IsDialog) (osmHorMargin,osmVerMargin) (0,0)
	hMargins	= getwindowhmargin` (snd (Select iswindowhmargin` (WindowHMargin` hMargin hMargin) whAtts`))
	vMargins	= getwindowvmargin` (snd (Select iswindowvmargin` (WindowVMargin` vMargin vMargin) whAtts`))

getControlMargin :: !Id !WState -> (Bool,Maybe ((Int,Int),(Int,Int)))
getControlMargin id wstate = hd (getControlMargins [id] wstate)