--- a/XftFontDescription.st Fri Dec 12 19:32:42 2014 +0100
+++ b/XftFontDescription.st Thu Jan 29 10:54:04 2015 +0100
@@ -1,4 +1,4 @@
-'From Smalltalk/X, Version:6.2.3.0 on 08-05-2014 at 10:08:24' !
+'From Smalltalk/X, Version:6.2.5.0 on 17-12-2014 at 18:03:00' !
"{ Package: 'stx:libview' }"
@@ -78,7 +78,8 @@
# define __HANDLE_VAL(type, externalAddress) \
((type)__externalAddressVal(externalAddress))
-#define __HANDLE_NEW(ptr, __cls) \
+
+# define __HANDLE_NEW(ptr, __cls) \
({ \
OBJ handle; \
handle = __MKEXTERNALADDRESS(ptr); \
@@ -530,6 +531,22 @@
"Created: / 02-01-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!XftFontDescription methodsFor:'converting'!
+
+asNonXftFont
+ |newFont|
+
+ newFont := FontDescription
+ family:family
+ face:face
+ style:style
+ size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])
+ sizeUnit:sizeUnit
+ encoding:encoding.
+
+ ^ newFont
+! !
+
!XftFontDescription methodsFor:'displaying'!
displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque
@@ -539,13 +556,15 @@
bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error stringLen|
"limit the string len, otherwise bad output is generated"
- stringLen := index2Arg - index1.
- stringLen > 4000 ifTrue:[
- index2 := index1 + 4000.
+ stringLen := index2Arg - index1 + 1.
+ stringLen > 8000 ifTrue:[
+ index2 := index1 + 8000 - 1.
] ifFalse:[
+ stringLen <= 0 ifTrue:[^ self].
index2 := index2Arg.
].
bytesPerCharacter := aString bitsPerCharacter // 8.
+ transformation := aGC transformation.
clipR := aGC deviceClippingBoundsOrNil.
clipR notNil ifTrue:[
@@ -555,9 +574,14 @@
clipH := clipR height.
clipW > 32767 ifTrue:['clipW > 32767 ' errorPrintCR. clipW errorPrintCR. self halt. clipW := 32767].
(clipX > 16384 or:[clipX < -16384]) ifTrue:['clipX < 16384 ' errorPrintCR. clipX errorPrintCR.].
+ "/ YES YES YES: this MUST be transformed!!
+ "/ (see htmlView) fix the notebook, please.
+"/ transformation notNil ifTrue:[
+"/ clipX := (transformation applyToX:clipX) ceiling.
+"/ clipY := (transformation applyToY:clipY) ceiling.
+"/ ].
].
- transformation := aGC transformation.
transformation isNil ifTrue:[
drawX := xArg.
drawY := yArg.
@@ -760,94 +784,101 @@
(device == aGraphicsDevice) ifTrue:[^ self].
(aGraphicsDevice isNil and:[device notNil]) ifTrue:[
- ^ self
+ ^ self
+ ].
+ aGraphicsDevice supportsXFTFonts ifFalse:[
+ ^ super onDevice:aGraphicsDevice
].
(closestFont notNil and:[closestFont graphicsDevice == aGraphicsDevice]) ifTrue:[
- ^ closestFont onDevice: aGraphicsDevice.
+ ^ closestFont onDevice: aGraphicsDevice.
].
RecentlyUsedFonts isNil ifTrue:[
- RecentlyUsedFonts := OrderedCollection new:10.
+ RecentlyUsedFonts := OrderedCollection new:10.
].
RecentlyUsedFonts keysAndValuesDo:[:index :aFont |
- ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
- "/ Transcript showCR:'hit'.
- RecentlyUsedFonts removeIndex:index.
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ]
+ ((aFont class == self class) and:[(self sameDeviceFontAs:aFont) and:[aFont getFontId notNil]]) ifTrue:[
+ "/ Transcript showCR:'hit'.
+ RecentlyUsedFonts removeIndex:index.
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ]
].
RecentlyUsedFonts size > 20 ifTrue:[
- RecentlyUsedFonts removeLast.
+ RecentlyUsedFonts removeLast.
].
aGraphicsDevice deviceFonts do:[:aFont |
- ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ].
+ ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ].
].
[
- myPatternId := self xftPatternCreate.
- self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
- pixelSize notNil ifTrue:[
- self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
- ] ifFalse:[
- self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
- ].
- self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
- self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
+ Error handle:[:ex |
+ ^ self asNonXftFont onDevice:aGraphicsDevice
+ ] do:[
+ myPatternId := self xftPatternCreate.
+ ].
+ self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
+ pixelSize notNil ifTrue:[
+ self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
+ ] ifFalse:[
+ self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
+ ].
+ self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
+ self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
- newFontId notNil ifTrue:[
- "/ Good, this font exists!!
- fontId := newFontId.
- device := aGraphicsDevice.
- aGraphicsDevice registerFont:self.
- RecentlyUsedFonts addFirst:self.
- ^ self.
- ] ifFalse:[
- closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
- closestPatternId1 isNil ifTrue:[
- self error: 'No font matches'.
- ].
- "
- self xftPatternGet: closestPatternId attribute: 'family' index: 0.
- self xftPatternGet: closestPatternId attribute: 'size' index: 0.
- "
- closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
- "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
- closestPatternId1 := nil.
- newFontId isNil ifTrue:[
- self error: 'Pattern matched, but font could not be opened (should not happen)'.
- ].
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
+ newFontId notNil ifTrue:[
+ "/ Good, this font exists!!
+ fontId := newFontId.
+ device := aGraphicsDevice.
+ aGraphicsDevice registerFont:self.
+ RecentlyUsedFonts addFirst:self.
+ ^ self.
+ ] ifFalse:[
+ closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
+ closestPatternId1 isNil ifTrue:[
+ self error: 'No font matches'.
+ ].
+ "
+ self xftPatternGet: closestPatternId attribute: 'family' index: 0.
+ self xftPatternGet: closestPatternId attribute: 'size' index: 0.
+ "
+ closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
+ "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
+ closestPatternId1 := nil.
+ newFontId isNil ifTrue:[
+ self error: 'Pattern matched, but font could not be opened (should not happen)'.
+ ].
- "/ Search for existing registered font. Note, that XftFont instances
- "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
- "/ to check whether some other font instance represents the same font...
- aGraphicsDevice deviceFonts do:[:aFont |
- ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
- closestFont := aFont.
- ^ closestFont
- ].
- ].
+ "/ Search for existing registered font. Note, that XftFont instances
+ "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
+ "/ to check whether some other font instance represents the same font...
+ aGraphicsDevice deviceFonts do:[:aFont |
+ ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
+ closestFont := aFont.
+ ^ closestFont
+ ].
+ ].
- closestFont := self shallowCopy
- setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
- yourself.
- aGraphicsDevice registerFont: closestFont.
- RecentlyUsedFonts addFirst:closestFont.
- ^ closestFont
- ].
+ closestFont := self shallowCopy
+ setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
+ yourself.
+ aGraphicsDevice registerFont: closestFont.
+ RecentlyUsedFonts addFirst:closestFont.
+ ^ closestFont
+ ].
] ensure:[
- myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
- closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
- closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
+ myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
+ closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
+ closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
].
"
@@ -1617,6 +1648,11 @@
^ info
!
+getFontResolution
+ device isNil ifTrue:[ ^ 72 @ 72 ].
+ ^ device resolution
+!
+
height
"return the height - the number of pixels above plus below the baseLine."
@@ -1761,51 +1797,51 @@
list := OrderedCollection new.
readEntry :=
- [
- |key|
+ [
+ |key|
- [l startsWith:'Pattern has'] whileFalse:[
- l := pipeStream nextLine. Transcript showCR:l.
- ].
+ [l startsWith:'Pattern has'] whileFalse:[
+ l := pipeStream nextLine. Transcript showCR:l.
+ ].
- currentDescription := XftFontDescription new.
- [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
- "/ Transcript showCR:l.
- lineStream := l readStream. lineStream skipSeparators.
- key := lineStream upToSeparator.
- (
- #('family:' 'style:' 'slant:' 'weight:' 'width:'
- 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
- 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
- 'fontversion:' 'fontformat:' 'decorative:' 'index:'
- 'outline:' 'familylang:' 'stylelang:' 'fullname:'
- 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
- ) includes:key
- ) ifTrue:[
- self perform:('fc_',(key allButLast)) asSymbol
- ] ifFalse:[
- Transcript show:'Xft ignored line: '; showCR:l.
- self breakPoint:#cg.
- ].
- ].
- list add:currentDescription
- ].
+ currentDescription := XftFontDescription new.
+ [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
+ "/ Transcript showCR:l.
+ lineStream := l readStream. lineStream skipSeparators.
+ key := lineStream upToSeparator.
+ (
+ #('family:' 'style:' 'slant:' 'weight:' 'width:'
+ 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
+ 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
+ 'fontversion:' 'fontformat:' 'decorative:' 'index:'
+ 'outline:' 'familylang:' 'stylelang:' 'fullname:'
+ 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
+ ) includes:key
+ ) ifTrue:[
+ self perform:('fc_',(key allButLast)) asSymbol
+ ] ifFalse:[
+ Transcript show:'Xft ignored line: '; showCR:l.
+ self breakPoint:#cg.
+ ].
+ ].
+ list add:currentDescription
+ ].
fcListProg := #('/usr/bin/fc-list' '/usr/X11/bin/fc-list') detect:[:eachProg|
- eachProg asFilename isExecutableProgram
- ] ifNone:[
- 'fc-list program not found - no XFT fonts' infoPrintCR.
- ^ list.
- ].
+ eachProg asFilename isExecutableProgram
+ ] ifNone:[
+ 'XftFontDescription [warning]: fc-list program not found - no XFT fonts' errorPrintCR.
+ ^ list.
+ ].
pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
[
- [pipeStream atEnd] whileFalse:[
- l := pipeStream nextLine.
- readEntry value.
- ]
+ [pipeStream atEnd] whileFalse:[
+ l := pipeStream nextLine.
+ readEntry value.
+ ]
] ensure:[
- pipeStream close
+ pipeStream close
].
^ list
@@ -2050,11 +2086,11 @@
!XftFontDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.2 2015-01-29 09:54:04 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.2 2015-01-29 09:54:04 stefan Exp $'
! !