StdIOCommon.dcl 10.1 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
definition module StdIOCommon


//	********************************************************************************
//	Clean Standard Object I/O library, version 1.2
//	
//	StdIOCommon defines common types and access functions for the I/O library.
//	********************************************************************************


import	StdOverloaded, StdString
import	StdBitmap, StdIOBasic, StdKey, StdMaybe
13
from	id			import	Id, RId, R2Id, RIdtoId, R2IdtoId, toString, ==
Peter Achten's avatar
Peter Achten committed
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


/*	The SelectState and MarkState types.				*/

::	SelectState		=	Able | Unable
::	MarkState		=	Mark | NoMark

enabled		:: !SelectState	-> Bool			// @1 == Able
marked		:: !MarkState	-> Bool			// @1 == Mark

instance ==		  SelectState				// Constructor equality
instance ==		  MarkState					// Constructor equality
instance ~		  SelectState				// Able <-> Unable
instance ~		  MarkState					// Mark <-> NoMark
instance toString SelectState
instance toString MarkState



/*	The KeyboardState type.								*/

::	KeyboardState
	=	CharKey		Char		KeyState	// ASCII character input
	|	SpecialKey	SpecialKey	KeyState Modifiers
											// Special key input
	|	KeyLost								// Key input lost while key was down
::	KeyState
	=	KeyDown		IsRepeatKey				// Key is down
	|	KeyUp								// Key goes up
::	IsRepeatKey								// Flag on key down:
	:==	Bool								// True iff key is repeating
::	Key
	=	IsCharKey	 Char
	|	IsSpecialKey SpecialKey
::	KeyboardStateFilter						// Predicate on KeyboardState:
	:==	KeyboardState -> Bool				// evaluate KeyFunction only if True

getKeyboardStateKeyState:: !KeyboardState -> KeyState	// KeyUp   if KeyLost
getKeyboardStateKey		:: !KeyboardState -> Maybe Key	// Nothing if KeyLost

instance ==		  KeyboardState				// Equality on KeyboardState
instance ==		  KeyState					// Equality on KeyState
instance toString KeyboardState
instance toString KeyState


/*	The MouseState type.								*/

::	MouseState
	=	MouseMove	Point2 Modifiers		// Mouse is up     (position,modifiers)
	|	MouseDown	Point2 Modifiers Int	// Mouse goes down (and nr down)
	|	MouseDrag	Point2 Modifiers		// Mouse is down   (position,modifiers)
	|	MouseUp		Point2 Modifiers		// Mouse goes up   (position,modifiers)
	|	MouseLost							// Mouse input lost while mouse was down
::	ButtonState
 	=	ButtonStillUp						// MouseMove
 	|	ButtonDown							// MouseDown _ _ 1
	|	ButtonDoubleDown					//			 _ _ 2
	|	ButtonTripleDown					//           _ _ >2
	|	ButtonStillDown						// MouseDrag
 	|	ButtonUp							// MouseUp/MouseLost
::	MouseStateFilter						// Predicate on MouseState:
	:==	MouseState -> Bool					// evaluate MouseFunction only if True

getMouseStatePos		:: !MouseState	-> Point2		// zero        if MouseLost
getMouseStateModifiers	:: !MouseState	-> Modifiers	// NoModifiers if MouseLost
getMouseStateButtonState:: !MouseState	-> ButtonState	// ButtonUp    if MouseLost

instance ==		  MouseState				// Equality on MouseState
instance ==		  ButtonState				// Constructor equality
instance toString MouseState
85
instance toString ButtonState
Peter Achten's avatar
Peter Achten committed
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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
150
151
152
153
154
155

/*	The SliderState type.								*/

::	SliderState
	=	{	sliderMin	:: !Int
		,	sliderMax	:: !Int
		,	sliderThumb	:: !Int
		}

instance == SliderState						// @1.sliderMin   == @2.sliderMin
											// @1.sliderMax   == @2.sliderMax
											// @1.sliderThumb == @2.sliderThumb
instance toString SliderState


/*	The UpdateState type.								*/

::	UpdateState
	=	{	oldFrame	:: !ViewFrame
		,	newFrame	:: !ViewFrame
		,	updArea		:: !UpdateArea
		}
::	ViewDomain			:==	Rectangle
::	ViewFrame			:==	Rectangle
::	UpdateArea			:==	[ViewFrame]

instance toString UpdateState

RectangleToUpdateState	:: !Rectangle -> UpdateState
											// r -> {oldFrame=newFrame=r,updArea=[r]}

/*	viewDomainRange defines the minimum and maximum values for ViewDomains.
	viewFrameRange  defines the minimum and maximum values for ViewFrames.
*/
viewDomainRange			:== {	corner1 = {x = 0-(2^30),y = 0-(2^30)}
							,	corner2 = {x =    2^30 ,y =    2^30 }
							}
viewFrameRange			:==	{	corner1 = {x = 1-(2^31),y = 1-(2^31)}
							,	corner2 = {x = (2^31)-1,y = (2^31)-1}
							}


/*	Modifiers indicates the meta keys that have been pressed (True) or not (False).	*/

::	Modifiers
	=	{	shiftDown	:: !Bool			// True iff shift   down
		,	optionDown	:: !Bool			// True iff option  down
		,	commandDown	:: !Bool			// True iff command down
		,	controlDown	:: !Bool			// True iff control down
		,	altDown		:: !Bool			// True iff alt     down
		}

//	Constants to check which of the Modifiers are down.

NoModifiers	:==	{shiftDown	= False
				,optionDown	= False
				,commandDown= False
				,controlDown= False
				,altDown	= False
				}
ShiftOnly	:==	{shiftDown	= True
				,optionDown	= False
				,commandDown= False
				,controlDown= False
				,altDown	= False
				}
OptionOnly	:== {shiftDown	= False
				,optionDown	= True
				,commandDown= False
				,controlDown= False
Peter Achten's avatar
Peter Achten committed
156
				,altDown	= True
Peter Achten's avatar
Peter Achten committed
157
158
159
160
				}
CommandOnly	:== {shiftDown	= False
				,optionDown	= False
				,commandDown= True
Peter Achten's avatar
Peter Achten committed
161
				,controlDown= True
Peter Achten's avatar
Peter Achten committed
162
163
164
165
				,altDown	= False
				}
ControlOnly	:== {shiftDown	= False
				,optionDown	= False
Peter Achten's avatar
Peter Achten committed
166
				,commandDown= True
Peter Achten's avatar
Peter Achten committed
167
168
169
170
				,controlDown= True
				,altDown	= False
				}
AltOnly		:==	{shiftDown	= False
Peter Achten's avatar
Peter Achten committed
171
				,optionDown	= True
Peter Achten's avatar
Peter Achten committed
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
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
				,commandDown= False
				,controlDown= False
				,altDown	= True
				}

instance ==			Modifiers
instance toString	Modifiers


/*	The layout language used for windows and controls.	*/
::	ItemPos
	:==	(	ItemLoc
		,	ItemOffset
		)
::	ItemLoc
 //	Absolute:
	=	Fix
 //	Relative to corner:
	|	LeftTop
	|	RightTop
	|	LeftBottom
	|	RightBottom
 //	Relative in next line:
	|	Left
	|	Center
	|	Right
 //	Relative to other item:
	|	LeftOf	Id
	|	RightTo	Id
	|	Above	Id
	|	Below	Id
 //	Relative to previous item:
	|	LeftOfPrev
	|	RightToPrev
	|	AbovePrev
	|	BelowPrev
::	ItemOffset
	=	NoOffset							// Shorthand for OffsetVector zero
	|	OffsetVector Vector2				// A constant offset vector
	|	OffsetFun    ParentIndex OffsetFun	// Offset depends on orientation
::	ParentIndex
	:== Int									// The number of parents (1..)
::	OffsetFun
	:==	(ViewDomain,Point2) -> Vector2		// Current view domain and origin

instance	zero	 ItemOffset				// zero == NoOffset
instance	==		 ItemLoc				// Constructor and value equality
instance	toString ItemLoc				// Constructor and value as String


/*	The Direction type.								*/

::	Direction
	=	Horizontal
	|	Vertical

instance	==		 Direction				// Constructor equality
instance	toString Direction				// Constructor as String


/*	The CursorShape type.							*/

::	CursorShape
	=	StandardCursor
	|	BusyCursor
	|	IBeamCursor
	|	CrossCursor
	|	FatCrossCursor
	|	ArrowCursor
	|	HiddenCursor

instance	==		 CursorShape			// Constructor equality
instance	toString CursorShape			// Constructor as String


/*	Document interface of interactive processes.	*/

::	DocumentInterface
	=	NDI									// No       Document Interface
	|	SDI									// Single   Document Interface
	|	MDI									// Multiple Document Interface

instance	==		 DocumentInterface		// Constructor equality
instance	toString DocumentInterface		// Constructor as String


/*	Process attributes.									*/

::	ProcessAttribute st									// Default:
	=	ProcessActivate		(IdFun st)					// No action on activate
	|	ProcessDeactivate	(IdFun st)					// No action on deactivate
	|	ProcessClose		(IdFun st)					// Process is closed
 //	Attributes for (M/S)DI process only:
	|	ProcessOpenFiles	(ProcessOpenFilesFunction st)
														// Request to open files
	|	ProcessWindowPos	ItemPos						// Platform dependent
	|	ProcessWindowSize	Size						// Platform dependent
	|	ProcessWindowResize	(ProcessWindowResizeFunction st)
														// Platform dependent
 	|	ProcessToolbar		[ToolbarItem st]			// Process has no toolbar
 //	Attributes for MDI processes only:
	|	ProcessNoWindowMenu								// Process has WindowMenu

::	ProcessWindowResizeFunction st
	:==	Size											// Old ProcessWindow size
	 ->	Size											// New ProcessWindow size
	 ->	st -> st
::	ProcessOpenFilesFunction st
	:==	[String]										// The filenames to open
	 -> st -> st

::	ToolbarItem st
	=	ToolbarItem Bitmap (Maybe String) (IdFun st)
	|	ToolbarSeparator


/*	Frequently used function types.						*/

::	ModifiersFunction	st	:==	Modifiers		->	st -> st
::	MouseFunction		st	:== MouseState		->	st -> st
::	KeyboardFunction	st	:== KeyboardState	->	st -> st
::	SliderAction		st	:==	SliderMove		->	st -> st
::	SliderMove
	=	SliderIncSmall
	|	SliderDecSmall
	|	SliderIncLarge
	|	SliderDecLarge
	|	SliderThumb Int

301
302
instance toString SliderMove

Peter Achten's avatar
Peter Achten committed
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

/*	Scrolling function.									*/

::	ScrollFunction
	:==	ViewFrame		->					// Current	view
		SliderState		->					// Current	state of scrollbar
		SliderMove		->					// Action of the user
		Int									// New thumb value

stdScrollFunction :: !Direction !Int -> ScrollFunction
/*	stdScrollFunction direction d implements standard scrolling behaviour:
	- direction indicates scrolling for Horizontal or Vertical scroll bar.
	- d         is the stepsize with which to scroll (taken absolute).
	stdScrollFunction lets the system scroll as follows:
	- Slider(Inc/Dec)Small: d
	- Slider(Inc/Dec)Large: viewFrame size modulo d
	- SliderThumb x:        x modulo d
*/


/*	Standard GUI object rendering function.				*/

::	Look
	:==	SelectState ->						// Current SelectState of GUI object
		UpdateState ->						// The area to be rendered
		*Picture	-> *Picture				// The rendering action

stdUnfillNewFrameLook:: SelectState !UpdateState !*Picture -> *Picture
stdUnfillUpdAreaLook :: SelectState !UpdateState !*Picture -> *Picture
/*	Two convenience functions for simple Look functions:
	stdUnfillNewFrameLook _ {newFrame} = unfill newFrame
	stdUnfillUpdAreaLook  _ {updArea}  = seq (map unfill updArea)
*/


/*	Common error report types.							*/

::	ErrorReport								// Usual cause:
	=	NoError								// Everything went allright
	|	ErrorViolateDI						// Violation against DocumentInterface
	|	ErrorIdsInUse						// Object contains Ids that are bound
	|	ErrorUnknownObject					// Object can not be found
345
	|	ErrorNotifierOpen					// It was tried to open a second send notifier // MW11++
Peter Achten's avatar
Peter Achten committed
346
347
348
349
	|	OtherError !String					// Other kind of error

instance	==			ErrorReport			// Constructor equality
instance	toString	ErrorReport			// Constructor as String
350
351
352

::	OkBool									// iff True, the operation was successful
	:==	Bool