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


//	Clean Object I/O library, version 1.2


7
import	StdBool, StdFunc, StdList, StdMisc
Peter Achten's avatar
Peter Achten committed
8
9
10
import	commondef, devicefunctions, devicesystemstate, processstack, receivertable, timertable
import	osdocumentinterface
from	osactivaterequests	import OSActivateRequest
11
from	osevent				import OSEvents, OSnewEvents
Peter Achten's avatar
Peter Achten committed
12
13
14
15
16
17
18
19
from	osguishare			import OSGUIShare
from	osmouse				import OSGetDoubleClickTime
from	ostime				import OSTime
from	ostoolbox			import OSNewToolbox, OSDummyToolbox
from	oswindow			import OSWindowPtr, OSNoWindowPtr, OSWindowMetrics, OSDefaultWindowMetrics
from	roundrobin			import RR, emptyRR, notodoRR


20
::	*PSt l
Peter Achten's avatar
Peter Achten committed
21
	=	{	ls				:: !l								// The local (and private) data of the process
22
		,	io				:: !*IOSt l							// The IOSt environment of the process
Peter Achten's avatar
Peter Achten committed
23
24
		}

25
26
27
::	*CProcesses													// The 'context-free' processes administration
	:==	RR *CProcess											//	is a round-robin
::	*CProcess													// The context-free process
Peter Achten's avatar
Peter Achten committed
28
	=	E. .l:
29
30
		{	localState	:: !Maybe l								//	its local state
		,	localIOSt	:: !*IOSt l								//	its context-free IOSt
Peter Achten's avatar
Peter Achten committed
31
		}
32
33
34
::	*IOSt l
	=	{	iounique		:: !*IOUnique l
		,	ioshare			:: !IOShare   l
Peter Achten's avatar
Peter Achten committed
35
		}
36
::	*IOUnique l
Peter Achten's avatar
Peter Achten committed
37
38
	=	{	ioevents		:: !*OSEvents						// The event stream environment
		,	ioworld			:: ![*World]						// The world environment
39
		,	ioprocesses		:: *CProcesses						// All other processes
40
		,	ioinit			:: !IdFun (PSt l)					// The initialisation functions of the process
Peter Achten's avatar
Peter Achten committed
41
42
		,	iotoolbox		:: !*OSToolbox						// The Mac continuation value
		}
43
::	IOShare	l
Peter Achten's avatar
Peter Achten committed
44
45
46
47
48
49
	=	{	ioid			:: !SystemId						// The Id of the process
		,	ionr			:: !SystemId						// The max SystemId of all processes
		,	ioparent		:: !Maybe SystemId					// If the process is a subprocess, then Just parentId, otherwise Nothing
		,	ioguishare		:: !Maybe GUIShare					// If the process shares GUI components, then Just _, otherwise Nothing
		,	iosubids		:: ![SystemId]						// The ids of the subprocesses of the process
		,	ioidseed		:: !Int								// The global id generating number (actually the World)
50
51
52
		,	iodevicefuncs	:: ![DeviceFunctions  (PSt l)]		// The currently active device functions
		,	iodevices		:: [DeviceSystemState (PSt l)]		// The GUI device states of the process
		,	ioatts			:: ![ProcessAttribute (PSt l)]		// The attributes of the process
Peter Achten's avatar
Peter Achten committed
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
		,	ioruntime		:: !RuntimeState					// The runtime state of the process
		,	ioosdinfo		:: !OSDInfo							// The OS document interface information of the process
		,	iokind			:: !ProcessKind						// The kind of the process (interactive or virtual)
		,	ioismodal		:: !Maybe SystemId					// If a process has some modal windows, then Just id, otherwise Nothing
		,	ioidtable		:: !IdTable							// The table of all bound Ids
		,	ioreceivertable	:: !ReceiverTable					// The table of the current whereabouts of receivers
		,	iotimertable	:: !TimerTable						// The table of all currently active timers
		,	ioostime		:: !OSTime							// The current OSTime
		,	ioactrequest	:: !ActivateRequests				// The issued activation requests
		,	iostack			:: !ProcessStack					// The stacking order of all processes
		,	iobutton		:: !ButtonFreqState					// The state of double MouseDowns
//PA---	,	iokeytrack		:: !Maybe KeyTrack					// If the process is handling Key(Repeat/Up), then Just _, otherwise Nothing
		,	ioinputtrack	:: !Maybe InputTrack				// The process is handling mouse/key input flags
		,	ioclipboard		:: !ClipboardState					// The state of the clipboard
		,	iooswmetrics	:: !OSWindowMetrics					// The window metrics
68
		,	iorcvdisabled	:: !Bool							// to check, whether a receiver was disabled (explicitly or via close) (MW11++)
Peter Achten's avatar
Peter Achten committed
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
		}
::	GUIShare
	:==	OSGUIShare
::	RuntimeState
	=	Running													// The process is running
	|	Blocked !SystemId										// The process is blocked for the process with given id
	|	Closed													// The process is closed

::	ActivateRequests	:== [OSActivateRequest]
::	ButtonFreqState
	=	{	bfstime		:: !Int									// Last time of a MouseDown
		,	bfsfreq		:: !ButtonFreq							// Nr of DoubleMouseDowns (modulo 3)
		,	bfsdddist	:: !DoubleDownDist						// The maximum distance for two MouseDowns
		,	bfspos		:: !Point2								// Last position MouseDown
		,	bfswindow	:: !OSWindowPtr							// Window in which last MouseDown occurred
		}
::	ButtonFreq			:== Int
::	DoubleDownDist		:== Int
//::	KeyTrack			:==	Int								// Message field of the Event of the key being tracked
::	InputTrack													// Input being tracked:
	=	{	itWindow	:: !OSWindowPtr							// the parent window
		,	itControl	:: !Int									// zero if parent window, otherwise item nr of control (>0)
		,	itKind		:: !InputTrackKind						// the input kinds being tracked
		}
::	InputTrackKind												// Input source kinds:
	=	{	itkMouse	:: !Bool								// mouse
		,	itkKeyboard	:: !Bool								// keyboard
		}
::	ClipboardState
	=	{	cbsCount	:: !Int									// ScrapCount of last access
		}

101
/*
Peter Achten's avatar
Peter Achten committed
102
103
iostateError :: String String -> .x
iostateError rule error = Error rule "iostate" error
104
*/
Peter Achten's avatar
Peter Achten committed
105
106
107
108
109
110

//	Access rules to the IOSt:

//	Creation of an initial, empty IOSt:

emptyIOSt :: !SystemId !(Maybe SystemId) !(Maybe GUIShare) !DocumentInterface !ProcessKind 
111
112
				![ProcessAttribute (PSt .l)] !(IdFun (PSt .l)) !(Maybe SystemId)
			-> IOSt .l
Peter Achten's avatar
Peter Achten committed
113
114
115
116
117
118
119
120
121
122
123
124
125
emptyIOSt ioId parentId guishare documentInterface processKind processAtts initIO modalId
	# (wMetrics,iounique)			= emptyIOUnique initIO
	= {	iounique= iounique
	  ,	ioshare	= {	ioid			= ioId
  				  ,	ionr			= NullSystemId
  				  ,	ioparent		= parentId
  				  ,	ioguishare		= guishare
  				  ,	iosubids		= []
  				  ,	ioidseed		= 0
  				  ,	iodevicefuncs	= []
  				  ,	iodevices		= []
  				  ,	ioatts			= processAtts
  				  ,	ioruntime		= Running
126
		 		  ,	ioosdinfo		= emptyOSDInfo documentInterface
Peter Achten's avatar
Peter Achten committed
127
128
129
130
131
132
133
134
135
136
137
138
139
  				  ,	iokind			= processKind
  				  ,	ioismodal		= modalId
  				  ,	ioidtable		= initialIdTable
				  ,	ioreceivertable	= initialReceiverTable
				  ,	iotimertable	= initialTimerTable
				  ,	ioostime		= fromInt 0
  				  ,	ioactrequest	= []
  				  ,	iostack			= emptyProcessStack
  				  ,	iobutton		= InitButtonFreqState
  		//		  ,	iokeytrack		= Nothing
  				  ,	ioinputtrack	= Nothing
  				  ,	ioclipboard		= InitClipboardState
  				  ,	iooswmetrics	= wMetrics
140
				  , iorcvdisabled	= False // MW11++
Peter Achten's avatar
Peter Achten committed
141
142
143
  				  }
	  }

144
emptyIOUnique :: !(IdFun (PSt .l)) -> (!OSWindowMetrics,!*IOUnique .l)
Peter Achten's avatar
Peter Achten committed
145
146
147
148
149
150
emptyIOUnique initIO
	# tb				= OSNewToolbox
	# (wMetrics,tb)		= OSDefaultWindowMetrics tb
	= (	wMetrics
	  ,	{	ioevents	= OSnewEvents
		,	ioworld		= []
151
		,	ioprocesses	= emptyRR
Peter Achten's avatar
Peter Achten committed
152
153
154
155
156
157
158
159
160
161
162
163
164
165
		,	ioinit		= initIO
		,	iotoolbox	= tb
		}
	  )

//	Access to the ButtonFreqState:

InitButtonFreqState	:==	{	bfstime		= 0
						,	bfsfreq		= 0
						,	bfsdddist	= 5
						,	bfspos		= zero
						,	bfswindow	= OSNoWindowPtr
						}

166
IOStButtonFreq :: !Int !Point2 !OSWindowPtr !(IOSt .l) -> (!Int,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
IOStButtonFreq now pos curWindow ioState
	# (bfs,ioState)		= getButtonFreq ioState
	  newbfs			= {bfs & bfstime=now, bfspos=pos, bfswindow=curWindow}
	| curWindow<>bfs.bfswindow
		= (1,setButtonFreq {newbfs & bfsfreq=1} ioState)
	# (double,ioState)	= accIOToolbox OSGetDoubleClickTime ioState
	  oldpos			= bfs.bfspos
	  oldfreq			= bfs.bfsfreq
	  ddDist`			= Dist oldpos.x pos.x + Dist oldpos.y pos.y
	  dTime				= now-bfs.bfstime
	| dTime>double || ddDist`>bfs.bfsdddist
		= (1,setButtonFreq {newbfs & bfsfreq=1} ioState)
	| otherwise
		# newfreq		= oldfreq+1
		= (newfreq,setButtonFreq {newbfs & bfsfreq=newfreq} ioState)
where
183
	getButtonFreq :: !(IOSt .l) -> (!ButtonFreqState, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
184
185
	getButtonFreq ioState=:{ioshare} = (ioshare.iobutton, ioState)
	
186
	setButtonFreq :: !ButtonFreqState !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
187
188
	setButtonFreq bfs ioState=:{ioshare} = {ioState & ioshare={ioshare & iobutton=bfs}}

189
IOStSetDoubleDownDist :: !DoubleDownDist !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
190
191
192
193
194
195
196
IOStSetDoubleDownDist ddDist ioState=:{ioshare}
	| ddDist==ioshare.iobutton.bfsdddist
		= ioState
	| otherwise
		= {ioState & ioshare={ioshare & iobutton={ioshare.iobutton & bfsdddist=max 0 ddDist}}}


197
//	Access rules to InputTrack:
Peter Achten's avatar
Peter Achten committed
198

199
IOStGetInputTrack :: !(IOSt .l) -> (!Maybe InputTrack,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
200
201
IOStGetInputTrack ioState=:{ioshare} = (ioshare.ioinputtrack, ioState)

202
IOStSetInputTrack :: !(Maybe InputTrack) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
203
204
205
206
207
IOStSetInputTrack inputtrack ioState=:{ioshare} = {ioState & ioshare={ioshare & ioinputtrack=inputtrack}}


//	Access rules to IOAttributes:

208
IOStGetProcessAttributes :: !(IOSt .l) -> (![ProcessAttribute (PSt .l)], !IOSt .l)
Peter Achten's avatar
Peter Achten committed
209
210
IOStGetProcessAttributes ioState=:{ioshare} = (ioshare.ioatts, ioState)

211
IOStSetProcessAttributes :: ![ProcessAttribute (PSt .l)] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
212
213
214
215
216
IOStSetProcessAttributes atts ioState=:{ioshare} = {ioState & ioshare={ioshare & ioatts=atts}}


//	Access rules to the initial actions:

217
IOStGetInitIO :: !(IOSt .l) -> (!IdFun (PSt .l), !IOSt .l)
Peter Achten's avatar
Peter Achten committed
218
219
IOStGetInitIO ioState=:{iounique=unique=:{ioinit}} = (ioinit,{ioState & iounique={unique & ioinit=id}})

220
IOStSetInitIO :: !(IdFun (PSt .l)) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
221
222
223
224
225
IOStSetInitIO initIO ioState = {ioState & iounique={ioState.iounique & ioinit=initIO}}


//	Access rules to RuntimeState:

226
IOStClosed :: !(IOSt .l) -> (!Bool,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
227
228
229
IOStClosed ioState=:{ioshare={ioruntime=Closed}}= (True,ioState)
IOStClosed ioState								= (False,ioState)

230
IOStGetRuntimeState :: !(IOSt .l) -> (!RuntimeState, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
231
232
IOStGetRuntimeState ioState=:{ioshare} = (ioshare.ioruntime, ioState)

233
IOStSetRuntimeState :: !RuntimeState !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
234
235
236
237
238
IOStSetRuntimeState runtime ioState=:{ioshare} = {ioState & ioshare={ioshare & ioruntime=runtime}}


//	Access rules to IOIsModal:

239
IOStGetIOIsModal :: !(IOSt .l) -> (!Maybe SystemId, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
240
241
IOStGetIOIsModal ioState=:{ioshare} = (ioshare.ioismodal, ioState)

242
IOStSetIOIsModal :: !(Maybe SystemId) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
243
244
245
246
247
IOStSetIOIsModal optId ioState=:{ioshare} = {ioState & ioshare={ioshare & ioismodal=optId}}


//	Access rules to IdTable:

248
IOStGetIdTable :: !(IOSt .l) -> (!IdTable,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
249
250
IOStGetIdTable ioState=:{ioshare} = (ioshare.ioidtable, ioState)

251
IOStSetIdTable :: !IdTable !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
252
253
254
255
256
IOStSetIdTable idTable ioState=:{ioshare} = {ioState & ioshare={ioshare & ioidtable=idTable}}


//	Access rules to ReceiverTable:

257
IOStGetReceiverTable :: !(IOSt .l) -> (!ReceiverTable,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
258
259
IOStGetReceiverTable ioState=:{ioshare} = (ioshare.ioreceivertable, ioState)

260
IOStSetReceiverTable :: !ReceiverTable !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
261
262
263
264
265
IOStSetReceiverTable ioreceivertable ioState=:{ioshare} = {ioState & ioshare={ioshare & ioreceivertable=ioreceivertable}}


//	Access rules to TimerTable:

266
IOStGetTimerTable :: !(IOSt .l) -> (!TimerTable,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
267
268
IOStGetTimerTable ioState=:{ioshare} = (ioshare.iotimertable, ioState)

269
IOStSetTimerTable :: !TimerTable !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
270
271
272
273
274
IOStSetTimerTable tt ioState=:{ioshare} = {ioState & ioshare={ioshare & iotimertable=tt}}


//	Access rules to OSTime:

275
IOStGetOSTime :: !(IOSt .l) -> (!OSTime,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
276
277
IOStGetOSTime ioState=:{ioshare} = (ioshare.ioostime,ioState)

278
IOStSetOSTime :: !OSTime !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
279
280
281
282
283
IOStSetOSTime ostime ioState=:{ioshare} = {ioState & ioshare={ioshare & ioostime=ostime}}


//	Access rules to ActivateRequests:

284
IOStGetActivateRequests :: !(IOSt .l) -> (!ActivateRequests, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
285
286
IOStGetActivateRequests ioState=:{ioshare} = (ioshare.ioactrequest, ioState)

287
IOStSetActivateRequests :: !ActivateRequests !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
288
289
290
291
292
IOStSetActivateRequests ioReqs ioState=:{ioshare} = {ioState & ioshare={ioshare & ioactrequest=ioReqs}}


//	Access rules to the OSEvents environment:

293
IOStGetEvents :: !(IOSt .l) -> (!*OSEvents, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
294
295
IOStGetEvents ioState=:{iounique=unique=:{ioevents}} = (ioevents,{ioState & iounique={unique & ioevents=OSnewEvents}})

296
IOStSetEvents :: !*OSEvents !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
297
298
299
300
301
IOStSetEvents es ioState = {ioState & iounique={ioState.iounique & ioevents=es}}


//	Access rules to the World environment:

302
IOStGetWorld :: !(IOSt .l) -> (!*World, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
303
304
IOStGetWorld ioState=:{iounique=unique=:{ioworld=[w:ws]}} = (w,{ioState & iounique={unique & ioworld=ws}})

305
IOStSetWorld :: !*World !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
306
307
308
IOStSetWorld w ioState=:{iounique=unique=:{ioworld=ws}} = {ioState & iounique={unique & ioworld=[w:ws]}}


309
//	Access rules to CProcesses:
Peter Achten's avatar
Peter Achten committed
310

311
312
IOStGetCProcesses :: !(IOSt .l) -> (!CProcesses, !IOSt .l)
IOStGetCProcesses ioState=:{iounique=unique=:{ioprocesses}} = (ioprocesses,{ioState & iounique={unique & ioprocesses=emptyRR}})
Peter Achten's avatar
Peter Achten committed
313

314
315
IOStSetCProcesses :: !CProcesses !(IOSt .l) -> IOSt .l
IOStSetCProcesses processes ioState = {ioState & iounique={ioState.iounique & ioprocesses=processes}}
Peter Achten's avatar
Peter Achten committed
316
317
318
319


//	Access to the ProcessStack of the IOSt:

320
IOStGetProcessStack :: !(IOSt .l) -> (!ProcessStack, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
321
322
IOStGetProcessStack ioState=:{ioshare} = (ioshare.iostack, ioState)

323
IOStSetProcessStack :: !ProcessStack !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
324
325
IOStSetProcessStack ioStack ioState=:{ioshare} = {ioState & ioshare={ioshare & iostack=ioStack}}

326
SelectIOSt :: !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
327
328
329
330
331
SelectIOSt ioState=:{ioshare} = {ioState & ioshare={ioshare & iostack=selectProcessShowState ioshare.ioid ioshare.iostack}}


//	Access rules to DocumentInterface:

332
IOStGetDocumentInterface :: !(IOSt .l) -> (!DocumentInterface, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
333
334
335
336
337
IOStGetDocumentInterface ioState=:{ioshare} = (getOSDInfoDocumentInterface ioshare.ioosdinfo, ioState)


//	Access rules to OSDInfo:

338
IOStGetOSDInfo :: !(IOSt .l) -> (!OSDInfo,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
339
340
IOStGetOSDInfo ioState=:{ioshare} = (ioshare.ioosdinfo, ioState)

341
IOStSetOSDInfo :: !OSDInfo !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
342
343
344
345
346
IOStSetOSDInfo osdInfo ioState=:{ioshare} = {ioState & ioshare={ioshare & ioosdinfo=osdInfo}}


//	Access rules to ProcessKind:

347
IOStGetProcessKind :: !(IOSt .l) -> (!ProcessKind, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
348
349
350
351
352
IOStGetProcessKind ioState=:{ioshare} = (ioshare.iokind, ioState)


//	Swapping of IOSt environments:

353
354
355
IOStSwapIO :: !(![*World],!CProcesses) !(IOSt .l) -> (!(![*World],!CProcesses),!IOSt .l)
IOStSwapIO (world`,cprocesses`) ioState=:{iounique=unique=:{ioworld,ioprocesses}}
	= ((ioworld,ioprocesses),{ioState & iounique={unique & ioworld=world`,ioprocesses=cprocesses`}})
Peter Achten's avatar
Peter Achten committed
356
357
358
359


//	Access to the SystemId of the IOSt:

360
IOStGetIOId :: !(IOSt .l) -> (!SystemId,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
361
362
363
364
365
IOStGetIOId ioState=:{ioshare} = (ioshare.ioid,ioState)


//	Access to the max SystemId of the IOSt:

366
IOStGetMaxIONr :: !(IOSt .l) -> (!SystemId,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
367
368
IOStGetMaxIONr ioState=:{ioshare} = (ioshare.ionr,ioState)

369
IOStSetMaxIONr :: !SystemId !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
370
371
IOStSetMaxIONr maxId ioState=:{ioshare} = {ioState & ioshare={ioshare & ionr=maxId}}

372
IOStNewMaxIONr :: !(IOSt .l) -> (!SystemId,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
373
374
375
376
377
378
379
380
IOStNewMaxIONr ioState=:{ioshare}
	= (newMaxId, {ioState & ioshare={ioshare & ionr=maxId1}})
where
	(maxId1,newMaxId) = IncrSystemId ioshare.ionr


//	Access to the parent Id of the IOSt:

381
IOStGetParentId :: !(IOSt .l) -> (!Maybe SystemId,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
382
383
384
385
386
IOStGetParentId ioState=:{ioshare} = (ioshare.ioparent,ioState)


//	Access to the subprocess flag of the IOSt:

387
IOStGetGUIShare :: !(IOSt .l) -> (!Maybe GUIShare,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
388
389
IOStGetGUIShare ioState=:{ioshare} = (ioshare.ioguishare,ioState)

390
IOStSetGUIShare :: !(Maybe GUIShare) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
391
392
393
394
395
IOStSetGUIShare guishare ioState=:{ioshare} = {ioState & ioshare={ioshare & ioguishare=guishare}}


//	Access to the SystemIds of the subprocess of the IOSt:

396
IOStGetSubProcessIds :: !(IOSt .l) -> (![SystemId],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
397
398
IOStGetSubProcessIds ioState=:{ioshare} = (ioshare.iosubids,ioState)

399
IOStSetSubProcessIds :: ![SystemId] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
400
401
402
403
404
IOStSetSubProcessIds ids ioState=:{ioshare} = {ioState & ioshare={ioshare & iosubids=ids}}


//	Access to the global seed integer to generate all Ids (see StdId):

405
IOStGetIdSeed :: !(IOSt .l) -> (!Int,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
406
407
408
IOStGetIdSeed ioState=:{ioshare}
	= (ioshare.ioidseed,ioState)

409
IOStSetIdSeed :: !Int !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
410
411
412
413
414
415
416
417
IOStSetIdSeed seed ioState=:{ioshare}
	= {ioState & ioshare={ioshare & ioidseed=seed}}


//	Access to the ClipboardState of the IOSt:

InitClipboardState	:==	{cbsCount=0}

418
IOStGetClipboardState :: !(IOSt .l) -> (!ClipboardState, !IOSt .l)
Peter Achten's avatar
Peter Achten committed
419
420
IOStGetClipboardState ioState=:{ioshare} = (ioshare.ioclipboard,ioState)

421
IOStSetClipboardState :: !ClipboardState !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
422
423
424
425
426
IOStSetClipboardState clipboard ioState=:{ioshare} = {ioState & ioshare={ioshare & ioclipboard=clipboard}}


//	Access to the OSWindowMetrics of the IOSt:

427
IOStGetOSWindowMetrics :: !(IOSt .l) -> (!OSWindowMetrics,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
428
429
430
431
432
IOStGetOSWindowMetrics ioState=:{ioshare} = (ioshare.iooswmetrics,ioState)


//	Access to the DeviceFunctions:

433
IOStGetDeviceFunctions :: !(IOSt .l) -> (![DeviceFunctions (PSt .l)],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
434
435
IOStGetDeviceFunctions ioState=:{ioshare} = (ioshare.iodevicefuncs,ioState)

436
IOStSetDeviceFunctions :: ![DeviceFunctions (PSt .l)] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
437
438
439
440
441
IOStSetDeviceFunctions funcs ioState=:{ioshare} = {ioState & ioshare={ioshare & iodevicefuncs=funcs}}


//	Access to the DeviceSystemStates:

442
IOStLastInteraction :: !(IOSt .l) -> (!Bool,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
443
IOStLastInteraction ioState
444
445
446
	# (processes,ioState)	= IOStGetCProcesses ioState
	  (empty,processes)		= notodoRR processes
	# ioState				= IOStSetCProcesses processes ioState
447
	= (not empty,ioState)
Peter Achten's avatar
Peter Achten committed
448

449
IOStHasDevice :: !Device !(IOSt .l) -> (!Bool,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
450
451
452
453
454
455
456
IOStHasDevice d ioState=:{ioshare={iodevices=ds}}
	= (devicesHaveDevice d ds, ioState)
where
	devicesHaveDevice :: !Device ![DeviceSystemState .ps] -> Bool
	devicesHaveDevice d [dState:dStates]	= toDevice dState==d || devicesHaveDevice d dStates
	devicesHaveDevice _ _					= False

457
IOStGetDevices :: !(IOSt .l) -> (![Device],!IOSt .l)
Peter Achten's avatar
Peter Achten committed
458
459
IOStGetDevices ioState=:{ioshare={iodevices=ds}} = (map toDevice ds,ioState)

460
IOStGetDevice :: !Device !(IOSt .l) -> (!Bool,DeviceSystemState (PSt .l),!IOSt .l)
461
/*
Peter Achten's avatar
Peter Achten committed
462
IOStGetDevice device {ioshare={iodevices=[]}}
463
464
465
466
467
	= iostateError ("IOStGetDevice ["+++toString device+++"]") "I/O operations on empty IOSt not allowed"
*/
IOStGetDevice d ioState=:{ioshare=ioshare=:{iodevices=ds}}
	# (found,device,ds)	= devicesGetDevice d ds
	= (found,device,{ioState & ioshare={ioshare & iodevices=ds}})
Peter Achten's avatar
Peter Achten committed
468
where
469
	devicesGetDevice :: !Device ![DeviceSystemState .pst] -> (!Bool,DeviceSystemState .pst,![DeviceSystemState .pst])
Peter Achten's avatar
Peter Achten committed
470
	devicesGetDevice d [dState:dStates]
471
472
473
474
475
476
477
478
		| toDevice dState==d
			= (True,dState,[dState:dStates])
		| otherwise
			# (found,device,dStates)	= devicesGetDevice d dStates
			= (found,device,[dState:dStates])
	devicesGetDevice d empty
	//	= iostateError "IOStGetDevice" (toString d+++" not present in IOSt")
		= (False,undef,empty)
Peter Achten's avatar
Peter Achten committed
479

480
IOStRemoveDevice :: !Device !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
481
482
483
484
485
486
487
488
489
IOStRemoveDevice d ioState=:{ioshare}
	= {ioState & ioshare={ioshare & iodevices=devicesRemoveDevice d ioshare.iodevices}}
where
	devicesRemoveDevice :: !Device ![DeviceSystemState .ps] -> [DeviceSystemState .ps]
	devicesRemoveDevice d [dState:dStates]
		| toDevice dState==d		= dStates
		| otherwise					= [dState:devicesRemoveDevice d dStates]
	devicesRemoveDevice _ dStates	= dStates

490
IOStSetDevice :: !(DeviceSystemState (PSt .l)) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
IOStSetDevice d ioState=:{ioshare=ioshare=:{iodevices}}
	#! ds 		= devicesSetDevice priority d iodevices
	#! ioshare	= {ioshare & iodevices=ds}
	= {ioState & ioshare=ioshare}
where
	priority	= priorityDevice (toDevice d)
	
	devicesSetDevice :: !Int !(DeviceSystemState .ps) ![DeviceSystemState .ps] -> [DeviceSystemState .ps]
	devicesSetDevice p dState2 ds=:[dState1:dStates]
		# device1	= toDevice dState1
		| device1==toDevice dState2
			= [dState2:dStates]
		| p>priorityDevice device1
			= [dState2:ds]
		| otherwise
			#! ds	= devicesSetDevice p dState2 dStates
			= [dState1:ds]
	devicesSetDevice _ dState _
		= [dState]

511
// MW11..
512
IOStGetRcvDisabled	:: !(IOSt .l) -> (!Bool, !(IOSt .l))
513
514
515
IOStGetRcvDisabled io=:{ioshare={iorcvdisabled}}
	= (iorcvdisabled, io)

516
IOStSetRcvDisabled	:: !Bool !(IOSt .l) -> IOSt .l
517
518
519
IOStSetRcvDisabled iorcvdisabled io=:{ioshare}
	= { io & ioshare={ ioshare & iorcvdisabled=iorcvdisabled }}
// ..MW11
Peter Achten's avatar
Peter Achten committed
520

521
getIOToolbox :: !(IOSt .l) -> (!*OSToolbox,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
522
523
getIOToolbox ioState=:{iounique=unique=:{iotoolbox}} = (iotoolbox,{ioState & iounique={unique & iotoolbox=OSDummyToolbox}})

524
setIOToolbox :: !*OSToolbox !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
525
526
setIOToolbox tb ioState = {ioState & iounique={ioState.iounique & iotoolbox=tb}}

527
appIOToolbox :: !.(IdFun *OSToolbox) !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
528
529
530
531
appIOToolbox f ioState=:{iounique=unique=:{iotoolbox}}
	#! tb	= f iotoolbox
	=  {ioState & iounique={unique & iotoolbox=tb}}

532
accIOToolbox :: !.(St *OSToolbox .x) !(IOSt .l) -> (!.x,!IOSt .l)
Peter Achten's avatar
Peter Achten committed
533
534
535
accIOToolbox f ioState=:{iounique=unique=:{iotoolbox}}
	#! (x,tb)	= f iotoolbox
	=  (x,{ioState & iounique={unique & iotoolbox=tb}})