|
1 " |
|
2 COPYRIGHT (c) 1991-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 ModalBox subclass:#FontPanel |
|
14 instanceVariableNames:'previewField familyList faceList sizeList |
|
15 applyButton abortButton |
|
16 revertButton okAction abortAction |
|
17 currentFamily currentFace |
|
18 currentStyle currentFaceAndStyle currentSize' |
|
19 classVariableNames:'' |
|
20 poolDictionaries:'' |
|
21 category:'Views-Interactors' |
|
22 ! |
|
23 |
|
24 FontPanel comment:' |
|
25 |
|
26 COPYRIGHT (c) 1991-93 by Claus Gittinger |
|
27 All Rights Reserved |
|
28 |
|
29 this class implements a font chooser |
|
30 |
|
31 %W% %E% |
|
32 written fall 91 by claus |
|
33 '! |
|
34 |
|
35 !FontPanel class methodsFor:'defaults'! |
|
36 |
|
37 defaultExtent |
|
38 ^ (Display pixelPerMillimeter * (120 @ 100)) rounded |
|
39 ! ! |
|
40 |
|
41 !FontPanel class methodsFor:'startup'! |
|
42 |
|
43 fontFromUser |
|
44 |fontPanel| |
|
45 fontPanel := FontPanel new. |
|
46 fontPanel action:[:family :face :style :size | |
|
47 ^ (Font family:family |
|
48 face:face |
|
49 style:style |
|
50 size:size) |
|
51 ]. |
|
52 fontPanel showAtPointer. |
|
53 ^ nil |
|
54 |
|
55 "FontPanel fontFromUser" |
|
56 ! ! |
|
57 |
|
58 !FontPanel methodsFor:'initializing'! |
|
59 |
|
60 initialize |
|
61 |buttonWidth buttonHeight space2 space3 space4 innerWidth |
|
62 familyLabel faceLabel sizeLabel bw| |
|
63 |
|
64 super initialize. |
|
65 |
|
66 space2 := ViewSpacing * 2. |
|
67 space3 := ViewSpacing * 3. |
|
68 space4 := ViewSpacing * 4. |
|
69 |
|
70 previewField := EditField in:self. |
|
71 previewField contents:'The quick brown fox\jumps over the lazy dog\1234567890\!@#$%^&*(){}[]:"~;,./<>?' withCRs. |
|
72 bw := previewField borderWidth. |
|
73 |
|
74 innerWidth := width - space2. |
|
75 |
|
76 previewField origin:(ViewSpacing @ ViewSpacing) |
|
77 extent:((innerWidth - (2 * bw)) @ (height // 4)). |
|
78 previewField origin:(ViewSpacing @ ViewSpacing) |
|
79 extent:[(width - space2 - (2 * bw)) @ (height // 4)]. |
|
80 |
|
81 familyLabel := Label in:self. |
|
82 familyLabel origin:(ViewSpacing |
|
83 @ |
|
84 (previewField origin y + |
|
85 previewField height + |
|
86 ViewSpacing)) |
|
87 extent:(((width - space4) // 5 * 2) |
|
88 @ |
|
89 (familyLabel height)). |
|
90 familyLabel origin:[ViewSpacing |
|
91 @ |
|
92 (previewField origin y + |
|
93 previewField height + |
|
94 ViewSpacing)] |
|
95 extent:[((width - space4) // 5 * 2) |
|
96 @ |
|
97 (familyLabel height)]. |
|
98 familyLabel label:'Family'. |
|
99 |
|
100 familyList := ScrollableView for:SelectionInListView in:self. |
|
101 familyList origin:(ViewSpacing |
|
102 @ |
|
103 (familyLabel origin y + familyLabel height + ViewSpacing)) |
|
104 extent:(((width - space4) // 5 * 2) |
|
105 @ |
|
106 (height // 2)). |
|
107 familyList origin:[ViewSpacing |
|
108 @ |
|
109 (familyLabel origin y + familyLabel height + ViewSpacing)] |
|
110 extent:[((width - space4) // 5 * 2) |
|
111 @ |
|
112 (height // 2)]. |
|
113 |
|
114 faceLabel := Label in:self. |
|
115 faceLabel origin:((familyList origin x + |
|
116 familyList width + |
|
117 ViewSpacing) |
|
118 @ |
|
119 (previewField origin y + |
|
120 previewField height + |
|
121 ViewSpacing)) |
|
122 extent:(((width - space4) // 5 * 2) @ |
|
123 (faceLabel height)). |
|
124 faceLabel origin:[(familyList origin x + |
|
125 familyList width + |
|
126 ViewSpacing) |
|
127 @ |
|
128 (previewField origin y + |
|
129 previewField height + |
|
130 ViewSpacing)] |
|
131 extent:[((width - space4) // 5 * 2) @ |
|
132 (faceLabel height)]. |
|
133 faceLabel label:'Typeface'. |
|
134 |
|
135 faceList := ScrollableView for:SelectionInListView in:self. |
|
136 faceList origin:((faceLabel origin x) |
|
137 @ |
|
138 (faceLabel origin y + faceLabel height + ViewSpacing)) |
|
139 extent:(((width - space4) // 5 * 2) @ |
|
140 (height // 2)). |
|
141 faceList origin:[(faceLabel origin x) |
|
142 @ |
|
143 (faceLabel origin y + faceLabel height + ViewSpacing)] |
|
144 extent:[((width - space4) // 5 * 2) @ |
|
145 (height // 2)]. |
|
146 |
|
147 sizeLabel := Label in:self. |
|
148 sizeLabel origin:((faceList origin x + |
|
149 faceList width + |
|
150 ViewSpacing) |
|
151 @ |
|
152 (previewField origin y + |
|
153 previewField height + |
|
154 ViewSpacing)) |
|
155 extent:(((width - space4) // 5 - sizeLabel borderWidth) @ |
|
156 (sizeLabel height)). |
|
157 sizeLabel origin:[(faceList origin x + |
|
158 faceList width + |
|
159 ViewSpacing) |
|
160 @ |
|
161 (previewField origin y + |
|
162 previewField height + |
|
163 ViewSpacing)] |
|
164 extent:[((width - space4) // 5 - sizeLabel borderWidth) @ |
|
165 (sizeLabel height)]. |
|
166 sizeLabel label:'Size'. |
|
167 |
|
168 sizeList := ScrollableView for:SelectionInListView in:self. |
|
169 sizeList origin:((sizeLabel origin x) |
|
170 @ |
|
171 (sizeLabel origin y + sizeLabel height + ViewSpacing)) |
|
172 extent:(((width - space4) // 5 - sizeList borderWidth) @ |
|
173 (height // 2)). |
|
174 sizeList origin:[(sizeLabel origin x) |
|
175 @ |
|
176 (sizeLabel origin y + sizeLabel height + ViewSpacing)] |
|
177 extent:[((width - space4) // 5 - sizeList borderWidth) @ |
|
178 (height // 2)]. |
|
179 |
|
180 applyButton := Button label:(resources at:'ok') |
|
181 action:[ |
|
182 applyButton turnOffWithoutRedraw. |
|
183 self okPressed |
|
184 ] |
|
185 in:self. |
|
186 applyButton isReturnButton:true. |
|
187 |
|
188 abortButton := Button label:(resources at:'abort') |
|
189 action:[ |
|
190 abortButton turnOffWithoutRedraw. |
|
191 self abortPressed |
|
192 ] |
|
193 in:self. |
|
194 |
|
195 buttonHeight := abortButton height. |
|
196 buttonWidth := (width - space3) // 2. |
|
197 abortButton extent:(buttonWidth @ buttonHeight). |
|
198 abortButton origin:[ViewSpacing @ (height - buttonHeight - space2)] |
|
199 extent:[((width - space3) // 2) @ buttonHeight]. |
|
200 |
|
201 applyButton extent:(buttonWidth @ buttonHeight). |
|
202 applyButton origin:[((width + ViewSpacing) // 2) @ (height - buttonHeight - space2)] |
|
203 extent:[((width - space3) // 2) @ buttonHeight]. |
|
204 |
|
205 familyList action:[:lineNr | self familySelected:(familyList selectionValue)]. |
|
206 faceList action:[:lineNr | self faceSelected:(faceList selectionValue)]. |
|
207 sizeList action:[:lineNr | self sizeSelected:(sizeList selectionValue)]. |
|
208 |
|
209 familyList list:(device fontFamilies asOrderedCollection) |
|
210 |
|
211 "FontPanel new showAtPointer" |
|
212 ! |
|
213 |
|
214 realize |
|
215 "kludge for sco - xlsfont fails sometimes - try again here" |
|
216 familyList list isNil ifTrue:[familyList list:(device fontFamilies)]. |
|
217 super realize |
|
218 |
|
219 |
|
220 ! ! |
|
221 |
|
222 !FontPanel methodsFor:'user interaction'! |
|
223 |
|
224 okPressed |
|
225 self hide. |
|
226 okAction notNil ifTrue:[ |
|
227 okAction value:currentFamily |
|
228 value:currentFace |
|
229 value:currentStyle |
|
230 value:currentSize |
|
231 ] |
|
232 ! |
|
233 |
|
234 abortPressed |
|
235 self hide |
|
236 |
|
237 ! |
|
238 |
|
239 familySelected:aFamilyName |
|
240 |faces styles list| |
|
241 |
|
242 familyList selectElement:aFamilyName. |
|
243 |
|
244 list := Text new. |
|
245 currentFamily := aFamilyName. |
|
246 faces := device facesInFamily:aFamilyName. |
|
247 faces do:[:aFace | |
|
248 styles := device stylesInFamily:aFamilyName face:aFace. |
|
249 styles do:[:aStyle | |
|
250 list add:(aFace , '-' , aStyle) |
|
251 ] |
|
252 ]. |
|
253 faceList list:list. |
|
254 currentFaceAndStyle notNil ifTrue:[ |
|
255 (list includes:currentFaceAndStyle) ifTrue:[ |
|
256 faceList selectElement:currentFaceAndStyle. |
|
257 self faceSelected:currentFaceAndStyle. |
|
258 ^ self |
|
259 ] |
|
260 ]. |
|
261 sizeList list:nil |
|
262 ! |
|
263 |
|
264 faceSelected:aFaceAndStyleName |
|
265 |sizes| |
|
266 |
|
267 sizes := Text new. |
|
268 self extractFaceAndStyleFrom:aFaceAndStyleName. |
|
269 sizes := device sizesInFamily:currentFamily face:currentFace style:currentStyle. |
|
270 sizes := sizes asOrderedCollection. |
|
271 sizes sort. |
|
272 sizeList list:sizes. |
|
273 currentSize notNil ifTrue:[ |
|
274 (sizes includes:(currentSize printString)) ifTrue:[ |
|
275 sizeList selectElement:currentSize. |
|
276 self showPreview |
|
277 ] |
|
278 ] |
|
279 ! |
|
280 |
|
281 sizeSelected:aNumberOrString |
|
282 (aNumberOrString isKindOf:Number) ifTrue:[ |
|
283 currentSize := aNumberOrString |
|
284 ] ifFalse:[ |
|
285 currentSize := Number readFromString:aNumberOrString |
|
286 ]. |
|
287 self showPreview |
|
288 ! ! |
|
289 |
|
290 !FontPanel methodsFor:'accessing'! |
|
291 |
|
292 initialFont:aFont |
|
293 |family face style size| |
|
294 |
|
295 family := aFont family. |
|
296 face := aFont face. |
|
297 style := aFont style. |
|
298 size := aFont size. |
|
299 family notNil ifTrue:[ |
|
300 self familySelected:family. |
|
301 face notNil ifTrue:[ |
|
302 style notNil ifTrue:[ |
|
303 self faceSelected:(face , '-' , style). |
|
304 size notNil ifTrue:[ |
|
305 self sizeSelected:size |
|
306 ] |
|
307 ] |
|
308 ] |
|
309 ] |
|
310 ! |
|
311 |
|
312 action:aBlock |
|
313 okAction := aBlock |
|
314 ! ! |
|
315 |
|
316 !FontPanel methodsFor:'private'! |
|
317 |
|
318 showPreview |
|
319 previewField font:(Font family:currentFamily |
|
320 face:currentFace |
|
321 style:currentStyle |
|
322 size:currentSize) |
|
323 ! |
|
324 |
|
325 extractFaceAndStyleFrom:aString |
|
326 |index| |
|
327 |
|
328 index := aString indexOf:$-. |
|
329 (index ~~ 0) ifTrue:[ |
|
330 currentFaceAndStyle := aString. |
|
331 currentFace := aString copyFrom:1 to:(index - 1). |
|
332 currentStyle := aString copyFrom:(index + 1) |
|
333 ] |
|
334 |
|
335 ! ! |