ioutil.icl 4.17 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
implementation module ioutil

import StdBool,StdList,StdFile
Diederik van Arkel's avatar
Diederik van Arkel committed
4
import StdControl,StdPSt//,StdFileSelect
Diederik van Arkel's avatar
Diederik van Arkel committed
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
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
101
102
103
104
105
106
import iostate

altScrollFunction :: !Direction !Int -> ScrollFunction
altScrollFunction direction d
	= altScrollFunction` direction d
where
	altScrollFunction` :: !Direction !Int !ViewFrame !SliderState !SliderMove -> Int
	altScrollFunction` direction d {corner1,corner2} {sliderThumb=x} move
		# d				= abs d
		  edge			= if (direction==Horizontal)
		  					(abs (corner2.x-corner1.x-d))
		  					(abs (corner2.y-corner1.y-d))
		= case move of
			SliderIncSmall	-> x+d
			SliderDecSmall	-> x-d
			SliderIncLarge	-> x+edge
			SliderDecLarge	-> x-edge
			SliderThumb x	-> x

alignScrollFunction :: !Direction !Int -> ScrollFunction
alignScrollFunction direction d
	= alignScrollFunction` direction d
where
	alignScrollFunction` :: !Direction !Int !ViewFrame !SliderState !SliderMove -> Int
	alignScrollFunction` direction d {corner1,corner2} {sliderThumb=x,sliderMax=m} move
		# d				= abs d
		  edge			= if (direction==Horizontal)
		  					(abs (corner2.x-corner1.x-d))
		  					(abs (corner2.y-corner1.y-d))
		= case move of
			SliderIncSmall	-> let x` = x+d in if (x`>m) m (align x`)
			SliderDecSmall	-> align (x-d)
			SliderIncLarge	-> align (x+edge)
			SliderDecLarge	-> align (x-edge)
			SliderThumb x	-> if (x == m) x (align x)
	align x = (x / d) * d

safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture);
safeOpenFixedFont fdef pict
	# ((ok,fnt),pict) = openFont fdef pict
	# ((ok,fnt),pict) = case ok of
							True -> ((ok,fnt),pict)
							False -> openFont fdef` pict
	| not ok
		= openDefaultFont pict
	= (fnt,pict)
where
	fdef` = NonProportionalFontDef
	
instance toString FontDef
where
	toString {fName,fSize,fStyles} = "<fName: "+++fName+++",fSize: "+++toString fSize+++",fStyles: "+++toS fStyles+++ ">"
	where
		toS [] = ""
		toS [s] = s
		toS [h:t] = h+++", "+++toS t

filterReturnKeys :: KeyboardStateFilter
filterReturnKeys = filterfun
where
	filterfun (SpecialKey key  (KeyDown False) _)	= key==enterKey || key==returnKey
//	filterfun (CharKey    '\n' (KeyDown False))		= True
	filterfun _										= False

escFilter :: KeyboardStateFilter
escFilter = filter
where
	filter (SpecialKey key KeyUp mods) = (key == escapeKey) && (mods == NoModifiers)
	filter _ = False

instance accScreenPicture (PSt .l)
where
	accScreenPicture f ps = accPIO (accScreenPicture f) ps

toMark :: !Bool -> MarkState
toMark True = Mark
toMark False = NoMark

toSelect :: !Bool -> SelectState
toSelect True = Able
toSelect False = Unable

noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
noPS f (ls,ps) = (f ls,ps)

drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
drawLeft point info picture
	#	text				= toString info
	=	drawAt point text picture

drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
drawCenter {x,y} info picture
	#	text				= toString info
		(width,picture)		= getPenFontStringWidth text picture
	=	drawAt {x=x-width/2,y=y} text picture

drawRight :: !.Point2 a !*Picture -> *Picture | toString a
drawRight {x,y} info picture
	#	text				= toString info
		(width,picture)		= getPenFontStringWidth text picture
	=	drawAt {x=x-width,y=y} text picture

Diederik van Arkel's avatar
Diederik van Arkel committed
107
setCheckControlItem :: !Id .Index !.Bool !*(IOSt .l) -> *(IOSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
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
setCheckControlItem id idx True io = markCheckControlItems id [idx] io
setCheckControlItem id idx False io = unmarkCheckControlItems id [idx] io

zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
zip3 [a:as] [b:bs] [c:cs]	= [(a,b,c):zip3 as bs cs]
zip3 as bs cs				= []

getPenAttributeFont :: ![.PenAttribute] -> FontDef;
getPenAttributeFont [] = SansSerifFontDef
getPenAttributeFont [PenFont f:_] = getFontDef f
getPenAttributeFont [_:t] = getPenAttributeFont t

getPenAttributeColour :: ![.PenAttribute] -> Colour;
getPenAttributeColour [] = Black
getPenAttributeColour [PenColour c:_] = c
getPenAttributeColour [_:r] = getPenAttributeColour r

getPenAttributeBack :: ![.PenAttribute] -> Colour;
getPenAttributeBack [] = White
getPenAttributeBack [PenBack c:_] = c
getPenAttributeBack [_:r] = getPenAttributeBack r

instance FileEnv Files
where
	accFiles f e = f e
	appFiles f e = f e

seqmap :: (.a -> .(.b -> .b)) ![.a] !.b -> .b;
seqmap f [] e = e
seqmap f [h:t] e
	#! e = f h e
	= seqmap f t e

notEmpty s		:== not (isEmpty s)