author | Claus Gittinger <cg@exept.de> |
Tue, 15 May 2018 18:15:30 +0200 | |
changeset 8364 | d5cdbd177a03 |
parent 7946 | 6ed11ca75246 |
permissions | -rw-r--r-- |
2547 | 1 |
" |
7946 | 2 |
COPYRIGHT (c) 1999 by Claus Gittinger / eXept Software AG |
2547 | 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 |
This is a demo example: |
|
13 |
||
14 |
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND |
|
15 |
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
16 |
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
17 |
ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE |
|
18 |
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
19 |
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
|
20 |
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
|
21 |
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
22 |
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
23 |
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
24 |
SUCH DAMAGE. |
|
25 |
" |
|
7608 | 26 |
"{ Package: 'stx:libview' }" |
2547 | 27 |
|
7608 | 28 |
"{ NameSpace: Smalltalk }" |
3659 | 29 |
|
2546 | 30 |
FontDescription subclass:#CompoundFont |
3663 | 31 |
instanceVariableNames:'baseFont characterToFontMapping maxAscent maxDescent maxHeight |
32 |
device' |
|
33 |
classVariableNames:'' |
|
34 |
poolDictionaries:'' |
|
35 |
category:'Graphics-Support' |
|
2546 | 36 |
! |
37 |
||
38 |
!CompoundFont class methodsFor:'documentation'! |
|
39 |
||
2547 | 40 |
copyright |
41 |
" |
|
7946 | 42 |
COPYRIGHT (c) 1999 by Claus Gittinger / eXept Software AG |
2547 | 43 |
All Rights Reserved |
44 |
||
45 |
This software is furnished under a license and may be used |
|
46 |
only in accordance with the terms of that license and with the |
|
47 |
inclusion of the above copyright notice. This software may not |
|
48 |
be provided or otherwise made available to, or used by, any |
|
49 |
other person. No title to or ownership of the software is |
|
50 |
hereby transferred. |
|
51 |
||
52 |
This is a demo example: |
|
53 |
||
54 |
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND |
|
55 |
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
56 |
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
57 |
ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE |
|
58 |
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
59 |
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
|
60 |
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
|
61 |
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
62 |
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
63 |
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
64 |
SUCH DAMAGE. |
|
65 |
" |
|
66 |
! |
|
67 |
||
2546 | 68 |
documentation |
69 |
" |
|
70 |
a CompountFont is a font which consists of character glyphs from multiple |
|
71 |
other (base-)fonts; for each character code, an individual font may be given. |
|
72 |
||
73 |
This has been mostly added to allow for non-EURO fonts to be used with ST/X, |
|
74 |
by defining a mixedFont, which has an EURO-glyph at the desired character |
|
75 |
position. |
|
76 |
Do not hardCode usage of MixedFonts into your application, since they |
|
77 |
might disappear in the future (when Unicode support has been fully |
|
78 |
implemented in ST/X, and Unicode fonts are generally available under X). |
|
79 |
I.e. to use these fonts, add appropriate setup to the styleSheet, |
|
80 |
or private.rc and use those fonts transparently. |
|
81 |
||
82 |
[Instance variables:] |
|
83 |
||
84 |
baseFont <Font> fallback (default-) font |
|
85 |
characterToFontMapping <Dictionary> maps characters to a fonts |
|
86 |
||
87 |
[class variables:] |
|
88 |
||
89 |
[see also:] |
|
90 |
Font BitmapFont |
|
91 |
DeviceDrawable GraphicsContext |
|
92 |
||
93 |
[author:] |
|
94 |
Claus Gittinger |
|
95 |
" |
|
96 |
||
97 |
||
98 |
! |
|
99 |
||
100 |
examples |
|
101 |
" |
|
102 |
a mixed font; all vowels are displayed in times; |
|
103 |
the rest in helvetica. |
|
104 |
[exBegin] |
|
105 |
|font top list| |
|
106 |
||
3659 | 107 |
font := CompoundFont basedOn:(Font family:'courier' size:18). |
2546 | 108 |
#($a $e $i $o $u) do:[:char | |
3659 | 109 |
font glyphAt:char putFont:(Font family:'times' size:18). |
2546 | 110 |
]. |
111 |
top := ScrollableView forView:(list := EditTextView new). |
|
112 |
list font:font. |
|
113 |
list list:#('a' 'z' 'aaa' 'zzz' 'azaz' 'zaza' 'aa' 'az' 'za' 'hello' 'abcdef' 'xyz'). |
|
114 |
top extent:200@200. |
|
115 |
top open. |
|
116 |
[exEnd] |
|
117 |
||
3671 | 118 |
[exBegin] |
119 |
|font font2 top list| |
|
120 |
||
121 |
font := CompoundFont basedOn:(Font family:'courier' size:18). |
|
122 |
font2 := Font family:'times' size:24. |
|
123 |
||
124 |
#($a $e $i $o $u $j) do:[:char | |
|
125 |
font glyphAt:char putFont:font2. |
|
126 |
font glyphAt:char asUppercase putFont:font2. |
|
127 |
]. |
|
128 |
top := ScrollableView forView:(list := EditTextView new). |
|
129 |
list font:font. |
|
130 |
list list:#('hello' 'abcdefghijklmnopqrstuvwxyz' 'xyz' |
|
131 |
'HELLO' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'XYZ'). |
|
132 |
top extent:200@200. |
|
133 |
top open. |
|
134 |
[exEnd] |
|
2546 | 135 |
|
136 |
a mixed font; the dollar character is replaced by the european |
|
137 |
EURO symbol; the rest is helvetica |
|
138 |
(this is a hack - we really need a resizable font for this): |
|
139 |
||
140 |
[exBegin] |
|
141 |
|font baseFont euroGlyph glyphs euroFont top list| |
|
142 |
||
143 |
baseFont := Font family:'helvetica' size:12. |
|
144 |
baseFont := baseFont onDevice:Display. |
|
145 |
glyphs := Array new:256. |
|
146 |
euroGlyph := Form |
|
3659 | 147 |
width:12 |
2546 | 148 |
height:16 |
149 |
fromArray:#( |
|
150 |
2r00000000 2r00000000 |
|
151 |
2r00000000 2r00000000 |
|
152 |
2r00000000 2r00000000 |
|
153 |
2r00000111 2r11000000 |
|
154 |
2r00001000 2r00100000 |
|
155 |
2r00010000 2r00000000 |
|
156 |
2r01111111 2r10000000 |
|
157 |
2r00010000 2r00000000 |
|
158 |
2r01111111 2r10000000 |
|
159 |
2r00010000 2r00000000 |
|
160 |
2r00001000 2r00100000 |
|
161 |
2r00000111 2r11000000 |
|
162 |
2r00000000 2r00000000 |
|
163 |
2r00000000 2r00000000 |
|
3659 | 164 |
2r00000000 2r00000000 |
165 |
2r00000000 2r00000000 |
|
2546 | 166 |
). |
167 |
glyphs at:($$ asciiValue+1) put:euroGlyph. |
|
168 |
||
169 |
euroFont := BitmapFont new glyphs:glyphs. |
|
170 |
euroFont setAscent:(baseFont ascent). |
|
171 |
euroFont setDescent:(baseFont descent). |
|
172 |
||
173 |
font := CompoundFont basedOn:baseFont. |
|
174 |
font glyphAt:$$ putFont:euroFont. |
|
175 |
||
176 |
top := ScrollableView forView:(list := EditTextView new). |
|
177 |
list font:font. |
|
178 |
list list:#('100 $' '193 DM'). |
|
179 |
top extent:200@200. |
|
180 |
top open. |
|
181 |
[exEnd] |
|
182 |
" |
|
183 |
! ! |
|
184 |
||
185 |
!CompoundFont class methodsFor:'instance creation'! |
|
186 |
||
187 |
basedOn:aRealFont |
|
188 |
^ self new baseFont:aRealFont |
|
189 |
! ! |
|
190 |
||
191 |
!CompoundFont methodsFor:'accessing'! |
|
192 |
||
193 |
baseFont |
|
194 |
"return the value of the instance variable 'baseFont' (automatically generated)" |
|
195 |
||
3659 | 196 |
^ baseFont |
197 |
! |
|
2546 | 198 |
|
199 |
baseFont:something |
|
200 |
"set the value of the instance variable 'baseFont' (automatically generated)" |
|
201 |
||
202 |
baseFont := something. |
|
203 |
maxAscent := maxDescent := nil. |
|
204 |
! |
|
205 |
||
206 |
glyphAt:char putFont:aFont |
|
207 |
characterToFontMapping isNil ifTrue:[ |
|
208 |
characterToFontMapping := Dictionary new. |
|
209 |
]. |
|
210 |
||
211 |
characterToFontMapping at:char put:aFont. |
|
3673 | 212 |
maxAscent := maxDescent := maxHeight := nil. |
3660 | 213 |
! |
214 |
||
215 |
graphicsDevice |
|
216 |
"return the device I am on" |
|
217 |
||
218 |
^ device |
|
2546 | 219 |
! ! |
220 |
||
221 |
!CompoundFont methodsFor:'displaying'! |
|
222 |
||
3663 | 223 |
displayString:aString from:index1 to:index2 x:x0 y:y0 in:aGC opaque:opaque |
2546 | 224 |
"this is only called for fonts which have a nil fontId, |
225 |
and therefore use the replacementFont. Should never be called |
|
226 |
for non-replacement fonts." |
|
227 |
||
228 |
|x y| |
|
229 |
||
230 |
x := x0. |
|
231 |
y := y0. |
|
232 |
||
233 |
self |
|
234 |
substringPartsOf:aString from:index1 to:index2 |
|
235 |
do:[:s :i1 :i2 :font | |
|
3671 | 236 |
|wString| |
237 |
||
238 |
wString := font widthOf:aString from:i1 to:i2. |
|
239 |
opaque ifTrue:[ |
|
3673 | 240 |
"/ (font ascent < maxAscent |
241 |
"/ or:[font descent < maxDescent]) |
|
242 |
"/ ifTrue:[ |
|
3671 | 243 |
aGC |
244 |
fillRectangleX:x |
|
3673 | 245 |
y:y-maxAscent |
3671 | 246 |
width:wString |
247 |
height:maxAscent+maxDescent |
|
248 |
color:aGC backgroundPaint. |
|
3673 | 249 |
"/ ]. |
3671 | 250 |
]. |
3663 | 251 |
font displayString:s from:i1 to:i2 x:x y:y in:aGC opaque:opaque. |
3671 | 252 |
x := x + wString. |
2546 | 253 |
]. |
254 |
! ! |
|
255 |
||
4525
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
256 |
!CompoundFont methodsFor:'printing'! |
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
257 |
|
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
258 |
userFriendlyName |
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
259 |
^ 'CompoundFont(baseFont: ', baseFont userFriendlyName, ')' |
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
260 |
! ! |
30fa1d24ca43
fix #userFriendlyName and #printOn:
Stefan Vogel <sv@exept.de>
parents:
3673
diff
changeset
|
261 |
|
2546 | 262 |
!CompoundFont methodsFor:'private'! |
263 |
||
264 |
computeMaxBounds |
|
3671 | 265 |
maxAscent := baseFont maxAscent. |
266 |
maxDescent := baseFont maxDescent. |
|
267 |
maxHeight := baseFont maxHeight. |
|
2546 | 268 |
characterToFontMapping notNil ifTrue:[ |
269 |
characterToFontMapping keysAndValuesDo:[:char :aFont | |
|
3671 | 270 |
maxAscent := maxAscent max:aFont maxAscent. |
271 |
maxDescent := maxDescent max:aFont maxDescent. |
|
272 |
maxHeight := maxHeight max:aFont maxHeight. |
|
2546 | 273 |
] |
274 |
]. |
|
275 |
! |
|
276 |
||
277 |
substringPartsOf:aString from:index1 to:index2 do:aBlock |
|
278 |
"helper - evaluate aBlock for parts of a string, which use the same font. |
|
279 |
aBlock is invoked for consecutive substrings, passing the string, |
|
280 |
the startIndex, endIndex and the font as arguments." |
|
281 |
||
282 |
|i1 i2 fn char currentFont| |
|
283 |
||
284 |
index2 < index1 ifTrue:[^ self]. |
|
285 |
||
286 |
i1 := index1. |
|
287 |
currentFont := characterToFontMapping at:(aString at:i1) ifAbsent:baseFont. |
|
288 |
i2 := i1 + 1. |
|
289 |
||
290 |
[i2 <= index2] whileTrue:[ |
|
291 |
char := aString at:i2. |
|
292 |
fn := characterToFontMapping at:char ifAbsent:baseFont. |
|
293 |
fn ~~ currentFont ifTrue:[ |
|
294 |
aBlock value:aString value:i1 value:(i2-1) value:currentFont. |
|
295 |
currentFont := fn. |
|
296 |
i1 := i2. |
|
297 |
]. |
|
298 |
i2 := i2 + 1. |
|
299 |
]. |
|
300 |
||
301 |
i1 < i2 ifTrue:[ |
|
302 |
aBlock value:aString value:i1 value:(i2-1) value:currentFont. |
|
303 |
]. |
|
304 |
||
305 |
" |
|
306 |
|f| |
|
307 |
||
308 |
f := self new. |
|
309 |
f baseFont:#baseFont. |
|
310 |
f fontAt:$$ put:#font2. |
|
311 |
f substringPartsOf:'ae$a' from:1 to:8 |
|
312 |
do:[:s :i1 :i2 :f | |
|
313 |
Transcript |
|
314 |
show:i1; space; |
|
315 |
show:i2; space; |
|
316 |
showCR:f |
|
317 |
] |
|
318 |
" |
|
319 |
! ! |
|
320 |
||
321 |
!CompoundFont methodsFor:'queries'! |
|
322 |
||
323 |
ascent |
|
3671 | 324 |
^ self maxAscent |
2546 | 325 |
! |
326 |
||
327 |
descent |
|
3671 | 328 |
^ self maxDescent |
2546 | 329 |
! |
330 |
||
3660 | 331 |
height |
332 |
maxHeight isNil ifTrue:[ |
|
333 |
self computeMaxBounds |
|
334 |
]. |
|
335 |
^ maxHeight. |
|
336 |
! |
|
337 |
||
2546 | 338 |
isFixedWidth |
7608 | 339 |
"return true, if this is a fixed pitch font |
340 |
(i.e. all characters are of the same width)" |
|
2546 | 341 |
|
3664 | 342 |
|w| |
343 |
||
2546 | 344 |
baseFont isFixedWidth ifFalse:[^ false]. |
3664 | 345 |
w := baseFont width. |
346 |
||
2546 | 347 |
characterToFontMapping keysAndValuesDo:[:char :font | |
3664 | 348 |
font isFixedWidth ifFalse:[^ false]. |
349 |
font width ~~ w ifTrue:[^ false]. |
|
2546 | 350 |
]. |
351 |
^ true |
|
352 |
! |
|
353 |
||
354 |
maxAscent |
|
3671 | 355 |
maxAscent isNil ifTrue:[ |
356 |
self computeMaxBounds |
|
357 |
]. |
|
358 |
^ maxAscent |
|
2546 | 359 |
! |
360 |
||
361 |
maxDescent |
|
3671 | 362 |
maxDescent isNil ifTrue:[ |
363 |
self computeMaxBounds |
|
364 |
]. |
|
365 |
^ maxDescent |
|
2546 | 366 |
! |
367 |
||
3659 | 368 |
onDevice:aDevice |
2546 | 369 |
"return a device representation of the receiver. |
370 |
Since I am device independent, return the receiver." |
|
371 |
||
3660 | 372 |
|newFonts lastFont lastDeviceFont newFont| |
373 |
||
374 |
aDevice == device ifTrue:[ ^ self ]. |
|
2546 | 375 |
|
376 |
baseFont := baseFont onDevice:aDevice. |
|
377 |
newFonts := Dictionary new. |
|
378 |
characterToFontMapping keysAndValuesDo:[:char :font | |
|
3660 | 379 |
font == lastFont ifTrue:[ |
380 |
newFont := lastDeviceFont |
|
381 |
] ifFalse:[ |
|
382 |
newFont := font onDevice:aDevice. |
|
383 |
lastFont := font. |
|
384 |
lastDeviceFont := newFont. |
|
385 |
]. |
|
386 |
newFonts at:char put:newFont |
|
2546 | 387 |
]. |
3660 | 388 |
characterToFontMapping := newFonts. |
389 |
device := aDevice. |
|
2546 | 390 |
! |
391 |
||
392 |
widthOf:aString from:index1 to:index2 |
|
393 |
|w| |
|
394 |
||
395 |
w := 0. |
|
396 |
self |
|
397 |
substringPartsOf:aString from:index1 to:index2 |
|
398 |
do:[:s :i1 :i2 :f | |
|
399 |
w := w + (f widthOf:s from:i1 to:i2) |
|
400 |
]. |
|
401 |
^ w |
|
402 |
||
403 |
! ! |
|
404 |
||
405 |
!CompoundFont class methodsFor:'documentation'! |
|
406 |
||
407 |
version |
|
7608 | 408 |
^ '$Header$' |
2546 | 409 |
! ! |
7608 | 410 |