Andreas Raab uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-ar.71.mcz ==================== Summary ==================== Name: Graphics-ar.71 Author: ar Time: 30 August 2009, 5:11:12 am UUID: 4fc068c9-df6c-8249-b8ee-5c9ab469a2dc Ancestors: Graphics-ar.70 First pass on FreeTypePlus integration. Deal with all of the overrides and add kerning support to CharacterScanner. This gets rid of all of the FTP extensions on Graphics package and the fumbling with CharacterScanner ivar list. =============== Diff against Graphics-ar.70 =============== Item was added: + ----- Method: AbstractFont>>linearWidthOf: (in category 'measuring') ----- + linearWidthOf: aCharacter + "This is the scaled, unrounded advance width." + ^self widthOf: aCharacter! Item was added: + ----- Method: AbstractFont>>kerningLeft:right: (in category 'kerning') ----- + kerningLeft: leftChar right: rightChar + ^0! Item was changed: ----- Method: CompositionScanner>>space (in category 'stop conditions') ----- space "Record left x and character index of the space character just encounted. Used for wrap-around. Answer whether the character has crossed the right edge of the composition rectangle of the paragraph." + pendingKernX := 0. spaceX := destX. destX := spaceX + spaceWidth. spaceIndex := lastIndex. lineHeightAtSpace := lineHeight. baselineAtSpace := baseline. lastIndex := lastIndex + 1. spaceCount := spaceCount + 1. destX > rightMargin ifTrue: [^self crossedX]. ^false ! Item was added: + ----- Method: AbstractFont class>>forceNonSubPixelCount (in category 'utilities') ----- + forceNonSubPixelCount + "Answer the force non-subpixel count" + ^ForceNonSubPixelCount ifNil:[ForceNonSubPixelCount := 0]! Item was changed: ----- Method: CompositionScanner>>crossedX (in category 'stop conditions') ----- crossedX "There is a word that has fallen across the right edge of the composition rectangle. This signals the need for wrapping which is done to the last space that was encountered, as recorded by the space stop condition." + pendingKernX := 0. spaceCount >= 1 ifTrue: ["The common case. First back off to the space at which we wrap." line stop: spaceIndex. lineHeight := lineHeightAtSpace. baseline := baselineAtSpace. spaceCount := spaceCount - 1. spaceIndex := spaceIndex - 1. "Check to see if any spaces preceding the one at which we wrap. Double space after punctuation, most likely." [(spaceCount > 1 and: [(text at: spaceIndex) = Space])] whileTrue: [spaceCount := spaceCount - 1. "Account for backing over a run which might change width of space." font := text fontAt: spaceIndex withStyle: textStyle. spaceIndex := spaceIndex - 1. spaceX := spaceX - (font widthOf: Space)]. line paddingWidth: rightMargin - spaceX. line internalSpaces: spaceCount] ifFalse: ["Neither internal nor trailing spaces -- almost never happens." lastIndex := lastIndex - 1. [destX <= rightMargin] whileFalse: [destX := destX - (font widthOf: (text at: lastIndex)). lastIndex := lastIndex - 1]. spaceX := destX. line paddingWidth: rightMargin - destX. line stop: (lastIndex max: line first)]. ^true! Item was added: + ----- Method: AbstractFont>>emphasisStringFor: (in category 'accessing') ----- + emphasisStringFor: emphasisCode + "Answer a translated string that represents the attributes given in emphasisCode." + + ^self class emphasisStringFor: emphasisCode! Item was added: + ----- Method: BitBlt>>combinationRule (in category 'accessing') ----- + combinationRule + "Answer the receiver's combinationRule" + + ^combinationRule! Item was added: + ----- Method: AbstractFont>>widthAndKernedWidthOfLeft:right:into: (in category 'kerning') ----- + widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray + "Set the first element of aTwoElementArray to the width of leftCharacter and + the second element to the width of left character when kerned with + rightCharacterOrNil. Answer aTwoElementArray" + | w k | + w := self widthOf: leftCharacter. + rightCharacterOrNil isNil + ifTrue:[ + aTwoElementArray + at: 1 put: w; + at: 2 put: w] + ifFalse:[ + k := self kerningLeft: leftCharacter right: rightCharacterOrNil. + aTwoElementArray + at: 1 put: w; + at: 2 put: w+k]. + ^aTwoElementArray + ! Item was added: + ----- Method: AbstractFont>>displayUnderlineOn:from:to: (in category 'displaying') ----- + displayUnderlineOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint + "display the underline if appropriate for the receiver"! Item was changed: ----- Method: CharacterBlockScanner>>paddedSpace (in category 'stop conditions') ----- paddedSpace "When the line is justified, the spaces will not be the same as the font's space character. A padding of extra space must be considered in trying to find which character the cursor is pointing at. Answer whether the scanning has crossed the cursor." | pad | pad := 0. spaceCount := spaceCount + 1. + pad := line justifiedPadFor: spaceCount font: font. - pad := line justifiedPadFor: spaceCount. lastSpaceOrTabExtent := lastCharacterExtent copy. self lastSpaceOrTabExtentSetX: spaceWidth + pad. (destX + lastSpaceOrTabExtent x) >= characterPoint x ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy. ^self crossedX]. lastIndex := lastIndex + 1. destX := destX + lastSpaceOrTabExtent x. ^ false ! Item was changed: ----- Method: CompositionScanner>>tab (in category 'stop conditions') ----- tab "Advance destination x according to tab settings in the paragraph's textStyle. Answer whether the character has crossed the right edge of the composition rectangle of the paragraph." + pendingKernX := 0. destX := textStyle nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin. destX > rightMargin ifTrue: [^self crossedX]. lastIndex := lastIndex + 1. ^false ! Item was changed: ----- Method: CompositionScanner>>columnBreak (in category 'stop conditions') ----- columnBreak "Answer true. Set up values for the text line interval currently being composed." + pendingKernX := 0. line stop: lastIndex. spaceX := destX. line paddingWidth: rightMargin - spaceX. ^true! Item was changed: ----- Method: CompositionScanner>>cr (in category 'stop conditions') ----- cr "Answer true. Set up values for the text line interval currently being composed." + pendingKernX := 0. line stop: lastIndex. spaceX := destX. line paddingWidth: rightMargin - spaceX. ^true! Item was changed: ----- Method: CharacterBlockScanner>>crossedX (in category 'stop conditions') ----- crossedX "Text display has wrapping. The scanner just found a character past the x location of the cursor. We know that the cursor is pointing at a character or before one." | leadingTab currentX | characterIndex == nil ifFalse: [ "If the last character of the last line is a space, and it crosses the right margin, then locating the character block after it is impossible without this hack." characterIndex > text size ifTrue: [ lastIndex := characterIndex. characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight). ^true]]. characterPoint x <= (destX + (lastCharacterExtent x // 2)) ifTrue: [lastCharacter := (text at: lastIndex). characterPoint := destX @ destY. ^true]. lastIndex >= line last ifTrue: [lastCharacter := (text at: line last). characterPoint := destX @ destY. ^true]. "Pointing past middle of a character, return the next character." lastIndex := lastIndex + 1. lastCharacter := text at: lastIndex. currentX := destX + lastCharacterExtent x + kern. self lastCharacterExtentSetX: (font widthOf: lastCharacter). characterPoint := currentX @ destY. lastCharacter = Space ifFalse: [^ true]. "Yukky if next character is space or tab." alignment = Justified ifTrue: [self lastCharacterExtentSetX: + (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1) font: font)). - (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1))). ^ true]. true ifTrue: [^ true]. "NOTE: I find no value to the following code, and so have defeated it - DI" "See tabForDisplay for illumination on the following awfulness." leadingTab := true. line first to: lastIndex - 1 do: [:index | (text at: index) ~= Tab ifTrue: [leadingTab := false]]. (alignment ~= Justified or: [leadingTab]) ifTrue: [self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX leftMargin: leftMargin rightMargin: rightMargin) - currentX] ifFalse: [self lastCharacterExtentSetX: (((currentX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount))) - currentX) max: 0)]. ^ true! Item was changed: Object subclass: #AbstractFont instanceVariableNames: '' + classVariableNames: 'ForceNonSubPixelCount' - classVariableNames: '' poolDictionaries: '' category: 'Graphics-Fonts'! !AbstractFont commentStamp: '<historical>' prior: 0! AbstractFont defines the generic interface that all fonts need to implement.! Item was changed: Object subclass: #CharacterScanner + instanceVariableNames: 'destX lastIndex xTable destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks pendingKernX' - instanceVariableNames: 'destX lastIndex xTable destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks' classVariableNames: 'DefaultStopConditions NilCondition PaddedSpaceCondition SpaceCondition' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! !CharacterScanner commentStamp: '<historical>' prior: 0! My instances hold the state associated with scanning text. My subclasses scan characters for specified purposes, such as computing a CharacterBlock or placing characters into Forms.! Item was changed: ----- Method: DisplayScanner>>paddedSpace (in category 'stop conditions') ----- paddedSpace "Each space is a stop condition when the alignment is right justified. Padding must be added to the base width of the space according to which space in the line this space is and according to the amount of space that remained at the end of the line when it was composed." spaceCount := spaceCount + 1. + destX := destX + spaceWidth + (line justifiedPadFor: spaceCount font: font). - destX := destX + spaceWidth + (line justifiedPadFor: spaceCount). lastIndex := lastIndex + 1. ^ false! Item was changed: ----- Method: CharacterScanner>>setFont (in category 'private') ----- setFont | priorFont | "Set the font and other emphasis." priorFont := font. text == nil ifFalse:[ emphasisCode := 0. kern := 0. indentationLevel := 0. alignment := textStyle alignment. font := nil. (text attributesAt: lastIndex forStyle: textStyle) do: [:att | att emphasizeScanner: self]]. font == nil ifTrue: [self setFont: textStyle defaultFontIndex]. font := font emphasized: emphasisCode. + priorFont + ifNotNil: [ + font = priorFont + ifTrue:[ + "font is the same, perhaps the color has changed? + We still want kerning between chars of the same + font, but of different color. So add any pending kern to destX" + destX := destX + (pendingKernX ifNil:[0])]. + destX := destX + priorFont descentKern]. + pendingKernX := 0. "clear any pending kern so there is no danger of it being added twice" - priorFont ifNotNil: [destX := destX + priorFont descentKern]. destX := destX - font descentKern. "NOTE: next statement should be removed when clipping works" leftMargin ifNotNil: [destX := destX max: leftMargin]. kern := kern - font baseKern. "Install various parameters from the font." spaceWidth := font widthOf: Space. xTable := font xTable. stopConditions := DefaultStopConditions.! Item was changed: ----- Method: TextStyle class>>emphasisMenuForFont:target:selector:highlight: (in category 'user interface') ----- emphasisMenuForFont: font target: target selector: selector highlight: currentEmphasis "Offer a font emphasis menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font. Answer nil if no derivatives exist. " | aMenu derivs | derivs := font derivativeFonts. derivs isEmpty ifTrue: [ ^nil ]. aMenu := MenuMorph entitled: 'emphasis' translated. derivs := derivs asOrderedCollection. derivs addFirst: font. derivs do: [ :df | aMenu + add: df emphasisString - add: (AbstractFont emphasisStringFor: df emphasis) target: target selector: selector argument: df. aMenu lastItem font: df. df emphasis == currentEmphasis ifTrue: [aMenu lastItem color: Color blue darker]]. ^ aMenu! Item was changed: ----- Method: TextStyle class>>fontMenuForStyle:target:selector:highlight: (in category 'user interface') ----- fontMenuForStyle: styleName target: target selector: selector highlight: currentFont "Offer a font menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font." + | aMenu displayFont | - | aMenu | aMenu := MenuMorph entitled: styleName. (TextStyle named: styleName) ifNotNilDo: [:s | s isTTCStyle ifTrue: [aMenu add: 'New Size' target: self selector: #chooseTTCFontSize: argument: {styleName. target. selector}]]. (self pointSizesFor: styleName) do: [:pointSize | | font subMenu | font := (self named: styleName) fontOfPointSize: pointSize. subMenu := self emphasisMenuForFont: font target: target selector: selector highlight: (currentFont ifNotNilDo: [:cf | (cf familyName = styleName and: [cf pointSize = font pointSize]) ifTrue: [currentFont emphasis]]). subMenu ifNil: [aMenu add: pointSize asString , ' Point' target: target selector: selector argument: font] ifNotNil: [aMenu add: pointSize asString , ' Point' subMenu: subMenu]. + displayFont := font. + (font isSymbolFont or:[(font hasDistinctGlyphsForAll: pointSize asString , ' Point') not]) + ifTrue:[ + "don't use a symbol font to display its own name!!!!" + displayFont := self default fontOfPointSize: pointSize]. + aMenu lastItem font: displayFont. - aMenu lastItem font: font. currentFont ifNotNilDo: [:cf | (cf familyName = styleName and: [cf pointSize = font pointSize]) ifTrue: [aMenu lastItem color: Color blue darker]]]. ^ aMenu! Item was changed: ----- Method: CharacterScanner>>basicScanCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta "Primitive. This is the inner loop of text display--but see scanCharactersFrom: to:rightX: which would get the string, stopConditions and displaying from the instance. March through source String from startIndex to stopIndex. If any character is flagged with a non-nil entry in stops, then return the corresponding value. Determine width of each character from xTable, indexed by map. If dextX would exceed rightX, then return stops at: 258. Advance destX by the width of the character. If stopIndex has been reached, then return stops at: 257. Optional. See Object documentation whatIsAPrimitive." + | ascii nextDestX char floatDestX widthAndKernedWidth nextChar atEndOfRun | - | ascii nextDestX char | <primitive: 103> lastIndex := startIndex. + floatDestX := destX. + widthAndKernedWidth := Array new: 2. + atEndOfRun := false. [lastIndex <= stopIndex] whileTrue: [char := (sourceString at: lastIndex). ascii := char asciiValue + 1. (stops at: ascii) == nil ifFalse: [^stops at: ascii]. "Note: The following is querying the font about the width since the primitive may have failed due to a non-trivial mapping of characters to glyphs or a non-existing xTable." + nextChar := (lastIndex + 1 <= stopIndex) + ifTrue:[sourceString at: lastIndex + 1] + ifFalse:[ + atEndOfRun := true. + "if there is a next char in sourceString, then get the kern + and store it in pendingKernX" + lastIndex + 1 <= sourceString size + ifTrue:[sourceString at: lastIndex + 1] + ifFalse:[ nil]]. + font + widthAndKernedWidthOfLeft: char + right: nextChar + into: widthAndKernedWidth. + nextDestX := floatDestX + (widthAndKernedWidth at: 1). - nextDestX := destX + (font widthOf: char). nextDestX > rightX ifTrue: [^stops at: CrossedX]. + floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2). + atEndOfRun + ifTrue:[ + pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1). + floatDestX := floatDestX - pendingKernX]. + destX := floatDestX. - destX := nextDestX + kernDelta. lastIndex := lastIndex + 1]. lastIndex := stopIndex. ^stops at: EndOfRun! Item was added: + ----- Method: AbstractFont class>>forceNonSubPixelDuring: (in category 'utilities') ----- + forceNonSubPixelDuring: aBlock + "Forces all font rendering to suppress subpixel anti-aliasing during the execution of aBlock" + ForceNonSubPixelCount ifNil:[ForceNonSubPixelCount := 0]. + ForceNonSubPixelCount := ForceNonSubPixelCount + 1. + aBlock ensure:[ForceNonSubPixelCount := ForceNonSubPixelCount - 1]! Item was added: + ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') ----- + justifiedPadFor: spaceIndex font: aFont + "Compute the width of pad for a given space in a line of justified text." + + | pad | + internalSpaces = 0 ifTrue: [^0]. + ^(aFont notNil and:[aFont isSubPixelPositioned]) + ifTrue:[paddingWidth * 1.0 / internalSpaces] + ifFalse:[ + pad := paddingWidth // internalSpaces. + spaceIndex <= (paddingWidth \\ internalSpaces) + ifTrue: [pad + 1] + ifFalse: [pad]]! Item was added: + ----- Method: AbstractFont>>hasGlyphsForAll: (in category 'testing') ----- + hasGlyphsForAll: asciiString + "Answer true if the receiver has glyphs for all the characters + in asciiString, false otherwise. + The default behaviour is to answer true, but subclasses may reimplement" + + ^true! Item was changed: ----- Method: TextStyle>>addNewFontSize: (in category 'fonts and font indexes') ----- addNewFontSize: pointSize "Add a font in specified size to the array of fonts." + | f d newArray t isSet | - | f d newArray t isSet fallbackStyle | fontArray first emphasis ~= 0 ifTrue: [ t := TextConstants at: self fontArray first familyName asSymbol. t fonts first emphasis = 0 ifTrue: [ ^ t addNewFontSize: pointSize. ]. ]. pointSize <= 0 ifTrue: [^ nil]. fontArray do: [:s | s pointSize = pointSize ifTrue: [^ s]. ]. (isSet := fontArray first isKindOf: TTCFontSet) ifTrue:[ | fonts | fonts := fontArray first fontArray collect: [ :font | | newFont | (font isNil) ifTrue: [newFont := nil] ifFalse: [ newFont := (font ttcDescription size > 256) ifTrue: [MultiTTCFont new initialize] ifFalse: [TTCFont new initialize]. newFont ttcDescription: font ttcDescription. newFont pixelSize: pointSize * 96 // 72. font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto | proto ifNotNil: [ d := proto class new initialize. d ttcDescription: proto ttcDescription. d pixelSize: newFont pixelSize. newFont derivativeFont: d]]]. ]. newFont]. f := TTCFontSet newFontArray: fonts] ifFalse: [ + f := fontArray first class new initialize: fontArray first. - f := TTCFont new initialize. - f ttcDescription: fontArray first ttcDescription. f pointSize: pointSize. fontArray first derivativeFonts do: [:proto | proto ifNotNil: [ + d := proto class new initialize: proto. - d := TTCFont new initialize. - d ttcDescription: proto ttcDescription. d pointSize: f pointSize. + f derivativeFont: d mainFont: proto. - f derivativeFont: d. ]. ]. - ]. - isSet ifFalse: [ - fallbackStyle := TextStyle named: (fontArray first fallbackFont textStyleName). ]. newArray := ((fontArray copyWith: f) asSortedCollection: [:a :b | a pointSize <= b pointSize]) asArray. self newFontArray: newArray. isSet ifTrue: [ TTCFontSet register: newArray at: newArray first familyName asSymbol. ]. - isSet ifFalse: [ - f setupDefaultFallbackFontTo: fallbackStyle. - f derivativeFonts do: [:g | g setupDefaultFallbackFontTo: fallbackStyle]. - ]. ^ self fontOfPointSize: pointSize ! Item was added: + ----- Method: AbstractFont>>isSubPixelPositioned (in category 'testing') ----- + isSubPixelPositioned + "Answer true if the receiver is currently using subpixel positioned + glyphs, false otherwise. This affects how padded space sizes are calculated + when composing text. + Currently, only FreeTypeFonts are subPixelPositioned, and only when not + Hinted" + + ^false ! Item was added: + ----- Method: AbstractFont>>isSymbolFont (in category 'testing') ----- + isSymbolFont + "Answer true if the receiver is a Symbol font, false otherwise. + The default is to answer false, subclasses can reimplement" + + ^false! Item was added: + ----- Method: AbstractFont>>displayStrikeoutOn:from:to: (in category 'displaying') ----- + displayStrikeoutOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint + "display the strikeout if appropriate for the receiver"! Item was added: + ----- Method: AbstractFont>>hasDistinctGlyphsForAll: (in category 'testing') ----- + hasDistinctGlyphsForAll: asciiString + "Answer true if the receiver has glyphs for all the characters + in asciiString and no single glyph is shared by more than one character, false otherwise. + The default behaviour is to answer true, but subclasses may reimplement" + + ^true! Item was changed: + ----- Method: AbstractFont class>>emphasisStringFor: (in category 'utilities') ----- - ----- Method: AbstractFont class>>emphasisStringFor: (in category 'as yet unclassified') ----- emphasisStringFor: emphasisCode "Answer a translated string that represents the attributes given in emphasisCode." | emphases bit | emphasisCode = 0 ifTrue: [ ^'Normal' translated ]. emphases := (IdentityDictionary new) at: 1 put: 'Bold' translated; at: 2 put: 'Italic' translated; at: 4 put: 'Underlined' translated; at: 8 put: 'Narrow' translated; at: 16 put: 'StruckOut' translated; yourself. bit := 1. ^String streamContents: [ :s | [ bit < 32 ] whileTrue: [ | code | code := emphasisCode bitAnd: bit. code isZero ifFalse: [ s nextPutAll: (emphases at: code); space ]. bit := bit bitShift: 1 ]. s position isZero ifFalse: [ s skip: -1 ]. ]! Item was changed: ----- Method: CharacterScanner>>columnBreak (in category 'scanning') ----- columnBreak + pendingKernX := 0. ^true! Item was added: + ----- Method: AbstractFont>>emphasisString (in category 'accessing') ----- + emphasisString + "Answer a translated string that represents the receiver's emphasis." + + ^self emphasisStringFor: self emphasis! |
Free forum by Nabble | Edit this page |