The Trunk: Graphics-fbs.219.mcz

Frank Shearar uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-fbs.219.mcz

==================== Summary ====================

Name: Graphics-fbs.219
Author: fbs
Time: 23 July 2013, 8:02:56.674 pm
UUID: f09c61bc-cdf6-1642-b2b4-1a71f35487b8
Ancestors: Graphics-fbs.218

Make TrueType sit above (and extend) Graphics, thus breaking the cyclic dependency.

The decoupling is pretty rough. By all means make the division between these two packages cleaner!

=============== Diff against Graphics-fbs.218 ===============

Item was removed:
- ----- Method: CharacterScanner>>scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
- scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
-
- | ascii encoding f nextDestX startEncoding |
- lastIndex := startIndex.
- lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun].
- startEncoding := (sourceString at: startIndex) leadingChar.
- font ifNil: [font := (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
- ((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
- f := font fontArray at: startEncoding + 1.
- spaceWidth := f widthOf: Space.
- ].
-
- [lastIndex <= stopIndex] whileTrue: [
- encoding := (sourceString at: lastIndex) leadingChar.
- encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun].
- ascii := (sourceString at: lastIndex) charCode.
- (encoding = 0 and: [ascii < 256 and:[(stops at: ascii + 1) notNil]])
- ifTrue: [^ stops at: ascii + 1].
- nextDestX := destX + (font widthOf: (sourceString at: lastIndex)).
- nextDestX > rightX ifTrue: [^ stops crossedX].
- destX := nextDestX + kernDelta.
- "destX printString displayAt: 0@(lastIndex*20)."
- lastIndex := lastIndex + 1.
- ].
- lastIndex := stopIndex.
- ^ stops endOfRun!

Item was removed:
- ----- Method: CharacterScanner>>scanMultiCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
- scanMultiCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
-
- | ascii encoding f nextDestX startEncoding |
- lastIndex := startIndex.
- lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun].
- startEncoding := (sourceString at: startIndex) leadingChar.
- font ifNil: [font := (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
- ((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
- f := font fontArray at: startEncoding + 1.
- spaceWidth := f widthOf: Space.
- ].
-
- [lastIndex <= stopIndex] whileTrue: [
- encoding := (sourceString at: lastIndex) leadingChar.
- encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun].
- ascii := (sourceString at: lastIndex) charCode.
- (encoding = 0 and: [ascii < 256 and:[(stops at: ascii + 1) notNil]])
- ifTrue: [^ stops at: ascii + 1].
- nextDestX := destX + (font widthOf: (sourceString at: lastIndex)).
- nextDestX > rightX ifTrue: [^ stops crossedX].
- destX := nextDestX + kernDelta.
- "destX printString displayAt: 0@(lastIndex*20)."
- lastIndex := lastIndex + 1.
- ].
- lastIndex := stopIndex.
- ^ stops endOfRun!

Item was removed:
- ----- Method: HostFont class>>initForSubtitles (in category 'system defaults') -----
- initForSubtitles
- "
- HostFont initForSubtitles
- "
-
- HostFont textStyleFrom: 'Verdana' sizes: #(18 20 22 24 26 28) ranges: HostFont defaultRanges.
-
- StrikeFontSet installExternalFontFileName: 'greekFont.out' encoding: GreekEnvironment leadingChar encodingName: #Greek textStyleName: #DefaultMultiStyle.
-
-
- TTCFontReader encodingTag: SimplifiedChineseEnvironment leadingChar.
- TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\simhei.TTF'.
-
- TTCFontReader encodingTag: JapaneseEnvironment leadingChar.
- TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC'.
-
- TTCFontReader encodingTag: KoreanEnvironment leadingChar.
- TTCFontSet newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\gulim.TTC'.
- !

Item was removed:
- ----- Method: HostFont class>>unloadAsianTT (in category 'system defaults') -----
- unloadAsianTT
- "
- self unloadAsianTT
- "
-
- TTCFontSet removeStyleName: 'MultiSimHei'.
- TTCFontSet removeStyleName: 'MultiMSGothic'.
- TTCFontSet removeStyleName: 'MultiGulim'.
- !

Item was removed:
- ----- Method: StrikeFont class>>fromUser (in category 'instance creation') -----
- fromUser
- "StrikeFont fromUser"
- ^self fromUser: TextStyle defaultFont!

Item was removed:
- ----- Method: StrikeFont class>>fromUser: (in category 'instance creation') -----
- fromUser: priorFont
- ^self fromUser: priorFont allowKeyboard: true!

Item was removed:
- ----- Method: StrikeFont class>>fromUser:allowKeyboard: (in category 'instance creation') -----
- fromUser: priorFont allowKeyboard: aBoolean "StrikeFont fromUser"
- "Present a menu of available fonts, and if one is chosen, return it.
- Otherwise return nil. Using ToolBuilder for added abstraction."
- | fontList fontMenu font builder resultBlock widget style result item |
- builder := ToolBuilder default.
- fontList := StrikeFont actualFamilyNames.
- fontMenu := builder pluggableMenuSpec new.
- resultBlock := [:value| result := value].
- fontList do: [:fontName | | active ptMenu |
- style := TextStyle named: fontName.
- active := priorFont familyName sameAs: fontName.
- ptMenu := builder pluggableMenuSpec new.
- style pointSizes do: [:pt | | label |
- label := pt printString, ' pt'.
- item := ptMenu add: label
- target: resultBlock
- selector: #value:
- argumentList: {{fontName. pt}}.
- item checked: (active and:[pt = priorFont pointSize]).
- ].
- style isTTCStyle ifTrue: [
- ptMenu add: 'new size'
- target: style
- selector: #addNewFontSizeDialog:
- argumentList: {{fontName. fontMenu}}.
- ].
- item := fontMenu add: fontName action: nil.
- item subMenu: ptMenu.
- item checked: active.
- ].
- TTFileDescription offerNonPortableFonts ifTrue:[
- fontMenu addSeparator.
- item := fontMenu add: 'More (non-portable) Fonts...'
- target: resultBlock
- selector: #value:
- argumentList: #(TTFileDescription).
- ].
- widget := builder open: fontMenu.
- builder runModal: widget.
- result ifNil:[^nil].
- "Pick a non-portable font if requested"
- result == #TTFileDescription ifTrue:[
- ^Smalltalk at: #TTFileDescription ifPresent:[:ttf|
- ttf fontFromUser: priorFont allowKeyboard: aBoolean]].
- style := TextStyle named: result first.
- style ifNil: [^ self].
- font := style fonts detect: [:any | any pointSize = result last] ifNone: [nil].
- ^ font!

Item was removed:
- ----- Method: StrikeFont class>>newForJapaneseFromEFontBDFFile:name:overrideWith: (in category 'instance creation') -----
- newForJapaneseFromEFontBDFFile: fileName name: aString overrideWith: otherFileName
-
- | n |
- n := self new.
- n readEFontBDFForJapaneseFromFile: fileName name: aString overrideWith: otherFileName.
- ^ n.
- !

Item was removed:
- ----- Method: StrikeFont class>>setupDefaultFallbackFont (in category 'accessing') -----
- setupDefaultFallbackFont
- "
- StrikeFont setupDefaultFallbackFont
- "
-
- (#(#Accuat #Accujen #Accula #Accumon #Accusf #Accushi #Accuve #Atlanta) collect: [:e | TextStyle named: e]) do: [:style |
- style fontArray do: [:e |
- e reset.
- e setupDefaultFallbackFont.
- ].
- ].
- TTCFont allSubInstances
- do: [:font | font reset.
- font setupDefaultFallbackFont]
-
- !

Item was removed:
- ----- Method: TextStyle class>>chooseTTCFontSize: (in category 'user interface') -----
- chooseTTCFontSize: args
- "Prompt for a point size and, if one is given, add a new font size to the font named by the first member of args. If args' length is three, send a message with the selector equal to the third of args, and the receiver equal to the second of args, passing the selected style as an argument."
-
- | f n style |
- f := UIManager default request: 'New Point Size' initialAnswer: '0'.
- n := f asNumber.
- style := (TextConstants at: args first) addNewFontSize: n.
- style ifNotNil: [
- args second ifNotNil: [args second perform: args third with: style].
- ].
- !

Item was removed:
- ----- Method: TextStyle>>addLinedIfTT (in category 'fonts and font indexes') -----
- addLinedIfTT
-
- (fontArray first isKindOf: TTCFont) ifFalse: [^ self].
-
- fontArray do: [:f |
- f addLined.
- ].
- !

Item was removed:
- ----- 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 |
- 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 pointSize: pointSize.
- fontArray first derivativeFonts do: [:proto |
- proto ifNotNil: [
- d := proto class new initialize: proto.
- d pointSize: f pointSize.
- f derivativeFont: d mainFont: proto.
- ].
- ].
- ].
- newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize].
- self newFontArray: newArray.
- isSet ifTrue: [
- TTCFontSet register: newArray at: newArray first familyName asSymbol.
- ].
- ^ self fontOfPointSize: pointSize
- !

Item was removed:
- ----- Method: TextStyle>>addNewFontSizeDialog: (in category 'fonts and font indexes') -----
- addNewFontSizeDialog: args
- "This is called from a modal menu and call back the menu with entered argument."
- | f n r |
- f := UIManager default request: 'Enter the point size' initialAnswer: '12'.
- n := f asNumber.
- r := self addNewFontSize: n.
- r ifNotNil: [
- args second ifNotNil: [args second modalSelection: {args first. n}].
- ].
- !

Item was removed:
- ----- Method: TextStyle>>discardOtherSizes (in category 'fonts and font indexes') -----
- discardOtherSizes
- "This method trys to discard the fonts in non-standard size.  If the size is still in use, there will be a problem."
- | newArray |
- self isTTCStyle ifFalse: [^ self].
- newArray := fontArray select: [:s | TTCFont pointSizes includes: s pointSize].
- self newFontArray: newArray.
-
- "(TextConstants at: #ComicSansMS) discardOtherSizes"!