etoys-dev May 2010

etoys-dev@lists.squeakfoundation.org

19 participants
192 discussions

Etoys release schedule
by Bert Freudenberg 31 May '10

31 May '10

Hi folks, we need to decide on the schedule of the next Etoys release. I see two valid alternatives: 1) "Summer" release in time for Squeakfest (end of July). That would mean we need to feature-freeze very soon, e.g. June 7th (one week from now). 2) Follow the Sugar release schedule ( http://wiki.sugarlabs.org/go/0.90/Roadmap ). That would give us more time, with feature freeze at the end of July, and the release in September. "Feature freeze" would mean that by that date, code for a new feature was at least submitted to the inbox. It does not have to be bug-free yet, but it should be complete enough for testing. Opinions? (we can also discuss in today's IRC chat) - Bert -

1 0

WebCamMorph
by Derek O'Connell 31 May '10

31 May '10

http://www.squeaksource.com/WebCamMorph.html Made mistake uploading. Anyone know how to reset MC version to 1? Instructions, on-screen controls and effects coming later.

1 0

popups in project-info
by Scott Wallace 31 May '10

31 May '10

Hi, Tim, and all, Attached is a fileout providing changes to the project-info dialog as requested for the benefit of the "showcase" on Squeakland.org. Basically, the "project info" dialog now contains three "enumerated" items, "Subject", "Age", and "Region". These three are all governed by pop-ups (in local language) rather than by type-ins. The results are included in the project manifest. Important notes: (1) It is essential that this be filed in to an image updated at least through update 2246PolygonFix-kfr. If filed in to an earlier image, subsequently loading updates will clobber some of the changes provided here. (2) Yoshiki is also modifying code in the EToyProjectDetailsMorph area in this same time-frame, so integration is likely to be necessary before our two fileouts are published. (3) There are a few obvious rough edges which someone may wish to tweak, though I don't know of any show-stoppers. For example, this has always been an English-only dialog, but now that the field names are localized, there may be layout issues in some languages (once translations are available.) Also, for the pop-up fields, if they've never been set they show as blank, whereas once they've been set to "(none)" (equivalent to blank) they show the text "(none)". Probably we should always show "(none)" when values for these three popups have not been supplied. Also, since some of the fields are now type-in and some are pop-ups, perhaps some UI convention (slight color difference?) should be used to hint at whether a field functions as a type-in or a pop-up. (4) This turned out to involve quite a bit of code, most of it written with a fever and at very late hours. So there's the distinct possibility of errors. I did test it briefly and it seemed to work as I expected. HOWEVER: it really needs verification by someone else. (5) The Preamble (please read if planning to test or use): -=------ Change Set: projectInfoPopUps-sw Date: 8 August 2009 Author: Scott Wallace Changes to the project-info dialog, in support of new data desired for the 'showcase' on squeakland.org: - 'Sub-Category' removed. - Subject, Age, and Region are added as pop-ups. - Choices for Subject, Age, Region popups, and corresponding codes, obtainable from web-site. - Project manifest now includes Age, Subject (category,) and Region info. The codes are strings of numbers, e.g. '554' as a Subject code means 'Language Arts' (look in #defaultAgeTriplets, #defaultSubjectTriplets, #defaultRegionTriplets on class-side of EToyProjectDetailsMorph.) - Names of fields are presented to the user in localized form. - Choices for values of pop-up fields are presented to the user in localized form. Notes: - There is support provided for obtaining up-to-date lists of the subject, age, and region alternatives from the web site (see EToyProjectDetailsMorph class updateTripletsFromWebSite) but it is not actually called at this point, out of concern for potential for long delay if connection to web site is slow. - The *region* codes are at present *not* obtained from the web-site (even when the user explicitly calls #updateTripletsFromWebSite,) but rather a 'fake' set of regions, basically the continents, is provided. This is probably temporary. We have no reasonable way to confront the user with a pop-up showing 250 choices. However, as per Tim's request, I have made it a point to include Antarctica in the region list. (Tim: look at method #defaultRegionTriplets for the current point of departure, if you want to adopt that, temporarily at least, on the web site. And/or of course change any defaults as needed. ----------- Cheers, -- Scott

11 34

Etoys: Graphics-Richo.4.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of Graphics to project Etoys: http://source.squeak.org/etoys/Graphics-Richo.4.mcz ==================== Summary ==================== Name: Graphics-Richo.4 Author: Richo Time: 30 May 2010, 5:11:17 pm UUID: a3ccd808-422a-1547-90fc-599bfe6187e3 Ancestors: Graphics-Richo.3 * Integrating true type font support by Andreas Raab =============== Diff against Graphics-Richo.3 =============== Item was changed: ----- Method: TextStyle class>>styleDecoder (in category 'class initialization') ----- styleDecoder TextConstants at: #StyleDecoder ifPresent: [ :dict | dict ifNotNil: [ ^dict ]]. ^TextConstants at: #StyleDecoder put: ( Dictionary new at: 'Regular' put: 0; at: 'Roman' put: 0; at: 'Medium' put: 0; at: 'Light' put: 0; at: 'Normal' put: 0; at: 'Plain' put: 0; at: 'Book' put: 0; at: 'Demi' put: 0; at: 'Demibold' put: 0; at: 'Semibold' put: 0; at: 'SemiBold' put: 0; at: 'ExtraBold' put: 1; at: 'SuperBold' put: 1; + at: 'Negreta' put: 1; at: 'B' put: 1; at: 'I' put: 2; at: 'U' put: 4; at: 'X' put: 16; at: 'N' put: 8; at: 'Bold' put: 1; at: 'Italic' put: 2; at: 'Oblique' put: 2; at: 'Narrow' put: 8; at: 'Condensed' put: 8; at: 'Underlined' put: 4; yourself )!

1 0

Etoys: TrueType-Richo.3.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of TrueType to project Etoys: http://source.squeak.org/etoys/TrueType-Richo.3.mcz ==================== Summary ==================== Name: TrueType-Richo.3 Author: Richo Time: 30 May 2010, 5:11:08 pm UUID: 87c0ca6c-4fa5-5e45-85e5-aaf9937d2a07 Ancestors: TrueType-Richo.2 * Integrating true type font support by Andreas Raab. =============== Diff against TrueType-Richo.2 =============== Item was changed: ----- Method: TTFileDescription>>on:offset: (in category 'initialize') ----- on: aFileName offset: fontOffset "Initialize the receiver from a file name" fileName := aFileName. fileOffset := fontOffset. self withFileDo:[:fontFile| + "Some bitmap fonts are called .ttf; skip anything that doesn't have a header" + (self findTable: 'head' in: fontFile) ifFalse:[^nil]. - (self findTable: 'head' in: fontFile) - ifFalse:[^self error: 'File does not have a header table']. self processFontHeaderTable: fontFile. (self findTable: 'maxp' in: fontFile) ifFalse:[^self error: 'File does not have a profile table']. self processMaximumProfileTable: fontFile. (self findTable: 'name' in: fontFile) ifFalse:[^self error: 'File does not have a naming table']. self processNamingTable: fontFile. (self findTable: 'hhea' in: fontFile) ifFalse:[^self error: 'File does not have a horizontal header table']. self processHorizontalHeaderTable: fontFile. (self findTable: 'hmtx' in: fontFile) ifFalse:[^self error: 'File does not have a horizontal header table']. hmtxTableOffset := fontFile position. (self findTable: 'loca' in: fontFile) ifFalse:[^self error: 'File does not have a naming table']. indexToLocOffset := fontFile position. (self findTable: 'glyf' in: fontFile) ifFalse:[^self error: 'File does not have a naming table']. glyphTableOffset := fontFile position. (self findTable: 'cmap' in: fontFile) ifFalse:[^self error: 'File does not have a header table']. self processCharacterMappingTable: fontFile. ].! Item was changed: ----- Method: TTFileDescription class>>fontOffsetsInFile: (in category 'instance creation') ----- fontOffsetsInFile: file "Answer a collection of font offsets in the given file" | tag version nFonts | file position: 0. tag := file next: 4. tag caseOf:{ + ['true' asByteArray] -> ["Version 1.0 TTF file" + "http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html + The values 'true' (0x74727565) and 0x00010000 are recognized by the Mac OS + as referring to TrueType fonts." + ^Array with: 0 "only one font" + ]. [#(0 1 0 0) asByteArray] -> ["Version 1.0 TTF file" ^Array with: 0 "only one font" ]. ['ttcf' asByteArray] -> ["TTC file" version := file next: 4. version = #(0 1 0 0) asByteArray ifFalse:[^self error: 'Unsupported TTC version']. nFonts := file nextNumber: 4. ^(1 to: nFonts) collect:[:i| file nextNumber: 4]. ]. } otherwise:[ self error: 'This is not a valid Truetype file'. ].! Item was changed: ----- Method: TTFileDescription class>>readFontsFrom: (in category 'instance creation') ----- readFontsFrom: aFilename "Reads and returns all the fonts in the given file" " TTFileDescription readFontsFrom: 'batang.ttc'. " ^self openFontFile: aFilename do:[:file| (self fontOffsetsInFile: file) + collect:[:offset| self new on: aFilename offset: offset] + thenSelect:[:font| font notNil]]. - collect:[:offset| self new on: aFilename offset: offset]]. !

1 0

Etoys: Graphics-Richo.3.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of Graphics to project Etoys: http://source.squeak.org/etoys/Graphics-Richo.3.mcz ==================== Summary ==================== Name: Graphics-Richo.3 Author: Richo Time: 30 May 2010, 5:10:09 pm UUID: 0ec495e4-b9ef-d84b-84eb-e68266c01585 Ancestors: Graphics-bf.2 * Integrating true type font support by Andreas Raab. =============== Diff against Graphics-bf.2 =============== Item was changed: SystemOrganization addCategory: #'Graphics-Display Objects'! + SystemOrganization addCategory: #'Graphics-External'! SystemOrganization addCategory: #'Graphics-Files'! + SystemOrganization addCategory: #'Graphics-Fonts'! SystemOrganization addCategory: #'Graphics-Primitives'! SystemOrganization addCategory: #'Graphics-Text'! - SystemOrganization addCategory: #'Graphics-Transformations'! SystemOrganization addCategory: #'Graphics-Tools-Intersection'! SystemOrganization addCategory: #'Graphics-Tools-Simplification'! SystemOrganization addCategory: #'Graphics-Tools-Triangulation'! + SystemOrganization addCategory: #'Graphics-Transformations'! - SystemOrganization addCategory: #'Graphics-External'! - SystemOrganization addCategory: #'Graphics-Fonts'! Item was changed: ----- Method: DisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') ----- displayLine: textLine offset: offset leftInRun: leftInRun "The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated). leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions." | done stopCondition nowLeftInRun startIndex string lastPos | + line := textLine. + morphicOffset := offset. + lineY := line top + offset y. + lineHeight := line lineHeight. + rightMargin := line rightMargin + offset x. + lastIndex := line first. - line _ textLine. - morphicOffset _ offset. - lineY _ line top + offset y. - lineHeight _ line lineHeight. - rightMargin _ line rightMargin + offset x. - lastIndex _ line first. leftInRun <= 0 ifTrue: [self setStopConditions]. + leftMargin := (line leftMarginForAlignment: alignment) + offset x. + destX := runX := leftMargin. - leftMargin _ (line leftMarginForAlignment: alignment) + offset x. - destX _ runX _ leftMargin. fillBlt == nil ifFalse: ["Not right" fillBlt destX: line left destY: lineY width: line width left height: lineHeight; copyBits]. + lastIndex := line first. - lastIndex _ line first. leftInRun <= 0 + ifTrue: [nowLeftInRun := text runLengthFor: lastIndex] + ifFalse: [nowLeftInRun := leftInRun]. + destY := lineY + line baseline - font ascent. + runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last. + spaceCount := 0. + done := false. + string := text string. - ifTrue: [nowLeftInRun _ text runLengthFor: lastIndex] - ifFalse: [nowLeftInRun _ leftInRun]. - destY _ lineY + line baseline - font ascent. - runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last. - spaceCount _ 0. - done _ false. - string _ text string. [done] whileFalse:[ + startIndex := lastIndex. + lastPos := destX@destY. + stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - startIndex _ lastIndex. - lastPos _ destX@destY. - stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: string rightX: rightMargin stopConditions: stopConditions kern: kern. lastIndex >= startIndex ifTrue:[ font displayString: string on: bitBlt + from: startIndex + "XXXX: The following is an interesting bug. All stopConditions exept #endOfRun + have lastIndex past the last character displayed. #endOfRun sets it *on* the character. + If we display up until lastIndex then we will also display invisible characters like + CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex + consistently) but I don't want to deal with the fallout right now so we keep the + fix minimally invasive." + to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) + at: lastPos kern: kern]. - from: startIndex to: lastIndex at: lastPos kern: kern]. "see setStopConditions for stopping conditions for displaying." + done := self perform: stopCondition. + lastIndex > runStopIndex ifTrue: [done := true]. - done _ self perform: stopCondition. - lastIndex > runStopIndex ifTrue: [done _ true]. ]. ^ runStopIndex - lastIndex "Number of characters remaining in the current run"!

1 0

Etoys: Multilingual-Richo.9.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of Multilingual to project Etoys: http://source.squeak.org/etoys/Multilingual-Richo.9.mcz ==================== Summary ==================== Name: Multilingual-Richo.9 Author: Richo Time: 30 May 2010, 5:09:38 pm UUID: 73d74df2-e8db-8f4f-b1ca-bea53533f8ed Ancestors: Multilingual-Richo.8 * Integrating true type font support by Andreas Raab =============== Diff against Multilingual-Richo.8 =============== Item was changed: ----- Method: MultiDisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') ----- displayLine: textLine offset: offset leftInRun: leftInRun "The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated). leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions." | done stopCondition nowLeftInRun startIndex string lastPos | + line := textLine. + morphicOffset := offset. + lineY := line top + offset y. + lineHeight := line lineHeight. + rightMargin := line rightMargin + offset x. + lastIndex := line first. - line _ textLine. - morphicOffset _ offset. - lineY _ line top + offset y. - lineHeight _ line lineHeight. - rightMargin _ line rightMargin + offset x. - lastIndex _ line first. leftInRun <= 0 ifTrue: [self setStopConditions]. + leftMargin := (line leftMarginForAlignment: alignment) + offset x. + destX := runX := leftMargin. - leftMargin _ (line leftMarginForAlignment: alignment) + offset x. - destX _ runX _ leftMargin. fillBlt == nil ifFalse: ["Not right" fillBlt destX: line left destY: lineY width: line width left height: lineHeight; copyBits]. + lastIndex := line first. - lastIndex _ line first. leftInRun <= 0 + ifTrue: [nowLeftInRun := text runLengthFor: lastIndex] + ifFalse: [nowLeftInRun := leftInRun]. + baselineY := lineY + line baseline. + destY := baselineY - font ascent. + runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last. + spaceCount := 0. + done := false. + string := text string. - ifTrue: [nowLeftInRun _ text runLengthFor: lastIndex] - ifFalse: [nowLeftInRun _ leftInRun]. - baselineY _ lineY + line baseline. - destY _ baselineY - font ascent. - runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last. - spaceCount _ 0. - done _ false. - string _ text string. [done] whileFalse:[ + startIndex := lastIndex. + lastPos := destX@destY. + stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - startIndex _ lastIndex. - lastPos _ destX@destY. - stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: string rightX: rightMargin stopConditions: stopConditions kern: kern. lastIndex >= startIndex ifTrue:[ font displayString: string on: bitBlt + from: startIndex + "XXXX: The following is an interesting bug. All stopConditions exept #endOfRun + have lastIndex past the last character displayed. #endOfRun sets it *on* the character. + If we display up until lastIndex then we will also display invisible characters like + CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex + consistently) but I don't want to deal with the fallout right now so we keep the + fix minimally invasive." + to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) + at: lastPos kern: kern baselineY: baselineY]. - from: startIndex to: lastIndex at: lastPos kern: kern baselineY: baselineY]. "see setStopConditions for stopping conditions for displaying." + done := self perform: stopCondition. + "lastIndex > runStopIndex ifTrue: [done := true]." - done _ self perform: stopCondition. - "lastIndex > runStopIndex ifTrue: [done _ true]." ]. ^ runStopIndex - lastIndex "Number of characters remaining in the current run"!

1 0

Etoys: Multilingual-Richo.8.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of Multilingual to project Etoys: http://source.squeak.org/etoys/Multilingual-Richo.8.mcz ==================== Summary ==================== Name: Multilingual-Richo.8 Author: Richo Time: 30 May 2010, 5:04:42 pm UUID: 0bf2bd31-ae57-544e-a5bf-bcf36c486f0c Ancestors: Multilingual-Richo.7 * Fixed a bug in TTCFont>>#textStyle =============== Diff against Multilingual-Richo.7 =============== Item was changed: ----- Method: TTCFont>>textStyle (in category 'accessing') ----- textStyle + + ^ TextStyle actualTextStyles + detect: [:aStyle | (aStyle fontArray collect: [:s | s name]) includes: self name] + ifNone: [].! - ^ TextStyle actualTextStyles detect: - [:aStyle | aStyle fontArray includes: self] ifNone: [nil]!

1 0

Etoys: Multilingual-Richo.7.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of Multilingual to project Etoys: http://source.squeak.org/etoys/Multilingual-Richo.7.mcz ==================== Summary ==================== Name: Multilingual-Richo.7 Author: Richo Time: 30 May 2010, 5:00:18 pm UUID: bdb9aaa5-53a4-c049-983a-b22e0e349d06 Ancestors: Multilingual-KR.6 * Integrating true type font support by Andreas Raab =============== Diff against Multilingual-KR.6 =============== Item was changed: ----- Method: TTCFont class>>registerAll (in category 'other') ----- registerAll " TTCFont registerAll " TextStyle allInstancesDo: [:e | + (e fontArray first isMemberOf: TTCFont) ifTrue: [ - (e isTTCStyle) ifTrue: [ self register: e fontArray at: e fontArray first familyName asSymbol. ]. ]. ! Item was changed: ----- Method: TTCFont>>computeForm: (in category 'private') ----- computeForm: char | ttGlyph scale | + scale := self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender). + Scale ifNotNil: [scale := Scale * scale]. + ttGlyph := ttcDescription at: (char isCharacter ifTrue: [char charCode] ifFalse: [char]). + ^ ttGlyph ifNotNil:[ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth]. - scale _ self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender). - Scale ifNotNil: [scale _ Scale * scale]. - ttGlyph _ ttcDescription at: (char isCharacter ifTrue: [char charCode] ifFalse: [char]). - ^ ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth. ! Item was changed: ----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'friend') ----- installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor + self foregroundColor: fgColor. "install color" - - foregroundColor _ fgColor. - aDisplayContext installTTCFont: self foregroundColor: foregroundColor backgroundColor: bgColor ! Item was changed: ----- Method: TTCFont>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- convertToCurrentVersion: varDict refStream: smartRefStrm "If we're reading in an old version with a pixelSize instance variable, convert it to a point size." "Deal with the change from pixelSize to pointSize, assuming the current monitor dpi." varDict at: 'pixelSize' ifPresent: [ :x | + pointSize := (TextStyle pixelsToPoints: x) rounded. - pointSize _ (TextStyle pixelsToPoints: x) rounded. ]. ^super convertToCurrentVersion: varDict refStream: smartRefStrm.! Item was added: + ----- Method: TTCFont>>derivativeFontArray (in category 'friend') ----- + derivativeFontArray + + ^ derivatives. + ! Item was changed: ----- Method: TTCFont class>>newTextStyleFromTTFile: (in category 'instance creation') ----- newTextStyleFromTTFile: fileName "Create a new TextStyle from specified file name. On certain versions of Windows, you can evaluate following to get Arial font into the image. On other platforms, wait and see someone implements the support code for FontPlugin then we can start relying on the generic font lookup mechanism. TTCFontReader encodingTag: 0. self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\symbol.TTF'. " | description | + description := TTFontDescription addFromTTFile: fileName. - description _ TTFontDescription addFromTTFile: fileName. ^ self newTextStyleFromTT: description. ! Item was changed: ----- Method: TTCFont>>maxAscii (in category 'accessing') ----- maxAscii + "Answer the max. code point in this font. The name of this method is historical." + ^maxAscii ifNil:[ttcDescription size].! - - ^ ttcDescription size. - ! Item was changed: ----- Method: TTCFont>>ttcDescription: (in category 'friend') ----- ttcDescription: aTTCDescription + ttcDescription := aTTCDescription. + self flushCache. - ttcDescription _ aTTCDescription. - self recreateCache. ! Item was changed: ----- Method: TTCFont>>fallbackFont (in category 'accessing') ----- fallbackFont ^ fallbackFont + ifNil: [fallbackFont := FixedFaceFont new errorFont fontSize: self height]! - ifNil: [fallbackFont _ FixedFaceFont new errorFont fontSize: self height]! Item was added: + ----- Method: TTCFont>>setupDefaultFallbackFontTo: (in category 'friend') ----- + setupDefaultFallbackFontTo: aTextStyleOrNil + " + TTCFont allInstances do: [:i | i setupDefaultFallbackFontTo: (TextStyle named: 'MultiMSMincho')]. + " + + | fonts f | + aTextStyleOrNil ifNil: [ + self fallbackFont: nil. + ^ self. + ]. + fonts := aTextStyleOrNil fontArray. + (aTextStyleOrNil defaultFont familyName endsWith: self familyName) ifTrue: [fallbackFont := nil. ^ self]. + + f := fonts first. + 1 to: fonts size do: [:i | + self height >= (fonts at: i) height ifTrue: [f := fonts at: i]. + ]. + self fallbackFont: f. + self reset. + + ! Item was changed: ----- Method: TTCFont class>>shutDown (in category 'class initialization') ----- shutDown "Flush the glyph cache" GlyphCacheData atAllPut: nil. + GlyphCacheIndex := 0. + ShutdownList ifNotNil:[ShutdownList do:[:fnt| fnt flushCache]]. + ShutdownList := WeakSet new. + ! - GlyphCacheIndex := 0.! Item was changed: ----- Method: TTCFont>>minAscii (in category 'accessing') ----- minAscii + "Answer the min. code point in this font. The name of this method is historical." - ^ 0. ! Item was changed: ----- Method: TTCFont>>emphasis (in category 'accessing') ----- emphasis "Answer the emphasis code (0 to 3) corresponding to my subfamily name" + ^self indexOfSubfamilyName: self subfamilyName - ^TTCFont indexOfSubfamilyName: self subfamilyName ! Item was changed: ----- Method: TTCFont class>>getExistings: (in category 'instance creation') ----- getExistings: fontArray | result em | + result := OrderedCollection new. - result _ OrderedCollection new. result add: fontArray. 1 to: 3 do: [:i | + em := (fontArray collect: [:f | f emphasized: i]). - em _ (fontArray collect: [:f | f emphasized: i]). (em at: 1) ~= (fontArray at: 1) ifTrue: [ result add: em. ]. ]. ^ result asArray. ! Item was changed: ----- Method: TTCFont>>textStyle (in category 'accessing') ----- textStyle + ^ TextStyle actualTextStyles detect: + [:aStyle | aStyle fontArray includes: self] ifNone: [nil]! - ^ TextStyle actualTextStyles - at: self familyName asSymbol - ifAbsent: []! Item was changed: ----- Method: TTCFont class>>familyName:pointSize:emphasis: (in category 'instance creation') ----- familyName: n pointSize: s emphasis: code + "(TTCFont familyName: 'BitstreamVeraSans' pointSize: 12 emphasis: 0)" + | t ret index | + t := self registry at: n asSymbol ifAbsent: [#()]. + t isEmpty ifTrue: [ + t := (TextConstants at: #DefaultTextStyle) fontArray. + ret := t first. + ret pointSize >= s ifTrue: [^ ret emphasis: code]. + index := 2. + [index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [ + ret := t at: index. + index := index + 1. + ]. + ^ ret emphasis: code. + ]. + ^ ((TextStyle named: n) addNewFontSize: s) emphasis: code. + ! - ^ self familyName: n pointSize: s emphasized: code! Item was changed: ----- Method: TTCFont>>widthOf: (in category 'public') ----- widthOf: aCharacter - "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." + (self hasGlyphOf: aCharacter) ifFalse: [ - - | f assoc | - aCharacter charCode > 255 ifTrue: [ fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter]. ^ 1 ]. + ^(self formOf: aCharacter) width! - assoc _ self cache at: (aCharacter charCode + 1). - assoc ifNotNil: [ - ^ assoc value width - ]. - - f _ self computeForm: aCharacter. - self at: aCharacter charCode put: f. - ^ f width. - ! Item was changed: ----- Method: TTCFont class>>newTextStyleFromTTStream: (in category 'instance creation') ----- newTextStyleFromTTStream: readStream " " | description | + description := TTFontDescription addFromTTStream: readStream. - description _ TTFontDescription addFromTTStream: readStream. ^ self newTextStyleFromTT: description. ! Item was changed: ----- Method: TTCFont>>glyphInfoOf:into: (in category 'private') ----- glyphInfoOf: aCharacter into: glyphInfoArray "Answer the width of the argument as a character in the receiver." | form | (self hasGlyphOf: aCharacter) ifFalse: [ ^ self fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray. ]. + form := self formOf: aCharacter. - form _ self formOf: aCharacter. glyphInfoArray at: 1 put: form; at: 2 put: 0; at: 3 put: form width; + at: 4 put: ascent "(self ascentOf: aCharacter)"; - at: 4 put: (self ascentOf: aCharacter); at: 5 put: self. ^ glyphInfoArray. ! Item was changed: ----- Method: TTCFont>>addLined: (in category 'private') ----- addLined: aTTCFont | l | + l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 4. - l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 4. self derivativeFont: l at: l emphasis. + l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 16. - l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 16. self derivativeFont: l at: l emphasis. + l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 20. - l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 20. self derivativeFont: l at: l emphasis. ! Item was added: + ----- Method: TTCFont>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aStream + "put on the given stream the tag to close the html + representation of the receiver" + self htmlSize isZero + ifFalse: [aStream nextPutAll: '</font>']! Item was changed: ----- Method: TTCFont class>>initialize (in category 'class initialization') ----- initialize " self initialize " | tt | + self allSubInstancesDo:[:fnt| fnt flushCache]. GlyphCacheSize := 512. GlyphCacheData := Array new: GlyphCacheSize. GlyphCacheIndex := 0. + GlyphCacheReady := true. + tt := TTFontDescription default. - tt _ TTFontDescription default. tt ifNotNil: [self newTextStyleFromTT: tt]. + (FileList respondsTo: #registerFileReader:) ifTrue: [ + FileList registerFileReader: self + ]. + Smalltalk addToShutDownList: self.! Item was changed: ----- Method: TTCFont>>height (in category 'accessing') ----- height "Answer my height in pixels. This will answer a Float." + ^height ifNil:[height := self pixelSize * Scale y]! - ^ self pixelSize * Scale y! Item was changed: ----- Method: TTCFont>>objectForDataStream: (in category 'objects from disk') ----- objectForDataStream: refStrm | dp | "I am about to be written on an object file. Write a reference to a known FontSet in the other system instead." "a path to me" + dp := DiskProxy global: #TTCFont selector: #familyName:pointSize:emphasis: - dp _ DiskProxy global: #TTCFont selector: #familyName:pointSize:emphasis: args: {self familyName. self pointSize. self emphasis}. refStrm replace: self with: dp. ^ dp. ! Item was changed: ----- Method: TTCFont>>derivativeFont: (in category 'friend') ----- derivativeFont: aTTCFont | index | + index := self indexOfSubfamilyName: (aTTCFont subfamilyName). - index _ TTCFont indexOfSubfamilyName: (aTTCFont subfamilyName). index < 1 ifTrue: [ ^ self "inform: 'unknown sub family name. This font will be skipped'". ]. self derivativeFont: aTTCFont at: index. self addLined: aTTCFont. ! Item was changed: AbstractFont subclass: #TTCFont + instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent maxAscii colorToCacheMap' + classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheReady GlyphCacheSize NamesToIndexes Registry Scale ShutdownList' - instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont ascent descent' - classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheSize NamesToIndexes Registry Scale' poolDictionaries: '' category: 'Multilingual-Display'! !TTCFont commentStamp: 'nk 4/2/2004 11:32' prior: 0! I represent a font that uses TrueType derived glyph. Upon a request for glyph for a character through a call to #formOf: (or #widthOf:), I first search corresponding glyph in the cache. If there is not, it creates a 32bit depth form with the glyph. The cache is weakly held. The entries are zapped at full GC. Structure: ttcDescription TTFontDescription -- The Squeak data structure for a TrueType font data file. pointSize Number -- Nominal Em size in points. Conversion to pixel sizes depends on the definition of TextStyle class>>pixelsPerInch. foregroundColor Color -- So far, this font need to know the glyph color in cache. cache WeakArray of <Color -> <Array(256) of glyph>> derivatives Array -- stores the fonts in the same family but different emphasis. ! Item was changed: ----- Method: TTCFont>>displayString:on:from:to:at:kern:baselineY: (in category 'friend') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY + | form glyphInfo destX destY hereX nextX actualFont | + destX := aPoint x. + glyphInfo := Array new: 5. - | destPoint form glyphInfo destY destX w | - destPoint _ aPoint. - destX _ aPoint x. - glyphInfo _ Array new: 5. startIndex to: stopIndex do: [:charIndex | self glyphInfoOf: (aString at: charIndex) into: glyphInfo. + form := glyphInfo at: 1. + hereX := glyphInfo at: 2. + nextX := glyphInfo at: 3. + (actualFont := glyphInfo at: 5) == aBitBlt lastFont + ifFalse: [actualFont installOn: aBitBlt]. + destY := baselineY - (glyphInfo at: 4). - form _ glyphInfo at: 1. - ((glyphInfo at: 5) ~= aBitBlt lastFont) ifTrue: [ - (glyphInfo at: 5) installOn: aBitBlt. - ]. - destY _ baselineY - (glyphInfo at: 4). aBitBlt sourceForm: form. aBitBlt destX: destX. aBitBlt destY: destY. + aBitBlt sourceX: hereX; sourceY: 0. + aBitBlt width: nextX - hereX. - aBitBlt sourceOrigin: (glyphInfo at: 2) @ 0. - aBitBlt width: (w _ (glyphInfo at: 3) - (glyphInfo at: 2)). aBitBlt height: form height. aBitBlt copyBits. + destX := destX + (nextX - hereX) + kernDelta. - destX _ destX + w + kernDelta. ]. + ^ destX @ destY - ^ destX @ destPoint y. ! Item was added: + ----- Method: TTCFont>>foregroundColor: (in category 'initialize') ----- + foregroundColor: fgColor + "Install the given foreground color" + foregroundColor = fgColor ifFalse:[ + foregroundColor := fgColor. + colorToCacheMap ifNil:[colorToCacheMap := Dictionary new]. + cache := colorToCacheMap at: fgColor ifAbsentPut:[WeakArray new: self maxAscii+1]. + ShutdownList ifNotNil:[ShutdownList add: self]. + ]. + ! Item was changed: ----- Method: TTCFont class>>recreateCache (in category 'other') ----- recreateCache " self recreateCache. " + self allSubInstances do: [:inst | inst flushCache]. - self allSubInstances do: [:inst | inst recreateCache]. Smalltalk garbageCollect. ! Item was changed: ----- Method: TTCFont>>ascent (in category 'accessing') ----- ascent + ascent ifNil:[ascent := ttcDescription ascender * self pixelSize // (ttcDescription ascender - ttcDescription descender) * Scale y]. + ^ (fallbackFont notNil + and: [fallbackFont ascent > ascent]) - | a | - ^ ascent ifNil: [ - a := ttcDescription ascender * self pixelSize // (ttcDescription ascender - ttcDescription descender) * Scale y. - ascent := (fallbackFont notNil - and: [fallbackFont ascent > a]) ifTrue: [fallbackFont ascent] + ifFalse: [ascent]! - ifFalse: [a] - ]. - ! Item was changed: ----- Method: TTCFont>>descent (in category 'accessing') ----- descent "One is added to make sure the gap between lines is filled. If we don't add, multi line selection in a text pane look ugly." + ^descent ifNil:[descent := (ttcDescription descender * self pixelSize // (ttcDescription descender - ttcDescription ascender)) * Scale y + 1]. - ^ descent ifNil: [descent _ (ttcDescription descender * self pixelSize // (ttcDescription descender - ttcDescription ascender)) * Scale y + 1]. ! Item was added: + ----- Method: TTCFont>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aStream + "put on the given stream the tag to open the html + representation of the receiver" + | size | + size := self htmlSize. + size isZero + ifFalse: [aStream nextPutAll: '<font size="' , size asString , '">']! Item was changed: ----- Method: TTCFont class>>reorganizeForNewFontArray:name: (in category 'instance creation') ----- reorganizeForNewFontArray: array name: styleName | style existings regular altName | (TextConstants includesKey: styleName) ifFalse: [ TextConstants at: styleName put: (TextStyle fontArray: array). ^ TextConstants at: styleName. ]. "There is a text style with the name I want to use. See if it is a TTC font..." + style := TextConstants at: styleName. - style _ TextConstants at: styleName. style isTTCStyle ifFalse: [ + altName := ((array at: 1) name, 'TT') asSymbol. - altName _ ((array at: 1) name, 'TT') asSymbol. ^ self reorganizeForNewFontArray: array name: altName. ]. + existings := (self getExistings: style fontArray), (Array with: array). + regular := existings detect: [:e | (e at: 1) isRegular] ifNone: [existings at: 1]. + - existings _ (self getExistings: style fontArray) copyWith: array. - regular _ existings reversed detect: [:e | (e at: 1) isRegular] ifNone: [existings at: 1]. regular do: [:r | r addLined: r. ]. "The existing array may be different in size than the new one." existings do: [:e | (e at: 1) isRegular ifFalse: [ regular do: [ :r | | f | + f := e detect: [ :ea | ea pointSize = r pointSize ] ifNone: [ ]. - f _ e detect: [ :ea | ea pointSize = r pointSize ] ifNone: [ ]. f ifNotNil: [ r derivativeFont: f ]. ]. ]. ]. style newFontArray: regular. self register: regular at: styleName. self recreateCache. ^ style. ! Item was changed: ----- Method: TTCFont class>>serviceInstallTrueTypeFontStyle (in category 'file list services') ----- serviceInstallTrueTypeFontStyle "Return a service to install a true type font as a text style" ^ SimpleServiceEntry provider: self + label: 'install ttf style' - label: 'install ttf style' translatedNoop selector: #newTextStyleFromTTFile: + description: 'install a true type font as a text style' + buttonLabel: 'install ttf'! - description: 'install a true type font as a text style' translatedNoop - buttonLabel: 'install ttf' translatedNoop! Item was added: + ----- Method: TTCFont>>htmlSize (in category 'html') ----- + htmlSize + "private - answer the size in html form, assumes 12 as default size" + ^ (self pointSize - 12 / 3) rounded! Item was changed: ----- Method: TTCFont class>>family:size: (in category 'instance creation') ----- family: f size: s + ^ self allInstances detect: [:a | a familyName = f and: [a pointSize = s]] ifNone: [nil]. + ! - ^ self familyName: f size: s emphasized: 0! Item was changed: ----- Method: TTCFont>>fallbackFont: (in category 'accessing') ----- fallbackFont: aFontSetOrNil + aFontSetOrNil == self + ifTrue:[^ self error: 'Invalid fallback font']. + + fallbackFont := aFontSetOrNil. - fallbackFont _ aFontSetOrNil. ! Item was changed: ----- Method: TTCFont>>isRegular (in category 'testing') ----- isRegular "Answer true if I am a Regular/Roman font (i.e. not bold, etc.)" + ^ (self indexOfSubfamilyName: (self subfamilyName)) = 0. - ^ (TTCFont indexOfSubfamilyName: (self subfamilyName)) = 0. ! Item was changed: ----- Method: TTCFont class>>scale: (in category 'other') ----- scale: anObject + Scale := anObject. - Scale _ anObject. ! Item was changed: ----- Method: TTCFont>>hasGlyphOf: (in category 'private') ----- hasGlyphOf: aCharacter + "Answer whether this font includes a glyph for the given character" + ^ aCharacter charCode <= self maxAscii + and:[(self formOf: aCharacter) notNil]! - - ^ aCharacter charCode <= 255 - ! Item was changed: ----- Method: TTCFont class>>removeStyleName: (in category 'other') ----- removeStyleName: aString + TextConstants removeKey: aString asSymbol ifAbsent: []. - | style symName | - symName _ aString asSymbol. - style _ TextConstants removeKey: symName ifAbsent: []. - style ifNotNil: [self unregister: symName]. TTFontDescription removeDescriptionNamed: aString asString. ! Item was changed: ----- Method: TTCFont>>derivativeFont:at: (in category 'friend') ----- derivativeFont: aTTCFont at: index | newDeriv | + aTTCFont ifNil: [derivatives := nil. ^ self]. + derivatives ifNil: [derivatives := Array new: 32]. - aTTCFont ifNil: [derivatives _ nil. ^ self]. - derivatives ifNil: [derivatives _ Array new: 32]. derivatives size < 32 ifTrue: [ + newDeriv := Array new: 32. - newDeriv _ Array new: 32. newDeriv replaceFrom: 1 to: derivatives size with: derivatives. + derivatives := newDeriv. - derivatives _ newDeriv. ]. derivatives at: index put: aTTCFont. ! Item was changed: ----- Method: TTCFont>>initialize (in category 'friend') ----- initialize + foregroundColor := Color black. - foregroundColor _ Color black. ! Item was changed: ----- Method: TTCFont>>flushCache (in category 'initialize') ----- flushCache + "Flush the cache of this font" + cache := foregroundColor := colorToCacheMap := nil.! - cache atAllPut: nil.! Item was changed: ----- Method: TTCFont>>cache (in category 'friend') ----- cache - cache size = 256 ifFalse:[self recreateCache]. "old weak-array caching" ^cache! Item was changed: ----- Method: TTCFont class>>repairBadSizes (in category 'other') ----- repairBadSizes "There was a bug that would cause the TTCFonts to generate incorrectly sized glyphs. By looking at the dimensions of cached forms, we can tell whether the incorrect height logic was used. If it was, change the point size of the font and its derivatives. Note that this is probably pointless to call after the new code has been loaded; it's here for documentation (it should be called from the CS preamble instead)." "TTCFont repairBadSizes" | description computedScale cached desiredScale newPointSize repaired | + repaired := OrderedCollection new. - repaired _ OrderedCollection new. TTCFont allInstancesDo: [ :font | cached := (font cache copyFrom: $A asciiValue + 1 to: $z asciiValue + 1) detect: [ :f | f notNil ] ifNone: []. cached := cached ifNil: [ font formOf: $A ] ifNotNil: [ cached value ]. + description := font ttcDescription. + desiredScale := cached height asFloat / (description ascender - description descender). + computedScale := font pixelSize asFloat / font ttcDescription unitsPerEm. - description _ font ttcDescription. - desiredScale _ cached height asFloat / (description ascender - description descender). - computedScale _ font pixelSize asFloat / font ttcDescription unitsPerEm. (((computedScale / desiredScale) - 1.0 * cached height) abs < 1.0) ifFalse: [ + newPointSize := (font pointSize * desiredScale / computedScale) rounded. - newPointSize _ (font pointSize * desiredScale / computedScale) rounded. font pointSize: newPointSize; flushCache. repaired add: font. font derivativeFonts do: [ :df | df ifNotNil: [ df pointSize: newPointSize; flushCache. repaired add: df. ]]. ]. ]. repaired isEmpty ifFalse: [ repaired asArray inspect ]. ! Item was changed: ----- Method: TTCFont>>at:put: (in category 'private') ----- at: char put: form | assoc | assoc := foregroundColor -> form. GlyphCacheData at: (GlyphCacheIndex := GlyphCacheIndex \\ GlyphCacheSize + 1) put: assoc. + cache at: (char asInteger + 1) put: assoc.! - self cache at: (char asInteger + 1) put: assoc.! Item was changed: ----- Method: TTCFont>>setupDefaultFallbackFont (in category 'emphasis') ----- setupDefaultFallbackFont + | fonts f | + fonts := TextStyle default fontArray. + f := fonts first. + 1 to: fonts size do: [:i | + self height > (fonts at: i) height ifTrue: [f := fonts at: i]. + ]. + (f == self) + ifFalse:[ self fallbackFont: f ]. + self reset. - self setupDefaultFallbackTextStyleTo: (StrikeFont defaultFallbackTextStyle). ! Item was changed: ----- Method: TTCFont>>formOf: (in category 'private') ----- formOf: char + | code form | + char charCode > self maxAscii - | f assoc code | - char charCode > 255 ifTrue: [^ self fallbackFont formOf: char]. + cache ifNil:[self foregroundColor: Color black]. "make sure we have a cache" - code _ char charCode. - assoc _ self cache at: (code + 1). - assoc ifNotNil: [ - (assoc key = foregroundColor) ifTrue: [ - ^ assoc value. - ]. - ]. + code := char charCode. + form := cache at: (code + 1). + form class == Association ifTrue:[^self computeForm: code]. "in midst of loading" + form ifNil:[ + form := self computeForm: code. + form ifNil:[^nil]. + cache at: code+1 put: form. + GlyphCacheData at: (GlyphCacheIndex := GlyphCacheIndex \\ GlyphCacheSize + 1) put: form. + ]. + ^form - f _ self computeForm: code. - self at: code put: f. - ^ f. !

1 0

Etoys: TrueType-Richo.2.mcz
by commits＠source.squeak.org 31 May '10

31 May '10

Ricardo Moran uploaded a new version of TrueType to project Etoys: http://source.squeak.org/etoys/TrueType-Richo.2.mcz ==================== Summary ==================== Name: TrueType-Richo.2 Author: Richo Time: 30 May 2010, 4:56:29 pm UUID: dfe1f839-7cb5-104c-87ba-e7f66149cc85 Ancestors: TrueType-bf.1 * Integrating true type font support by Andreas Raab. =============== Diff against TrueType-bf.1 =============== Item was added: + ----- Method: TTFileDescription>>withFileDo: (in category 'initialize') ----- + withFileDo: aBlock + "Open the font file for the duration of aBlock" + ^self class openFontFile: fileName do: aBlock.! Item was added: + ----- Method: TTFileDescription>>displayAll (in category 'private') ----- + displayAll + "Read all the glyphs and display them" + | glyph form scale points x y | + points := 24. + scale := points asFloat / unitsPerEm. + x := y := 0. + Display deferUpdates: true. + 1 to: numGlyphs do:[:i| + glyph := self readGlyphAt: i-1. + form := glyph asFormWithScale: scale + ascender: ascender + descender: descender. + Display fillWhite: (x@y extent: form extent). + form displayOn: Display at: x@y rule: 34. + Display forceToScreen: (x@y extent: form extent). + x := x + form width. + x > Display width ifTrue:[y := y + form height. x := 0]. + y > Display height ifTrue:[y := 0]. + Sensor anyButtonPressed ifTrue:[^Display restore]. + ].! Item was added: + ----- Method: TTFileDescription>>descender (in category 'accessing') ----- + descender + "Descender of the font. Relative to unitsPerEm." + ^descender! Item was added: + ----- Method: TTFileDescription>>processSimpleGlyph:contours:from: (in category 'glyphs') ----- + processSimpleGlyph: glyph contours: nContours from: fontFile + "Construct a simple glyph frm the font file" + | endPts nPts iLength flags | + endPts := Array new: nContours. + 1 to: nContours do:[:i| endPts at: i put: (fontFile nextNumber: 2)]. + glyph initializeContours: nContours with: endPts. + nContours = 0 ifTrue:[^self]. + nPts := endPts last + 1. + iLength := fontFile nextNumber: 2. "instruction length" + fontFile skip: iLength. + flags := self getGlyphFlagsFrom: fontFile size: nPts. + self readGlyphXCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts. + self readGlyphYCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts.! Item was added: + ----- Method: TTFileDescription>>name (in category 'accessing') ----- + name + "For compatibility with TTFontDescription" + ^familyName! Item was added: + ----- Method: TTFileDescription class>>fontFromUser: (in category 'user interaction') ----- + fontFromUser: priorFont + ^self fontFromUser: priorFont allowKeyboard: true! Item was added: + ----- Method: TTFileDescription>>ascender (in category 'accessing') ----- + ascender + "Ascender of the font. Relative to unitsPerEm." + ^ascender! Item was added: + ----- Method: TTFileDescription class>>loadAllFontFiles (in category 'examples') ----- + loadAllFontFiles + "Load all the TTF files we can find in all font paths" + " + TTFileDescription loadAllFontFiles. + " + self fontPathsDo:[:path| | fd | + fd := FileDirectory on: path. + (fd fileNamesMatching: '*.ttf;*.ttc') do:[:fn| + (self readFontsFrom: fn) do:[:font| + (1 to: font numGlyphs) + do:[:i| font readGlyphAt: i-1] + displayingProgress: 'Reading ', font name]. + ] displayingProgress: 'Scanning ', path. + ].! Item was added: + ----- Method: TTFileDescription class>>installFamilyNamed: (in category 'instance creation') ----- + installFamilyNamed: familyName + "Install all the corresponding fonts for this family" + " + TTFileDescription installFamilyNamed: 'Arial'. + TTFileDescription installFamilyNamed: 'Batang'. + " + | fontFiles ttDesc | + fontFiles := self allFontsAndFiles at: familyName ifAbsent:[#()]. + fontFiles do:[:fileName| + ttDesc := (self readFontsFrom: fileName) detect:[:fnt| fnt familyName = familyName]. + TTCFont newTextStyleFromTT: ttDesc. + ]. + ^TextStyle named: familyName! Item was added: + ----- Method: TTGlyph>>buildAllContours (in category 'private-initialization') ----- + buildAllContours + "Build the contours in all non-composite glyphs." + ^self buildContours! Item was added: + ----- Method: TTFileDescription>>processNamingTable: (in category 'ttf tables') ----- + processNamingTable: fontFile + "copyright CHARPTR The font's copyright notice. + familyName CHARPTR The font's family name. + subfamilyName CHARPTR The font's subfamily name. + uniqueName CHARPTR A unique identifier for this font. + fullName CHARPTR The font's full name (a combination of + familyName and subfamilyName). + versionName CHARPTR The font's version string. + " + | nRecords initialOffset storageOffset pID sID nID length offset string | + initialOffset := fontFile position. + fontFile skip: 2. "Skip format selector" + "Get the number of name records" + nRecords := fontFile nextNumber: 2. + "Offset from the beginning of this table" + storageOffset := (fontFile nextNumber: 2) + initialOffset. + 1 to: nRecords do:[:i| + fontFile position: initialOffset + 6 + ((i-1) * 12). + pID := fontFile nextNumber: 2. + sID := fontFile nextNumber: 2. + "lID := "fontFile nextNumber: 2. + nID := fontFile nextNumber: 2. + length := fontFile nextNumber: 2. + offset := fontFile nextNumber: 2. + "Read only Macintosh or Microsoft strings" + (pID = 1 or:[pID = 3 and:[sID = 1]]) ifTrue:[ + "MS uses Unicode all others single byte" + "multiBytes := pID = 3." + fontFile position: storageOffset+offset. + string := (fontFile next: length) asString. + pID = 3 ifTrue:[ | keep | + keep := true. + string := string select:[:ch| keep := keep not]. + ]. + nID caseOf: { + "[0] -> [copyright := string]." + [1] -> [(pID = 1 or:[familyName == nil]) ifTrue:[familyName := string]]. + [2] -> [(pID = 1 or:[subfamilyName == nil]) ifTrue:[subfamilyName := string]]. + "[3] -> [(pID = 1 or:[uniqueName == nil]) ifTrue:[uniqueName := string]]." + "[4] -> [(pID = 1 or:[fullName == nil]) ifTrue:[fullName := string]]." + "[5] -> [(pID = 1 or:[versionName == nil]) ifTrue:[versionName := string]]." + "[6] -> [(pID = 1 or:[postscriptName == nil]) ifTrue:[postscriptName := string]]." + "[7] -> [(pID = 1 or:[trademark == nil]) ifTrue:[trademark := string]]." + } otherwise:["ignore"]. + ]. + ]. + ! Item was added: + Object subclass: #TTFileDescription + instanceVariableNames: 'fileName fileOffset familyName subfamilyName ascender descender lineGap unitsPerEm numGlyphs indexToLocOffset indexToLocFormat glyphTableOffset cmapType cmapOffset numHMetrics hmtxTableOffset' + classVariableNames: 'AllFontsAndFiles FontPaths OfferNonPortableFonts' + poolDictionaries: '' + category: 'TrueType-Fonts'! + + !TTFileDescription commentStamp: 'ar 7/29/2009 22:18' prior: 0! + Contrary to TTFontDescritption, this class leaves true type files on disk and only reads the required portions when constructing glyphs. This avoids the need of reading the entire font into memory at the cost of having to hit disk whenever a glyph is requested.! Item was added: + ----- Method: TTFileDescription class>>allFamilyNamesAndFiles (in category 'font paths') ----- + allFamilyNamesAndFiles + "Answer a dictionary of all known family names and their corresponding file names." + | names | + AllFontsAndFiles ifNil:[ + AllFontsAndFiles := Dictionary new. + Cursor wait showWhile:[self allFontsDo:[:font| + names := AllFontsAndFiles at: font familyName + ifAbsentPut:[OrderedCollection new]. + names add: font fileName]]]. + ^AllFontsAndFiles ! Item was added: + ----- Method: TTFileDescription>>subfamilyName (in category 'accessing') ----- + subfamilyName + "The subfamily name for the font" + ^subfamilyName! Item was added: + ----- Method: TTFileDescription>>on: (in category 'initialize') ----- + on: aFileName + "Initialize the receiver from a file name" + fileName := aFileName. + self withFileDo:[:fontFile| + (self findTable: 'head' in: fontFile) + ifFalse:[^self error: 'File does not have a header table']. + self processFontHeaderTable: fontFile. + (self findTable: 'maxp' in: fontFile) + ifFalse:[^self error: 'File does not have a profile table']. + self processMaximumProfileTable: fontFile. + (self findTable: 'name' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + self processNamingTable: fontFile. + (self findTable: 'hhea' in: fontFile) + ifFalse:[^self error: 'File does not have a horizontal header table']. + self processHorizontalHeaderTable: fontFile. + (self findTable: 'hmtx' in: fontFile) + ifFalse:[^self error: 'File does not have a horizontal header table']. + hmtxTableOffset := fontFile position. + (self findTable: 'loca' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + indexToLocOffset := fontFile position. + (self findTable: 'glyf' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + glyphTableOffset := fontFile position. + (self findTable: 'cmap' in: fontFile) + ifFalse:[^self error: 'File does not have a header table']. + self processCharacterMappingTable: fontFile. + ].! Item was added: + ----- Method: TTFileDescription>>profileAll (in category 'private') ----- + profileAll + "Profile reading all the glyphs" + MessageTally spyOn:[ + 1 to: numGlyphs do:[:glyphIndex| self readGlyphAt: glyphIndex-1]. + ].! Item was added: + ----- Method: TTFileDescription>>updateGlyphMetrics:fromFile: (in category 'glyphs') ----- + updateGlyphMetrics: glyph fromFile: fontFile + "Update the horizontal metrics for the given glyph" + | glyphIndex | + glyphIndex := glyph glyphIndex. + glyphIndex <= numHMetrics ifTrue:[ + fontFile position: hmtxTableOffset + (glyphIndex*4). + glyph advanceWidth: (fontFile nextNumber: 2). + glyph leftSideBearing: (self short: (fontFile nextNumber: 2)). + ] ifFalse:[ + fontFile position: hmtxTableOffset + ((numHMetrics-1) *4). + glyph advanceWidth: (fontFile nextNumber: 2). + fontFile position: hmtxTableOffset + (numHMetrics * 4) + ((glyphIndex-numHMetrics)*2). + glyph leftSideBearing: (self short: (fontFile nextNumber: 2)). + ]. + glyph updateRightSideBearing.! Item was added: + ----- Method: TTFileDescription class>>fontFromUser:allowKeyboard: (in category 'user interaction') ----- + fontFromUser: priorFont allowKeyboard: aBoolean + "TTFileDescription fontFromUser" + | fontMenu active ptMenu label fontNames builder resultBlock result item style font widget | + builder := ToolBuilder default. + fontNames := self allFontsAndFiles keys asArray sort. + fontMenu := builder pluggableMenuSpec new. + fontMenu label: 'Non-portable fonts'. + resultBlock := [:value| result := value]. + fontNames do: [:fontName | + active := priorFont familyName sameAs: fontName. + ptMenu := builder pluggableMenuSpec new. + TTCFont pointSizes do: [:pt | + label := pt printString, ' pt'. + item := ptMenu add: label + target: resultBlock + selector: #value: + argumentList: {{fontName. pt}}. + item checked: (active and:[pt = priorFont pointSize]). + ]. + item := fontMenu add: fontName action: nil. + item subMenu: ptMenu. + item checked: active. + ]. + widget := builder open: fontMenu. + builder runModal: widget. + result ifNil:[^nil]. + style := (TextStyle named: result first) ifNil:[self installFamilyNamed: result first]. + style ifNil: [^ self]. + font := style fonts detect: [:any | any pointSize = result last] ifNone: [nil]. + ^ font + ! Item was added: + ----- Method: TTFileDescription class>>shutDown (in category 'class initialization') ----- + shutDown + "Flush my caches" + FontPaths := Dictionary new. + AllFontsAndFiles := nil.! Item was added: + ----- Method: TTFileDescription>>getGlyphFlagsFrom:size: (in category 'glyphs') ----- + getGlyphFlagsFrom: fontFile size: nPts + "Read in the flags for this glyph. The outer loop gathers the flags that + are actually contained in the table. If the repeat bit is set in a flag + then the next byte is read from the table; this is the number of times + to repeat the last flag. The inner loop does this, incrementing the + outer loops index each time." + | flags index repCount flagBits | + flags := ByteArray new: nPts. + index := 1. + [index <= nPts] whileTrue:[ + flagBits := fontFile next. + flags at: index put: flagBits. + (flagBits bitAnd: 8) = 8 ifTrue:[ + repCount := fontFile next. + repCount timesRepeat:[ + index := index + 1. + flags at: index put: flagBits]]. + index := index + 1]. + ^flags! Item was added: + ----- Method: TTCompositeGlyph>>buildAllContours (in category 'accessing') ----- + buildAllContours + "Build the contours in all non-composite glyphs." + glyphs do:[:assoc| assoc value buildAllContours].! Item was added: + ----- Method: TTFileDescription class>>offerNonPortableFonts (in category 'user interaction') ----- + offerNonPortableFonts + "Should native fonts be offered when displaying font menus?" + ^OfferNonPortableFonts ifNil:[true]! Item was added: + ----- Method: TTFileDescription>>lineGap (in category 'accessing') ----- + lineGap + "Ascender of the font. Relative to unitsPerEm." + ^lineGap! Item was added: + ----- Method: TTFileDescription>>fileName (in category 'accessing') ----- + fileName + "The name of the Truetype file" + ^fileName! Item was added: + ----- Method: TTFileDescription class>>allFontsDo: (in category 'font paths') ----- + allFontsDo: aBlock + "Evaluate aBlock with all the fonts we can find. Use sparingly." + self fontPathsDo:[:path| + self fontFilesIn: path do:[:font| + font familyName + ifNotNil:[aBlock value: font]]]! Item was added: + ----- Method: TTFileDescription>>readGlyphAt:fromFile: (in category 'glyphs') ----- + readGlyphAt: glyphIndex fromFile: fontFile + "Answer the glyph with the given glyph index" + | glyphOffset nextOffset glyphLength glyph nContours left top right bottom | + indexToLocFormat = 0 ifTrue:["Format0: offset/2 is stored" + fontFile position: indexToLocOffset+(glyphIndex * 2). + glyphOffset := (fontFile nextNumber: 2) * 2. + nextOffset := (fontFile nextNumber: 2) * 2. + ] ifFalse:["Format1: store actual offset" + fontFile position: indexToLocOffset+(glyphIndex * 4). + glyphOffset := fontFile nextNumber: 4. + nextOffset := fontFile nextNumber: 4. + ]. + glyphLength := nextOffset - glyphOffset. + glyphLength = 0 ifTrue:[^TTGlyph new glyphIndex: glyphIndex]. + + fontFile position: glyphTableOffset+glyphOffset. + nContours := self short: (fontFile nextNumber: 2). + left := self short: (fontFile nextNumber: 2). + top := self short: (fontFile nextNumber: 2). + right := self short: (fontFile nextNumber: 2). + bottom := self short: (fontFile nextNumber: 2). + nContours >= 0 ifTrue:[ + glyph := TTGlyph new glyphIndex: glyphIndex. + self processSimpleGlyph: glyph contours: nContours from: fontFile. + ] ifFalse:[ + glyph := TTCompositeGlyph new glyphIndex: glyphIndex. + self processCompositeGlyph: glyph contours: nContours from: fontFile. + ]. + glyph buildAllContours. + glyph bounds: (left@top corner: right@bottom). + ^glyph + ! Item was added: + ----- Method: TTFileDescription class>>findFontFile: (in category 'font paths') ----- + findFontFile: fontFileName + "Find the path containing the font with the given name. + If it can't be found, return nil." + | fd | + self fontPathsDo:[:path| + fd := FileDirectory on: path. + ([fd fileExists: fontFileName] on: Error do:[false]) + ifTrue:[^fd fullNameFor: fontFileName]. + ]. + ^nil! Item was added: + ----- Method: TTFileDescription class>>offerNonPortableFonts: (in category 'user interaction') ----- + offerNonPortableFonts: aBool + "Should native fonts be offered when displaying font menus?" + OfferNonPortableFonts := aBool.! Item was added: + ----- Method: TTFileDescription>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + aStream nextPutAll: '('; print: fileName; nextPutAll: ')'.! Item was added: + ----- Method: TTFileDescription>>on:offset: (in category 'initialize') ----- + on: aFileName offset: fontOffset + "Initialize the receiver from a file name" + fileName := aFileName. + fileOffset := fontOffset. + self withFileDo:[:fontFile| + (self findTable: 'head' in: fontFile) + ifFalse:[^self error: 'File does not have a header table']. + self processFontHeaderTable: fontFile. + (self findTable: 'maxp' in: fontFile) + ifFalse:[^self error: 'File does not have a profile table']. + self processMaximumProfileTable: fontFile. + (self findTable: 'name' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + self processNamingTable: fontFile. + (self findTable: 'hhea' in: fontFile) + ifFalse:[^self error: 'File does not have a horizontal header table']. + self processHorizontalHeaderTable: fontFile. + (self findTable: 'hmtx' in: fontFile) + ifFalse:[^self error: 'File does not have a horizontal header table']. + hmtxTableOffset := fontFile position. + (self findTable: 'loca' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + indexToLocOffset := fontFile position. + (self findTable: 'glyf' in: fontFile) + ifFalse:[^self error: 'File does not have a naming table']. + glyphTableOffset := fontFile position. + (self findTable: 'cmap' in: fontFile) + ifFalse:[^self error: 'File does not have a header table']. + self processCharacterMappingTable: fontFile. + ].! Item was added: + ----- Method: TTFileDescription class>>fontFromUser (in category 'user interaction') ----- + fontFromUser + "TTFileDescription fontFromUser" + ^self fontFromUser: TextStyle defaultFont! Item was added: + ----- Method: TTGlyph>>referenceVertexAt: (in category 'private-initialization') ----- + referenceVertexAt: index + "Only used while reading before constructing contours" + | count vertices | + count := 0. + contours do: [:construction | + vertices := construction points. + index - count > vertices size + ifTrue: [count := count + vertices size] + ifFalse: [^(vertices at: index - count) asPoint]]. + ^count! Item was added: + ----- Method: TTFileDescription>>glyphAt: (in category 'glyphs') ----- + glyphAt: charOrCode + "Answer the glyph with the given code point" + | codePoint glyphIndex glyph | + codePoint := charOrCode asCharacter charCode. + self withFileDo:[:fontFile| + glyphIndex := self readCmapTableAt: codePoint fromFile: fontFile. + glyph := self readGlyphAt: glyphIndex fromFile: fontFile. + self updateGlyphMetrics: glyph fromFile: fontFile. + ]. + ^glyph! Item was added: + ----- Method: TTFileDescription class>>fontFilesIn:do: (in category 'font paths') ----- + fontFilesIn: path do: aBlock + "TTFileDescription loadAllFilesIn: 'C:\Windows\Fonts'" + "Load all the TTF files we can find in the given path" + | fd | + fd := FileDirectory on: path. + (fd fileNamesMatching: '*.ttf;*.ttc') do:[:fn| + (self readFontsFrom: fn) do:[:font| aBlock value: font]].! Item was added: + ----- Method: TTFileDescription>>childGlyphAt:in:fromFile: (in category 'glyphs') ----- + childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile + "Get the glyph with the given glyph index. Look in cache first, then read from file. + Ensure file is positioned at point where it was when it came here." + ^glyphCache at: glyphIndex ifAbsentPut:[ | glyph filePos | + filePos := fontFile position. + glyph := self readGlyphAt: glyphIndex fromFile: fontFile. + fontFile position: filePos. + glyph].! Item was added: + ----- Method: TTFileDescription>>processHorizontalHeaderTable: (in category 'ttf tables') ----- + processHorizontalHeaderTable: fontFile + " + ascender SHORT Typographic ascent. + descender SHORT Typographic descent. + lineGap SHORT Typographic lineGap. + numberOfHMetrics USHORT Number hMetric entries in the HTMX + Table; may be smaller than the total + number of glyphs. + " + fontFile skip: 4. "Skip table version" + ascender := self short: (fontFile nextNumber: 2). + descender := self short: (fontFile nextNumber: 2). + lineGap := self short: (fontFile nextNumber: 2). + fontFile skip: 2. "Skip advanceWidthMax" + fontFile skip: 2. "Skip minLeftSideBearing" + fontFile skip: 2. "Skip minRightSideBearing" + fontFile skip: 2. "Skip xMaxExtent" + fontFile skip: 2. "Skip caretSlopeRise" + fontFile skip: 2. "Skip caretSlopeRun" + fontFile skip: 10. "Skip 5 reserved shorts" + fontFile skip: 2. "Skip metricDataFormat" + + numHMetrics := fontFile nextNumber: 2. + + ^numHMetrics! Item was added: + ----- Method: TTFileDescription>>processFontHeaderTable: (in category 'ttf tables') ----- + processFontHeaderTable: fontFile + "Value Data Type Description + unitsPerEm USHORT Granularity of the font's em square. + xMax USHORT Maximum X-coordinate for the entire font. + xMin USHORT Minimum X-coordinate for the entire font. + yMax USHORT Maximum Y-coordinate for the entire font. + yMin USHORT Minimum Y-coordinate for the entire font. + indexToLocFormat SHORT Used when processing the Index To Loc Table." + + fontFile skip: 4. "Skip table version number" + fontFile skip: 4. "Skip font revision number" + fontFile skip: 4. "Skip check sum adjustment" + fontFile skip: 4. "Skip magic number" + fontFile skip: 2. "Skip flags" + + unitsPerEm := fontFile nextNumber: 2. + + fontFile skip: 8. "Skip creation date" + fontFile skip: 8. "Skip modification date" + + "Skip min/max values of all glyphs" + fontFile skip: 2. + fontFile skip: 2. + fontFile skip: 2. + fontFile skip: 2. + + fontFile skip: 2. "Skip mac style" + fontFile skip: 2. "Skip lowest rec PPEM" + fontFile skip: 2. "Skip font direction hint" + + indexToLocFormat := fontFile nextNumber: 2. + ! Item was added: + ----- Method: TTFileDescription>>short: (in category 'private') ----- + short: aNumber + (aNumber bitAnd: 16r8000) = 0 + ifTrue: [^aNumber] + ifFalse: [^-1 - (aNumber bitXor: 16rFFFF)]! Item was added: + ----- Method: TTFileDescription>>processCompositeGlyph:contours:from: (in category 'glyphs') ----- + processCompositeGlyph: glyph contours: nContours from: fontFile + "Read a composite glyph from the font data. The glyph passed into this method contains some state variables that must be copied into the resulting composite glyph." + | flags glyphIndex hasInstr ofsX ofsY iLen a11 a12 a21 a22 m glyphCache | + glyphCache := Dictionary new. + a11 := a22 := 16r4000. "1.0 in F2Dot14" + a21 := a12 := 0. "0.0 in F2Dot14" + "Copy state" + hasInstr := false. + [ flags := fontFile nextNumber: 2. + glyphIndex := fontFile nextNumber: 2. + (flags bitAnd: 1) = 1 ifTrue:[ + ofsX := self short: (fontFile nextNumber: 2). + ofsY := self short: (fontFile nextNumber: 2). + ] ifFalse:[ + (ofsX := fontFile next) > 127 ifTrue:[ofsX := ofsX - 256]. + (ofsY := fontFile next) > 127 ifTrue:[ofsY := ofsY - 256]. + ]. + ((flags bitAnd: 2) = 2) ifFalse:[ + | i1 i2 p1 p2 | + (flags bitAnd: 1) = 1 ifTrue: [ + i1 := ofsX + 65536 \\ 65536. + i2 := ofsY + 65536 \\ 65536] + ifFalse: [ + i1 := ofsX + 256 \\ 256. + i2 := ofsY + 256 \\ 256]. + p1 := glyph referenceVertexAt: i1+1. + p2 := (self childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile) referenceVertexAt: i2+1. + ofsX := p1 x - p2 x. + ofsY := p1 y - p2 y. + ]. + (flags bitAnd: 8) = 8 ifTrue:[ + a11 := a22 := self short: (fontFile nextNumber: 2)]. + (flags bitAnd: 64) = 64 ifTrue:[ + a11 := self short: (fontFile nextNumber: 2). + a22 := self short: (fontFile nextNumber: 2). + ]. + (flags bitAnd: 128) = 128 ifTrue:[ + "2x2 transformation" + a11 := self short: (fontFile nextNumber: 2). + a21 := self short: (fontFile nextNumber: 2). + a12 := self short: (fontFile nextNumber: 2). + a22 := self short: (fontFile nextNumber: 2). + ]. + m := MatrixTransform2x3 new. + "Convert entries from F2Dot14 to float" + m a11: (a11 asFloat / 16r4000). + m a12: (a12 asFloat / 16r4000). + m a21: (a21 asFloat / 16r4000). + m a22: (a22 asFloat / 16r4000). + m a13: ofsX. + m a23: ofsY. + glyph addGlyph: (self childGlyphAt: glyphIndex in: glyphCache fromFile: fontFile) transformation: m. + hasInstr := hasInstr or:[ (flags bitAnd: 256) = 256]. + "Continue as long as the MORE:=COMPONENTS bit is set" + (flags bitAnd: 32) = 32] whileTrue. + hasInstr ifTrue:[ + iLen := fontFile nextNumber: 2. + fontFile skip: iLen].! Item was added: + ----- Method: TTFileDescription>>familyName (in category 'accessing') ----- + familyName + "The family name for the font" + ^familyName! Item was added: + ----- Method: TTFileDescription class>>openFontFile:do: (in category 'instance creation') ----- + openFontFile: fontFileName do: aBlock + "Open the font with the given font file name" + | fontFilePath file | + fontFilePath := FontPaths at: fontFileName + ifAbsentPut:[self findFontFile: fontFileName]. + fontFilePath ifNil:[^nil]. + [file := FileStream readOnlyFileNamed: fontFilePath] on: Error do:[:ex| + "We lost the font; someone might have moved it away" + fontFilePath removeKey: fontFileName ifAbsent:[]. + ^nil + ]. + ^[aBlock value: file binary] ensure:[file close].! Item was added: + ----- Method: TTFileDescription>>size (in category 'accessing') ----- + size + "Compatibility with TTFontDescription" + ^16rFFFF! Item was added: + ----- Method: TTFileDescription>>findTable:in: (in category 'ttf tables') ----- + findTable: tag in: fontFile + "Position the fontFile at the beginning of the table with the given tag. + Answer true if we found the table, false otherwise." + | maxTables chksum offset length table | + fontFile position: fileOffset. + fontFile skip: 4. "version" + maxTables := fontFile nextNumber: 2. + fontFile skip: 6. + 1 to: maxTables do:[:i| + table := (fontFile next: 4) asString. + chksum := fontFile nextNumber: 4. + offset := fontFile nextNumber: 4. + length := fontFile nextNumber: 4. + table = tag ifTrue:[ + fontFile position: offset. + ^true]. + ]. + chksum. length. "fake usage" + ^false! Item was added: + ----- Method: TTFileDescription class>>allFontsAndFiles (in category 'font paths') ----- + allFontsAndFiles + "Answer a dictionary of all known family names and their corresponding file names." + | names | + AllFontsAndFiles ifNil:[ + AllFontsAndFiles := Dictionary new. + Cursor wait showWhile:[self allFontsDo:[:font| + names := AllFontsAndFiles at: font familyName + ifAbsentPut:[OrderedCollection new]. + names add: font fileName]]]. + ^AllFontsAndFiles ! Item was added: + ----- Method: TTFileDescription>>readCmapTableAt:fromFile: (in category 'glyphs') ----- + readCmapTableAt: codePoint fromFile: fontFile + | cmapFmt length firstCode entryCount segCount segIndex startCode endCode idDelta idRangeOffset offset | + fontFile position: cmapOffset. + cmapFmt := fontFile nextNumber: 2. + length := fontFile nextNumber: 2. + fontFile skip: 2. "skip version" + + cmapFmt = 0 ifTrue:["byte encoded table" + codePoint > 255 ifTrue:[^0]. + length := length - 6. "should be always 256" + length <= 0 ifTrue: [^0]. "but sometimes, this table is empty" + fontFile skip: codePoint. "move to correct byte offset in table" + ^fontFile next]. + + cmapFmt = 4 ifTrue:[ "segment mapping to deltavalues" + codePoint > 16rFFFF ifTrue:[^0]. + segCount := (fontFile nextNumber: 2) // 2. + fontFile skip: 6. "skip searchRange, entrySelector, rangeShift" + segIndex := (0 to: segCount-1) + detect:[:i| (endCode := (fontFile nextNumber: 2)) >= codePoint]. + fontFile position: cmapOffset + 16 + (segCount*2) + (segIndex*2). + startCode := fontFile nextNumber: 2. + startCode <= codePoint ifFalse:[^0]. "not in segment range" + fontFile position: cmapOffset + 16 + (segCount*4) + (segIndex*2). + idDelta := fontFile nextNumber: 2. + fontFile position: cmapOffset + 16 + (segCount*6) + (segIndex*2). + idRangeOffset := fontFile nextNumber: 2. + idRangeOffset = 0 ifTrue:[^(idDelta + codePoint) bitAnd: 16rFFFF]. + offset := (fontFile position - 2) + idRangeOffset + ((codePoint - startCode) * 2). + fontFile position: offset. + ^fontFile nextNumber: 2. + ]. + + cmapFmt = 6 ifTrue:[ "trimmed table" + firstCode := fontFile nextNumber: 2. + entryCount := fontFile nextNumber: 2. + (codePoint between: firstCode and: firstCode+entryCount) ifFalse:[^0]. + fontFile skip: (codePoint-firstCode) * 2. + ^fontFile nextNumber: 2]. + + ^0! Item was added: + ----- Method: TTFileDescription class>>fontOffsetsInFile: (in category 'instance creation') ----- + fontOffsetsInFile: file + "Answer a collection of font offsets in the given file" + | tag version nFonts | + file position: 0. + tag := file next: 4. + tag caseOf:{ + [#(0 1 0 0) asByteArray] -> ["Version 1.0 TTF file" + ^Array with: 0 "only one font" + ]. + ['ttcf' asByteArray] -> ["TTC file" + version := file next: 4. + version = #(0 1 0 0) asByteArray ifFalse:[^self error: 'Unsupported TTC version']. + nFonts := file nextNumber: 4. + ^(1 to: nFonts) collect:[:i| file nextNumber: 4]. + ]. + } otherwise:[ + self error: 'This is not a valid Truetype file'. + ].! Item was added: + ----- Method: TTFileDescription class>>fontPathsDo: (in category 'font paths') ----- + fontPathsDo: aBlock + "Evaluate aBlock with all of the font paths that should be searched on the current platform" + + "Start with the current directory" + aBlock value: FileDirectory default pathName. + + "Then subdirectory 'fonts'" + aBlock value: (FileDirectory default directoryNamed: 'fonts') pathName. + + "Platform specific directories" + SmalltalkImage current platformName caseOf:{ + ['Win32'] -> [ + "Standard Windows fonts directory" + aBlock value: 'C:\Windows\Fonts'. + ]. + ['Mac OS'] -> [ + "Standard system fonts directory" + aBlock value: '/Library/Fonts'. + ]. + ['unix'] -> [ | base | + "Standard fonts are in /usr/share/fonts/*" + base := '/usr/share/fonts'. + (FileDirectory on: base) directoryNames + do:[:dn| aBlock value: base, '/', dn]. + ]. + } otherwise:[]. + ! Item was added: + ----- Method: TTFileDescription>>numGlyphs (in category 'accessing') ----- + numGlyphs + "The number of glyphs represented in this font" + ^numGlyphs! Item was added: + ----- Method: TTFileDescription class>>initialize (in category 'class initialization') ----- + initialize + "TTFileDescription initialize" + Smalltalk addToShutDownList: self. + FontPaths := Dictionary new. + AllFontsAndFiles := nil.! Item was added: + ----- Method: TTFileDescription>>readGlyphXCoords:glyph:nContours:flags:endPoints: (in category 'glyphs') ----- + readGlyphXCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts + "Read the x coordinates for the given glyph from the font file." + | startPoint endPoint flagBits xValue contour ttPoint | + startPoint := 1. + 1 to: nContours do:[:i| + contour := glyph contours at: i. + "Get the end point" + endPoint := (endPts at: i) + 1. + "Store number of points" + startPoint to: endPoint do:[:j| + ttPoint := contour points at: (j - startPoint + 1). + flagBits := flags at: j. + "If bit zero in the flag is set then this point is an on-curve + point, if not, then it is an off-curve point." + (flagBits bitAnd: 1) = 1 + ifTrue:[ ttPoint type: #OnCurve] + ifFalse:[ttPoint type: #OffCurve]. + "First we check to see if bit one is set. This would indicate that + the corresponding coordinate data in the table is 1 byte long. + If the bit is not set, then the coordinate data is 2 bytes long." + (flagBits bitAnd: 2) = 2 ifTrue:[ "one byte" + xValue := fontFile next. + xValue := (flagBits bitAnd: 16)=16 ifTrue:[xValue] ifFalse:[xValue negated]. + ttPoint x: xValue. + ] ifFalse:[ "two byte" + "If bit four is set, then this coordinate is the same as the + last one, so the relative offset (of zero) is stored. If bit + is not set, then read in two bytes and store it as a signed value." + (flagBits bitAnd: 16) = 16 ifTrue:[ ttPoint x: 0 ] + ifFalse:[ + xValue := self short: (fontFile nextNumber: 2). + ttPoint x: xValue]]]. + startPoint := endPoint + 1]! Item was added: + ----- Method: TTCompositeGlyph>>referenceVertexAt: (in category 'initialize') ----- + referenceVertexAt: index + "Only used while reading before constructing contours" + | i p | + i := index. + self glyphsAndTransformationsDo: [:glyph :transform | + p := glyph referenceVertexAt: i. + p isPoint + ifTrue: [^transform localPointToGlobal: p]. + i := i - p]. + self error: ['this should not happen']! Item was added: + ----- Method: TTFileDescription>>at: (in category 'accessing') ----- + at: charOrCode + "Compatibility with TTFontDescription" + ^self glyphAt: charOrCode! Item was changed: ----- Method: TTGlyph>>buildContours (in category 'private-initialization') ----- buildContours "Build the contours in the receiver glyph. The contour is constructed by converting the points form each contour into an absolute value and then compressing the contours into PointArrays." | tx ty points | + tx := ty := 0. + contours := contours collect:[:contour| + contour isCollection ifTrue:[^self]. "already built" + points := contour points. - tx _ ty _ 0. - contours _ contours collect:[:contour| - points _ contour points. points do:[:pt| + pt x: (tx := tx + pt x). + pt y: (ty := ty + pt y)]. - pt x: (tx _ tx + pt x). - pt y: (ty _ ty + pt y)]. contour asCompressedPoints].! Item was added: + ----- Method: TTFileDescription>>readGlyphYCoords:glyph:nContours:flags:endPoints: (in category 'glyphs') ----- + readGlyphYCoords: fontFile glyph: glyph nContours: nContours flags: flags endPoints: endPts + "Read the y coordinates for the given glyph from the font file." + | startPoint endPoint flagBits yValue contour ttPoint | + startPoint := 1. + 1 to: nContours do:[:i| + contour := glyph contours at: i. + "Get the end point" + endPoint := (endPts at: i) + 1. + "Store number of points" + startPoint to: endPoint do:[:j| + ttPoint := contour points at: (j - startPoint + 1). + flagBits := flags at: j. + "Check if this value one or two byte encoded" + (flagBits bitAnd: 4) = 4 ifTrue:[ "one byte" + yValue := fontFile next. + yValue := (flagBits bitAnd: 32)=32 ifTrue:[yValue] ifFalse:[yValue negated]. + ttPoint y: yValue. + ] ifFalse:[ "two byte" + (flagBits bitAnd: 32) = 32 ifTrue:[ ttPoint y: 0 ] + ifFalse:[ + yValue := self short: (fontFile nextNumber: 2). + ttPoint y: yValue]]]. + startPoint := endPoint + 1]! Item was added: + ----- Method: TTFileDescription class>>readFontsFrom: (in category 'instance creation') ----- + readFontsFrom: aFilename + "Reads and returns all the fonts in the given file" + " + TTFileDescription readFontsFrom: 'batang.ttc'. + " + ^self openFontFile: aFilename do:[:file| + (self fontOffsetsInFile: file) + collect:[:offset| self new on: aFilename offset: offset]]. + ! Item was added: + ----- Method: TTFileDescription>>processMaximumProfileTable: (in category 'ttf tables') ----- + processMaximumProfileTable: fontFile + " + numGlyphs USHORT The number of glyphs in the font. + " + fontFile skip: 4. "Skip Table version number" + numGlyphs := fontFile nextNumber: 2.! Item was added: + ----- Method: TTFileDescription>>processCharacterMappingTable: (in category 'ttf tables') ----- + processCharacterMappingTable: fontFile + "Read the font's character to glyph index mapping table." + | initialOffset nSubTables pID sID offset | + initialOffset := fontFile position. + fontFile skip: 2. "Skip table version" + nSubTables := fontFile nextNumber: 2. + 1 to: nSubTables do:[:i| + pID := fontFile nextNumber: 2. + sID := fontFile nextNumber: 2. + offset := fontFile nextNumber: 4. + "Check if this is either a Unicode (0), Macintosh (1), + or a Windows (3) encoded table" + (#(0 1 3) includes: pID) ifTrue:[ + cmapType := pID. + cmapOffset := initialOffset + offset. + cmapType = 0 ifTrue:[^self]. "found Unicode table; use it" + ]. + ].!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

etoys-dev May 2010