Packages February 2022

packages@lists.squeakfoundation.org

1 participants
200 discussions

The Trunk: TrueType-mt.68.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.68.mcz ==================== Summary ==================== Name: TrueType-mt.68 Author: mt Time: 6 February 2022, 1:35:03.086367 pm UUID: aab3d683-d9e0-cc4f-880a-54ea666530b2 Ancestors: TrueType-mt.67 Fixes regression from last commit. I forgot that there can be multiple cmap tables using different formats so that we might find one that we actually support. Sorry for the noise. =============== Diff against TrueType-mt.67 =============== Item was added: + ----- Method: TTCharacterMappingTable>>isValid (in category 'testing') ----- + isValid + + ^ characterMap notNil! Item was changed: ----- Method: TTCharacterMappingTable>>printOn: (in category 'printing') ----- printOn: stream stream nextPutAll: 'cmap( '; nextPutAll: self platformName; nextPutAll: ' ; '; nextPutAll: self encodingName. self isMacintosh ifTrue: [ stream nextPut: $<; nextPutAll: self macLanguageName; nextPut: $>]. stream nextPutAll: ' ; '; + nextPutAll: (self characterMap ifNil: ['n/a'] ifNotNil: [:m | m size asString]); - nextPutAll: self characterMap size asString; nextPutAll: ' )'.! Item was changed: ----- Method: TTFontReader>>decodeCmapFmtTable: (in category 'private') ----- decodeCmapFmtTable: entry "Decode cmap table. Currently supports formats 0, 4, and 6 https://docs.microsoft.com/en-us/typography/opentype/spec/cmap#format-0-byt…" | cmapFmt | ^ (cmapFmt := entry nextUShort) caseOf: { [0] -> [self decodeCmapFmtTable0: entry]. [4] -> [self decodeCmapFmtTable4: entry]. [6] -> [self decodeCmapFmtTable6: entry]. + } otherwise: [ + Transcript showln: '[TTFontReader] Unsupported encoding of cmap: ', cmapFmt. + {nil.nil}]! - } otherwise: [self error: 'Unsupported encoding of cmap: ', cmapFmt]! Item was changed: ----- Method: TTFontReader>>processData:offset: (in category 'public') ----- processData: fontData offset: anOffset + | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry os2Entry glyphOffset cmaps numHMetrics indexToLocFormat | - | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry os2Entry glyphOffset cmap numHMetrics indexToLocFormat | "Read the raw font byte data" fontDescription := TTFontDescription new. "Search the tables required to build the font" (headerEntry := self getTableDirEntry: 'head' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a header table']. (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a maximum profile table']. (nameEntry := self getTableDirEntry: 'name' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a name table']. (indexLocEntry := self getTableDirEntry: 'loca' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a relocation table']. (charMapEntry := self getTableDirEntry: 'cmap' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a character map table']. (glyphEntry := self getTableDirEntry: 'glyf' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a glyph table']. (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a horizontal header table']. (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData offset: anOffset) == nil ifTrue:[ ^self error:'This font does not have a horizontal metrics table']. (kerningEntry := self getTableDirEntry: 'kern' from: fontData offset: anOffset) == nil ifTrue:[ Transcript cr; show:'This font does not have a kerning table';endEntry]. (os2Entry := self getTableDirEntry: 'OS/2' from: fontData offset: anOffset) == nil ifTrue:[ Transcript cr; show: 'This font does not have a OS/2 table'; endEntry]. "Process the data" indexToLocFormat := self processFontHeaderTable: headerEntry. self processMaximumProfileTable: maxProfileEntry. self processNamingTable: nameEntry. glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. + cmaps := self processCharacterMappingTable: charMapEntry. + "cmaps explore." + cmaps := cmaps select: [:ea | ea isValid]. + cmaps ifEmpty:[^self error:'This font has no suitable character mappings']. - cmap := self processCharacterMappingTable: charMapEntry. - (cmap == nil or:[cmap value == nil]) - ifTrue:[^self error:'This font has no suitable character mappings']. self processGlyphDataTable: glyphEntry offsets: glyphOffset. numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. kerningEntry isNil ifTrue:[kernPairs := #()] ifFalse:[self processKerningTable: kerningEntry]. os2Entry ifNotNil: [self processOS2Table: os2Entry]. + charMap := self processCharMap: cmaps. + charMapENC := self processCharMapENC: cmaps. self flag: #leadingChar. - charMap := self processCharMap: cmap. - charMapENC := self processCharMapENC: cmap. self flag: #leadingChar. fontDescription setGlyphs: glyphs mapping: charMap. fontDescription setKernPairs: kernPairs. ^fontDescription!

1 0

The Trunk: TrueType-mt.67.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.67.mcz ==================== Summary ==================== Name: TrueType-mt.67 Author: mt Time: 6 February 2022, 1:19:37.698367 pm UUID: 8709386a-24e4-b348-b8b9-aeaf7febd1c8 Ancestors: TrueType-mt.66 Removes debug statement. Sorry for the noise. =============== Diff against TrueType-mt.66 =============== Item was changed: ----- Method: TTFontReader>>processCharMap: (in category 'processing - support') ----- processCharMap: mappingTables "Process the given character map. Prefer Unicode mappings" - mappingTables explore. - ^ mappingTables detect: [:ea | ea isUnicode] ifFound: [:table | table map: glyphs] ifNone: [mappingTables last map: glyphs]!

1 0

The Trunk: TrueType-mt.66.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.66.mcz ==================== Summary ==================== Name: TrueType-mt.66 Author: mt Time: 6 February 2022, 1:17:53.180367 pm UUID: 549ac535-cdc2-ef4b-9d1f-fa74a7a901cb Ancestors: TrueType-mt.65 Refactors character mapping during TTF/TTC parsing. Windows' symbol fonts work now correctly. Does not treat that duplication in TTFileDescription. =============== Diff against TrueType-mt.65 =============== Item was changed: ----- Method: TTCFont>>isSymbolFont (in category 'testing') ----- isSymbolFont + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap#encoding-rec…" + + ^ (self hasGlyphOf: $a) not or: [self hasGlyphForCode: 16rF020]! - - ^ (self hasGlyphOf: $a) not! Item was added: + Object subclass: #TTCharacterMappingTable + instanceVariableNames: 'version platformID encodingID characterMap macLanguageID' + classVariableNames: '' + poolDictionaries: '' + category: 'TrueType-Support'! Item was added: + ----- Method: TTCharacterMappingTable>>characterMap (in category 'accessing') ----- + characterMap + + ^ characterMap! Item was added: + ----- Method: TTCharacterMappingTable>>characterMap: (in category 'accessing') ----- + characterMap: anObject + + characterMap := anObject.! Item was added: + ----- Method: TTCharacterMappingTable>>encodingID (in category 'accessing') ----- + encodingID + + ^ encodingID! Item was added: + ----- Method: TTCharacterMappingTable>>encodingID: (in category 'accessing') ----- + encodingID: anObject + + encodingID := anObject.! Item was added: + ----- Method: TTCharacterMappingTable>>encodingName (in category 'accessing') ----- + encodingName + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap" + + ^ platformID caseOf: { + [0] -> [self encodingNameForUnicode]. + [1] -> [self encodingNameForMacintosh]. + [2] -> [self encodingNameForISO]. + [3] -> [self encodingNameForWindows]. + [4] -> ['OTF Windows NT compatibility mapping'] + } ! Item was added: + ----- Method: TTCharacterMappingTable>>encodingNameForISO (in category 'accessing') ----- + encodingNameForISO + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap" + + ^ #( + '7-bit ASCII' + 'ISO 10646' + 'ISO 8859-1' + ) at: encodingID + 1! Item was added: + ----- Method: TTCharacterMappingTable>>encodingNameForMacintosh (in category 'accessing') ----- + encodingNameForMacintosh + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap" + + ^ #('Roman' 'Japanese' 'Chinese (Traditional)' 'Korean' 'Arabic' 'Hebrew' 'Greek' 'Russian' 'RSymbol' 'Devanagari' 'Gurmukhi' 'Gujarati' 'Oriya' 'Bengali' 'Tamil' 'Telugu' 'Kannada' 'Malayalam' 'Sinhalese' 'Burmese' 'Khmer' 'Thai' 'Laotian' 'Georgian' 'Armenian' 'Chinese (Simplified)' 'Tibetan' 'Mongolian' 'Geez' 'Slavic' 'Vietnamese' 'Sindhi' 'Uninterpreted') at: encodingID + 1! Item was added: + ----- Method: TTCharacterMappingTable>>encodingNameForUnicode (in category 'accessing') ----- + encodingNameForUnicode + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap" + + ^ #( + 'Unicode 1.0 (deprecated)' + 'Unicode 1.1 (deprecated)' + 'ISO/IEC 10646 (deprecated)' + 'Unicode 2.0+ (BMP only)' "basic multilingual pane" + 'Unicode 2.0+ (full)' + 'Unicode Variation Sequences (subtable format 14)' + 'Unicode Full (subtable format 13)' + ) at: encodingID + 1 ifAbsent: [ 'unknown ', encodingID asString]! Item was added: + ----- Method: TTCharacterMappingTable>>encodingNameForWindows (in category 'accessing') ----- + encodingNameForWindows + "https://docs.microsoft.com/en-us/typography/opentype/spec/cmap" + + ^ #( + 'Symbol' + 'Unicode BMP' "basic multilingual pane" + 'ShiftJIS' + 'PRC' + 'Big5' + 'Wansung' + 'Johab' + 'Reserved' + 'Reserved' + 'Reserved' + 'Unicode Full' + ) at: encodingID + 1! Item was added: + ----- Method: TTCharacterMappingTable>>isMacintosh (in category 'testing') ----- + isMacintosh + + ^ platformID = 1! Item was added: + ----- Method: TTCharacterMappingTable>>isUnicode (in category 'testing') ----- + isUnicode + + ^ platformID = 0! Item was added: + ----- Method: TTCharacterMappingTable>>isWindows (in category 'testing') ----- + isWindows + + ^ platformID = 3! Item was added: + ----- Method: TTCharacterMappingTable>>macEncodingName (in category 'accessing') ----- + macEncodingName + + ^#('Roman' 'Japanese' 'Chinese (Traditional)' 'Korean' 'Arabic' 'Hebrew' 'Greek' 'Russian' 'RSymbol' 'Devanagari' 'Gurmukhi' 'Gujarati' 'Oriya' 'Bengali' 'Tamil' 'Telugu' 'Kannada' 'Malayalam' 'Sinhalese' 'Burmese' 'Khmer' 'Thai' 'Laotian' 'Georgian' 'Armenian' 'Chinese (Simplified)' 'Tibetan' 'Mongolian' 'Geez' 'Slavic' 'Vietnamese' 'Sindhi' 'Uninterpreted') at: encodingID + 1! Item was added: + ----- Method: TTCharacterMappingTable>>macLanguageID (in category 'accessing') ----- + macLanguageID + + ^ macLanguageID! Item was added: + ----- Method: TTCharacterMappingTable>>macLanguageID: (in category 'accessing') ----- + macLanguageID: anObject + + macLanguageID := anObject.! Item was added: + ----- Method: TTCharacterMappingTable>>macLanguageName (in category 'accessing') ----- + macLanguageName + + self + assert: [platformID = 1] + description: 'LanguageID is only defined for the macOS platform'. + + ^ #('English' 'French' 'German' 'Italian' 'Dutch' 'Swedish' 'Spanish' 'Danish' 'Portuguese' 'Norwegian' 'Hebrew' 'Japanese' 'Arabic' 'Finnish' 'Greek' 'Icelandic' 'Maltese' 'Turkish' 'Croatian' 'Chinese (Traditional)' 'Urdu' 'Hindi' 'Thai' 'Korean' 'Lithuanian' 'Polish' 'Hungarian' 'Estonian' 'Latvian' 'Sami' 'Faroese' 'Farsi/Persian' 'Russian' 'Chinese (Simplified)' 'Flemish' 'Irish Gaelic' 'Albanian' 'Romanian' 'Czech' 'Slovak' 'Slovenian' 'Yiddish' 'Serbian' 'Macedonian' 'Bulgarian' 'Ukrainian' 'Byelorussian' 'Uzbek' 'Kazakh' 'Azerbaijani (Cyrillic script)' 'Azerbaijani (Arabic script)' 'Armenian' 'Georgian' 'Moldavian' 'Kirghiz' 'Tajiki' 'Turkmen' 'Mongolian (Mongolian script)' 'Mongolian (Cyrillic script)' 'Pashto' 'Kurdish' 'Kashmiri' 'Sindhi' 'Tibetan' 'Nepali' 'Sanskrit' 'Marathi' 'Bengali' 'Assamese' 'Gujarati' 'Punjabi' 'Oriya' 'Malayalam' 'Kannada' 'Tamil' 'Telugu' 'Sinhalese' 'Burmese' 'Khmer' 'Lao' 'Vietnamese' 'Indonesian' 'Tagalog' 'Malay (Roman script)' 'Malay (Ara bic script)' 'Amharic' 'Tigrinya' 'Galla' 'Somali' 'Swahili' 'Kinyarwanda/Ruanda' 'Rundi' 'Nyanja/Chewa' 'Malagasy' 'Esperanto') + at: macLanguageID + 1 ifAbsent: [ + #('Welsh' 'Basque' 'Catalan' 'Latin' 'Quechua' 'Guarani' 'Aymara' 'Tatar' 'Uighur' 'Dzongkha' 'Javanese (Roman script)' 'Sundanese (Roman script)' 'Galician' 'Afrikaans' 'Breton' 'Inuktitut' 'Scottish Gaelic' 'Manx Gaelic' 'Irish Gaelic (with dot above)' 'Tongan' 'Greek (polytonic)' 'Greenlandic' 'Azerbaijani (Roman script)') + at: macLanguageID - 128 + 1]! Item was added: + ----- Method: TTCharacterMappingTable>>macToWin: (in category 'mapping') ----- + macToWin: index + ^ (index - 1) asCharacter macToSqueak asciiValue + 1! Item was added: + ----- Method: TTCharacterMappingTable>>map: (in category 'mapping') ----- + map: glyphs + + self isUnicode ifTrue: [^ self mapFromUnicode: glyphs]. + self isMacintosh ifTrue: [^ self mapFromMacintosh: glyphs]. + self isWindows ifTrue: [^ self mapFromWindows: glyphs]. + + "Fallback" + self notify: 'Platform is not supported: ', self platformName. + ^ Array new: 256 withAll: glyphs first! Item was added: + ----- Method: TTCharacterMappingTable>>mapFromMacintosh: (in category 'mapping') ----- + mapFromMacintosh: glyphs + + | charTable glyph | + self + assert: [#(0 "MacRoman") includes: encodingID] + description: 'Encoding not supported: ' self encodingName. + + self flag: #todo. "Support encodingID and macLanguageID." + + charTable := Array new: 256 withAll: glyphs first. "Initialize with default glyph" + 1 to: (characterMap size min: charTable size) do: + [:i | + glyph := glyphs at: (characterMap at: i) + 1. + charTable at: (self macToWin: i) put: glyph]. + ^ charTable! Item was added: + ----- Method: TTCharacterMappingTable>>mapFromUnicode: (in category 'mapping') ----- + mapFromUnicode: glyphs + + | charTable glyph | + self + assert: [encodingID >= 3] + description: 'Encoding not supported: ', self encodingName. + + charTable := SparseLargeTable new: characterMap size + chunkSize: 256 arrayClass: Array base: 1 + defaultValue: glyphs first. + 1 to: charTable size do: + [:i | + glyph := glyphs at: (characterMap at: i) + 1 ifAbsent: [glyphs first]. + charTable at: i put: glyph]. + + charTable zapDefaultOnlyEntries. + ^charTable! Item was added: + ----- Method: TTCharacterMappingTable>>mapFromWindows: (in category 'mapping') ----- + mapFromWindows: glyphs + + | charTable glyph | + self + assert: [#(0 1) includes: encodingID] + description: 'Encoding not supported: ', self encodingName. + + charTable := characterMap size > 256 + ifFalse: [Array new: 256 withAll: glyphs first] + ifTrue: [SparseLargeTable new: characterMap size + chunkSize: 256 arrayClass: Array base: 1 + defaultValue: glyphs first]. + + 1 to: (characterMap size min: charTable size) do: [:i | + | glyphIndex | + glyphIndex := characterMap at: i. + encodingID = 0 ifTrue: [ "symbol font" + glyphIndex := glyphIndex bitAnd: 16r00FF]. + glyph := glyphs at: glyphIndex + 1 ifAbsent: [glyphs first]. + charTable at: i put: glyph. + encodingID = 0 ifTrue: [ "symbol font" + (i-1 between: 16rF020 and: 16rF0FF) ifTrue: [ "copy into ascii range" + charTable at: (i-1 bitAnd: 16r00FF)+1 put: glyph]]]. + + ^ charTable! Item was added: + ----- Method: TTCharacterMappingTable>>platformID (in category 'accessing') ----- + platformID + + ^ platformID! Item was added: + ----- Method: TTCharacterMappingTable>>platformID: (in category 'accessing') ----- + platformID: anObject + + platformID := anObject.! Item was added: + ----- Method: TTCharacterMappingTable>>platformName (in category 'accessing') ----- + platformName + + ^ platformID caseOf: { + [0] -> [#Unicode]. + [1] -> [#Macintosh]. + [2] -> [#ISO "deprecated"]. + [3] -> [#Windows]. + [4] -> [#Custom] + }! Item was added: + ----- Method: TTCharacterMappingTable>>printOn: (in category 'printing') ----- + printOn: stream + + stream + nextPutAll: 'cmap( '; + nextPutAll: self platformName; + nextPutAll: ' ; '; + nextPutAll: self encodingName. + + self isMacintosh ifTrue: [ + stream + nextPut: $<; + nextPutAll: self macLanguageName; + nextPut: $>]. + + stream + nextPutAll: ' ; '; + nextPutAll: self characterMap size asString; + nextPutAll: ' )'.! Item was added: + ----- Method: TTCharacterMappingTable>>version (in category 'accessing') ----- + version + + ^ version! Item was added: + ----- Method: TTCharacterMappingTable>>version: (in category 'accessing') ----- + version: anObject + + version := anObject.! Item was added: + ----- Method: TTCharacterMappingTable>>winToMac: (in category 'mapping') ----- + winToMac: index + ^ (index - 1) asCharacter squeakToMac asciiValue + 1! Item was added: + ----- Method: TTFontReader>>decodeCmapFmtTable0: (in category 'private') ----- + decodeCmapFmtTable0: entry + "byte encoded table" + + | length language cmap | + length := entry nextUShort. + language := entry nextUShort. + + length := length - 6. "should be always 256" + length <= 0 ifTrue: [^ nil]. "but sometimes, this table is empty" + cmap := Array new: length. + entry nextBytes: length into: cmap startingAt: entry offset. + ^ {language. cmap}! Item was added: + ----- Method: TTFontReader>>decodeCmapFmtTable4: (in category 'private') ----- + decodeCmapFmtTable4: entry + "segment mapping to deltavalues" + + | length language entryCount segCount segments offset cmap | + length := entry nextUShort. + language := entry nextUShort. + + segCount := entry nextUShort // 2. + entry skip: 6. "skip searchRange, entrySelector, rangeShift" + segments := Array new: segCount. + segments := (1 to: segCount) collect: [:e | Array new: 4]. + 1 to: segCount do: [:i | (segments at: i) at: 2 put: entry nextUShort]. "endCount" + entry skip: 2. "skip reservedPad" + 1 to: segCount do: [:i | (segments at: i) at: 1 put: entry nextUShort]. "startCount" + 1 to: segCount do: [:i | (segments at: i) at: 3 put: entry nextShort]. "idDelta" + offset := entry offset. + 1 to: segCount do: [:i | (segments at: i) at: 4 put: entry nextUShort]. "idRangeOffset" + entryCount := segments inject: 0 into: [:max :seg | max max: seg second]. + cmap := Array new: entryCount+1 withAll: 0.. + segments withIndexDo: + [:seg :si | | code | + seg first to: seg second do: + [:i | + seg last > 0 ifTrue: + ["offset to glypthIdArray - this is really C-magic!!" + entry offset: i - seg first - 1 * 2 + seg last + si + si + offset. + code := entry nextUShort. + code > 0 ifTrue: [code := code + seg third]] + ifFalse: + ["simple offset" + code := i + seg third]. + cmap at: i + 1 put: code]]. + + ^ {language. cmap}! Item was added: + ----- Method: TTFontReader>>decodeCmapFmtTable6: (in category 'private') ----- + decodeCmapFmtTable6: entry + "trimmed table" + + | length language entryCount cmap firstCode | + length := entry nextUShort. + language := entry nextUShort. + + firstCode := entry nextUShort. + entryCount := entry nextUShort. + cmap := Array new: entryCount + firstCode withAll: 0. + entryCount timesRepeat: + [cmap at: (firstCode := firstCode + 1) put: entry nextUShort]. + + ^ {language. cmap}! Item was changed: ----- Method: TTFontReader>>decodeCmapFmtTable: (in category 'private') ----- decodeCmapFmtTable: entry + "Decode cmap table. Currently supports formats 0, 4, and 6 + https://docs.microsoft.com/en-us/typography/opentype/spec/cmap#format-0-byt…" + + | cmapFmt | + ^ (cmapFmt := entry nextUShort) + caseOf: { + [0] -> [self decodeCmapFmtTable0: entry]. + [4] -> [self decodeCmapFmtTable4: entry]. + [6] -> [self decodeCmapFmtTable6: entry]. + } otherwise: [self error: 'Unsupported encoding of cmap: ', cmapFmt]! - | cmapFmt length entryCount segCount segments offset cmap firstCode | - cmapFmt := entry nextUShort. - length := entry nextUShort. - entry skip: 2. "skip version" - - cmapFmt = 0 ifTrue: "byte encoded table" - [length := length - 6. "should be always 256" - length <= 0 ifTrue: [^ nil]. "but sometimes, this table is empty" - cmap := Array new: length. - entry nextBytes: length into: cmap startingAt: entry offset. - ^ cmap]. - - cmapFmt = 4 ifTrue: "segment mapping to deltavalues" - [segCount := entry nextUShort // 2. - entry skip: 6. "skip searchRange, entrySelector, rangeShift" - segments := Array new: segCount. - segments := (1 to: segCount) collect: [:e | Array new: 4]. - 1 to: segCount do: [:i | (segments at: i) at: 2 put: entry nextUShort]. "endCount" - entry skip: 2. "skip reservedPad" - 1 to: segCount do: [:i | (segments at: i) at: 1 put: entry nextUShort]. "startCount" - 1 to: segCount do: [:i | (segments at: i) at: 3 put: entry nextShort]. "idDelta" - offset := entry offset. - 1 to: segCount do: [:i | (segments at: i) at: 4 put: entry nextUShort]. "idRangeOffset" - entryCount := segments inject: 0 into: [:max :seg | max max: seg second]. - cmap := Array new: entryCount+1 withAll: 0.. - segments withIndexDo: - [:seg :si | | code | - seg first to: seg second do: - [:i | - seg last > 0 ifTrue: - ["offset to glypthIdArray - this is really C-magic!!" - entry offset: i - seg first - 1 * 2 + seg last + si + si + offset. - code := entry nextUShort. - code > 0 ifTrue: [code := code + seg third]] - ifFalse: - ["simple offset" - code := i + seg third]. - cmap at: i + 1 put: code]]. - ^ cmap]. - - cmapFmt = 6 ifTrue: "trimmed table" - [firstCode := entry nextUShort. - entryCount := entry nextUShort. - cmap := Array new: entryCount + firstCode withAll: 0. - entryCount timesRepeat: - [cmap at: (firstCode := firstCode + 1) put: entry nextUShort]. - ^ cmap]. - ^ nil! Item was removed: - ----- Method: TTFontReader>>macToWin: (in category 'private') ----- - macToWin: index - ^ (index - 1) asCharacter macToSqueak asciiValue + 1! Item was changed: ----- Method: TTFontReader>>processCharMap: (in category 'processing - support') ----- + processCharMap: mappingTables + "Process the given character map. Prefer Unicode mappings" - processCharMap: assoc - "Process the given character map" + mappingTables explore. - | charTable glyph cmap | - cmap := assoc value. + ^ mappingTables + detect: [:ea | ea isUnicode] + ifFound: [:table | table map: glyphs] + ifNone: [mappingTables last map: glyphs]! - assoc key = 0 ifTrue: "Unicode table" - [charTable := SparseLargeTable new: cmap size - chunkSize: 256 arrayClass: Array base: 1 - defaultValue: glyphs first. - 1 to: charTable size do: - [:i | - glyph := glyphs at: (cmap at: i) + 1 ifAbsent: [glyphs first]. - charTable at: i put: glyph]. - charTable zapDefaultOnlyEntries. - ^charTable]. - - charTable := Array new: 256 withAll: glyphs first. "Initialize with default glyph" - - assoc key = 1 ifTrue: "Mac encoded table" - [1 to: (cmap size min: charTable size) do: - [:i | - glyph := glyphs at: (cmap at: i) + 1. - charTable at: (self macToWin: i) put: glyph]]. - - assoc key = 3 ifTrue: "Win encoded table" - [1 to: (cmap size min: charTable size) do: - [:i | - glyph := glyphs at: (cmap at: i) + 1. - charTable at: i put: glyph]]. - - ^ charTable! Item was changed: ----- Method: TTFontReader>>processCharMapENC: (in category 'processing - support') ----- + processCharMapENC: mappingTables - processCharMapENC: assoc "Process the given character map" | glyph cmap encode0 encode1 char value null | + self flag: #deprecated. + cmap := mappingTables + detect: [:ea | ea isUnicode] + ifFound: [:table | table characterMap] + ifNone: [mappingTables last characterMap]. - cmap := assoc value. null := (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. null contours: #(). encode0 := Array new: 256 withAll: glyphs first. encode1 := Array new: 65536 withAll: glyphs first. 0 to: 255 do: [:i | char := Character value: i. glyph := glyphs at: (cmap at: char asUnicode + 1) + 1. encode0 at: i+1 put: glyph. ]. Character separators do: [:c | encode0 at: (c asciiValue + 1) put: null. ]. 0 to: 65536 - 1 do: [:i | value := cmap at: i+1. value = 65535 ifFalse: [ "???" | g | g := glyphs at: value+1 ifAbsent: [ null. ]. (g isKindOf: TTCompositeGlyph) ifFalse: [ encode1 at: i+1 put: g. ] ifTrue: [ g basicGlyphs: (((glyphs at: value+1) basicGlyphs) collect: [:t | t key->(glyphs at: (t value glyphIndex+1))]). encode1 at: i+1 put: g ]. ] ]. ^ {encode0. encode1}. ! Item was changed: ----- Method: TTFontReader>>processCharacterMappingTable: (in category 'processing - tables') ----- processCharacterMappingTable: entry "Read the font's character to glyph index mapping table. If an appropriate mapping can be found then return an association with the format identifier and the contents of the table" + | initialOffset nSubTables tables tableVersion | - | copy initialOffset nSubTables pID sID offset cmap assoc | initialOffset := entry offset. + tableVersion := entry nextUShort. - entry skip: 2. "Skip table version" nSubTables := entry nextUShort. + tables := OrderedCollection new. 1 to: nSubTables do:[:i| + | platformID encodingID offset copy cmap | + platformID := entry nextUShort. + encodingID := entry nextUShort. - pID := entry nextUShort. - sID := entry nextUShort. offset := entry nextULong. + "Go to the beginning of the table" + copy := entry copy. + copy offset: initialOffset + offset. + cmap := self decodeCmapFmtTable: copy. + tables add: (TTCharacterMappingTable new + version: tableVersion; + platformID: platformID; + encodingID: encodingID; + characterMap: cmap second; + macLanguageID: cmap first; + yourself)]. + ^ tables! - "Check if this is either a Macintosh encoded table - or a Windows encoded table" - (#(0 1 3) includes: pID) ifTrue: [ - (assoc notNil and: [assoc key = pID]) ifFalse: [ - "Go to the beginning of the table" - copy := entry copy. - copy offset: initialOffset + offset. - cmap := self decodeCmapFmtTable: copy. - (pID = 0 and: [cmap notNil]) "Prefer Unicode encoding over everything else" - ifTrue: [^ pID -> cmap]. - "(pID = 1 and: [cmap notNil])" "Prefer Macintosh encoding over everything else" - "ifTrue: [pID -> cmap]." - assoc := pID -> cmap. "Keep it in case we don't find a better table" - ]. - ]. - ]. - ^assoc! Item was removed: - ----- Method: TTFontReader>>winToMac: (in category 'private') ----- - winToMac: index - ^ (index - 1) asCharacter squeakToMac asciiValue + 1!

1 0

The Trunk: TrueType-mt.65.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.65.mcz ==================== Summary ==================== Name: TrueType-mt.65 Author: mt Time: 6 February 2022, 9:49:42.289117 am UUID: c10c4627-e035-e343-a04d-498ec187e7cd Ancestors: TrueType-mt.64 Adds protocol to inspect the unmapped glyph indexes in a TTFontDescription. Useful for debugging encoding issues, e.g., in TTFontReader>>#processCharMap:. =============== Diff against TrueType-mt.64 =============== Item was added: + ----- Method: TTFontDescription>>atGlyphIndex: (in category 'accessing') ----- + atGlyphIndex: anInteger + "Answers the glyph at its original index." + + ^ glyphs + at: anInteger + 1 + ifAbsent: []! Item was added: + ----- Method: TTFontDescription>>maxGlyphIndex (in category 'accessing') ----- + maxGlyphIndex + + ^ glyphs size - 1!

1 0

The Trunk: Morphic-mt.1873.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1873.mcz ==================== Summary ==================== Name: Morphic-mt.1873 Author: mt Time: 6 February 2022, 9:41:36.973117 am UUID: 24c5c327-234a-ce45-afa7-3362bc6cb38a Ancestors: Morphic-mt.1872 Complements TrueType-mt.64 =============== Diff against Morphic-mt.1872 =============== Item was changed: ----- Method: FontImporterTool>>browseImported (in category 'actions') ----- browseImported | filenames fonts ttcFonts | fonts := self currentSelection. filenames := fonts allFilenames. + ttcFonts := (filenames gather: [:ea | TTFontReader parseFileNamed: ea]) + collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]. - ttcFonts := filenames gather: [:ea | - (TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: ea)) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. ttcFonts do: [:ea | ea browseAllGlyphs].! Item was changed: ----- Method: FontImporterTool>>import (in category 'actions') ----- import | megaSize filenames fonts | fonts := self currentSelection. filenames := fonts allFilenames. megaSize := ((filenames inject: 0 into: [ :sum :fn | sum + (FileStream readOnlyFileNamed: fn do: [:file | file size])]) / (1024 * 1024)) asFloat. (UIManager default confirm: ( 'About to import {1}{2}.\\This is at least {3} MB of space required in the image.\ Please respect the copyright and embedding restrictions of the font.\ Proceed?' translated withCRs format: { self currentParent ifNotNil: [:p| p fontname, ' ', self currentSelection fontname] ifNil: [self currentSelection fontname]. filenames size > 1 ifTrue: [' ({1} font files)' translated format: {filenames size}] ifFalse: ['']. megaSize printShowingDecimalPlaces: 2})) ifTrue: [ filenames do: [:filename | | readFonts | + readFonts := TTFontDescription addFromTTFile: filename. - readFonts := TTCFontDescription addFromTTFile: filename. readFonts isCollection ifFalse: [TTCFont newTextStyleFromTT: readFonts] ifTrue: [self importFontFamily: readFonts]]]. self allFonts: nil. "force redraw" TTCFont registerAll.!

1 0

The Trunk: EToys-mt.461.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.461.mcz ==================== Summary ==================== Name: EToys-mt.461 Author: mt Time: 6 February 2022, 9:40:19.583117 am UUID: 9b4aed3d-4d91-4640-95e9-3249f1a08a87 Ancestors: EToys-mt.460 Complements TrueType-mt.64 =============== Diff against EToys-mt.460 =============== Item was removed: - ----- Method: TTFontDescription class>>addSetFromTTFile: (in category '*Etoys-Squeakland-instance creations') ----- - addSetFromTTFile: fileName - " - Execute the following only if you know what you are doing. - self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC' - " - - | tt | - (fileName asLowercase endsWith: 'ttf') ifTrue: [ - tt := TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). - ] ifFalse: [ - tt := TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). - ]. - - ^ self addToDescription: tt. - !

1 0

The Trunk: TrueType-mt.64.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.64.mcz ==================== Summary ==================== Name: TrueType-mt.64 Author: mt Time: 6 February 2022, 9:39:28.342117 am UUID: 22f7b06a-3cdf-f14d-8664-3c9c16bea06b Ancestors: TrueType-mt.63 Minor cleanup in TTFontReader and TTCFontReader. The resulting TTFontDescription will now have correctly the mapping in "glyphTable" and the original glyphs in "glyphs". Note that there is still a lot of parsing duplication in TTFileDescription. =============== Diff against TrueType-mt.63 =============== Item was removed: - ----- Method: TTCFontDescription class>>addFromTTFile: (in category 'instance creations') ----- - addFromTTFile: fileName - " - Execute the following only if you know what you are doing. - self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC' - " - - | tt | - (fileName asLowercase endsWith: 'ttf') ifTrue: [ - tt := TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). - ] ifFalse: [ - tt := TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). - ]. - - self addToDescription: tt. - ^ tt. - ! Item was removed: - ----- Method: TTCFontDescription class>>descriptionNamed:at: (in category 'accessing') ----- - descriptionNamed: descriptionName at: index - - | array | - (array := self descriptionNamed: descriptionName) ifNil: [^ nil]. - ^ array at: index. - ! Item was changed: TTFontReader subclass: #TTCFontReader instanceVariableNames: 'fonts' classVariableNames: 'EncodingTag' poolDictionaries: '' + category: 'TrueType-Support'! - category: 'TrueType-Fonts'! Item was removed: - ----- Method: TTCFontReader>>getTableDirEntry:from:offset: (in category 'private') ----- - getTableDirEntry: tagString from: fontData offset: offset - "Find the table named tagString in fontData and return a table directory entry for it." - - | nTables pos currentTag tag | - nTables := fontData shortAt: 5 + offset bigEndian: true. - tag := ByteArray new: 4. - 1 to: 4 do:[:i| tag byteAt: i put: (tagString at: i) asInteger]. - tag := tag longAt: 1 bigEndian: true. - pos := 13 + offset. - 1 to: nTables do:[:i| - currentTag := fontData longAt: pos bigEndian: true. - currentTag = tag ifTrue:[^TTFontTableDirEntry on: fontData at: pos]. - pos := pos+16]. - ^nil! Item was changed: + ----- Method: TTCFontReader>>parseTTCHeaderFrom: (in category 'processing') ----- - ----- Method: TTCFontReader>>parseTTCHeaderFrom: (in category 'private') ----- parseTTCHeaderFrom: fontData | pos nTables | nTables := fontData longAt: 9 bigEndian: true. fonts := Array new: nTables. pos := 13. 1 to: nTables do: [:i | fonts at: i put: (fontData longAt: pos bigEndian: true). pos := pos + 4. ]. ^ fonts ! Item was removed: - ----- Method: TTCFontReader>>processCharMap: (in category 'processing') ----- - processCharMap: assoc - "Process the given character map" - - | glyph cmap encode0 encode1 char value null | - cmap := assoc value. - null := (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. - null contours: #(). - - encode0 := Array new: 256 withAll: glyphs first. - encode1 := Array new: 65536 withAll: glyphs first. - - 0 to: 255 do: [:i | - char := Character value: i. - glyph := glyphs at: (cmap at: char asUnicode + 1) + 1. - encode0 at: i+1 put: glyph. - ]. - Character separators do: [:c | - encode0 at: (c asciiValue + 1) put: null. - ]. - 0 to: 65536 - 1 do: [:i | - value := cmap at: i+1. - value = 65535 ifFalse: [ "???" - | g | - g := glyphs at: value+1 ifAbsent: [ null. ]. - (g isKindOf: TTCompositeGlyph) ifFalse: [ - encode1 at: i+1 put: g. - ] ifTrue: [ - g basicGlyphs: (((glyphs at: value+1) basicGlyphs) collect: [:t | t key->(glyphs at: (t value glyphIndex+1))]). - encode1 at: i+1 put: g - ]. - ] - ]. - - ^ {encode0. encode1}. - ! Item was changed: ----- Method: TTCFontReader>>readFrom: (in category 'public') ----- readFrom: aStream - "Read the raw font byte data" | fontData | + fontData := aStream binary contents asByteArray. - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - fonts := self parseTTCHeaderFrom: fontData. + ^ fonts collect: [:offset | + fontDescription := TTFontDescription new. + self processData: fontData offset: offset "encoding: EncodingTag"]! - ^ fonts gather: [:offset | - fontDescription := TTCFontDescription new. - self readFrom: fontData fromOffset: offset at: EncodingTag]! Item was removed: - ----- Method: TTCFontReader>>readFrom:fromOffset:at: (in category 'private') ----- - readFrom: fontData fromOffset: offset at: encodingTag - - | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry os2Entry glyphOffset cmap numHMetrics indexToLocFormat fontDescription0 fontDescription1 array result | - - "Search the tables required to build the font" - (headerEntry := self getTableDirEntry: 'head' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a header table']. - (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a maximum profile table']. - (nameEntry := self getTableDirEntry: 'name' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a name table']. - (indexLocEntry := self getTableDirEntry: 'loca' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a relocation table']. - (charMapEntry := self getTableDirEntry: 'cmap' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a character map table']. - (glyphEntry := self getTableDirEntry: 'glyf' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a glyph table']. - (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal header table']. - (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal metrics table']. - (kerningEntry := self getTableDirEntry: 'kern' from: fontData offset: offset) == nil ifTrue:[ - Transcript cr; show:'This font does not have a kerning table';endEntry]. - (os2Entry := self getTableDirEntry: 'OS/2' from: fontData offset: offset) == nil ifTrue:[ - Transcript cr; show: 'This font does not have a OS/2 table'; endEntry]. - - - "Process the data" - indexToLocFormat := self processFontHeaderTable: headerEntry. - self processMaximumProfileTable: maxProfileEntry. - self processNamingTable: nameEntry. - glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. - cmap := self processCharacterMappingTable: charMapEntry. - (cmap == nil or:[cmap value == nil]) - ifTrue:[^self error:'This font has no suitable character mappings']. - self processGlyphDataTable: glyphEntry offsets: glyphOffset. - numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. - self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. - kerningEntry isNil - ifTrue:[kernPairs := #()] - ifFalse:[self processKerningTable: kerningEntry]. - os2Entry ifNotNil: [self processOS2Table: os2Entry]. - array := self processCharMap: cmap. - fontDescription0 := fontDescription shallowCopy. - fontDescription1 := fontDescription shallowCopy. - fontDescription0 setGlyphs: (array at: 1) mapping: (array at: 1).. - fontDescription1 setGlyphs: (array at: 2) mapping: (array at: 2).. - fontDescription0 setKernPairs: kernPairs. - fontDescription1 setKernPairs: kernPairs. - result := OrderedCollection new. - (encodingTag = nil or: [encodingTag = 0]) ifTrue: [^ Array with: fontDescription1]. - result add: fontDescription0. - encodingTag -1 timesRepeat: [result add: nil]. - result add: fontDescription1. - ^ result asArray. - - ! Item was removed: - ----- Method: TTCFontReader>>readTTFFrom: (in category 'reading') ----- - readTTFFrom: aStream - - "Read the raw font byte data" - | fontData | - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - fontDescription := TTCFontDescription new. - - ^ self readFrom: fontData fromOffset: 0 at: EncodingTag. - ! Item was changed: ----- Method: TTFontDescription class>>addFromTTFile: (in category 'instance creation') ----- addFromTTFile: fileName " self addFromTTFile: 'C:\WINDOWS\Fonts\ARIALN.TTF' " + + ^ self addToDescription: (self fromTTFile: fileName)! - ^self addFromTTStream: (FileStream readOnlyFileNamed: fileName). - ! Item was changed: ----- Method: TTFontDescription class>>addFromTTStream: (in category 'instance creation') ----- addFromTTStream: readStream " + self addFromTTStream: (FileStream readOnlyFileNamed: 'C:\WINDOWS\Fonts\ARIALN.TTF') - self addFromTTFile: 'C:\WINDOWS\Fonts\ARIALN.TTF' " + ^ self addToDescription: (self fromTTStream: readStream)! - | tt | - tt := TTFontReader readFrom: readStream. - tt := self addToDescription: tt. - tt blankGlyphForSeparators. - ^ tt. - ! Item was added: + ----- Method: TTFontDescription class>>addSetFromTTFile: (in category 'instance creation') ----- + addSetFromTTFile: fileName + + ^ self addFromTTFile: fileName! Item was changed: ----- Method: TTFontDescription class>>addSetFromTTFile:encodingTag:ranges: (in category 'instance creation') ----- addSetFromTTFile: fileName encodingTag: encodingTag ranges: ranges | tt | + tt := self addSetFromTTFile: fileName. - (fileName asLowercase endsWith: 'ttf') ifTrue: [ - tt := TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). - ] ifFalse: [ - tt := TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). - ]. - (tt at: encodingTag + 1) compactForRanges: ranges. + ^ tt! - ^ self addToDescription: tt. - ! Item was changed: + ----- Method: TTFontDescription class>>clearDefault (in category 'house keeping') ----- - ----- Method: TTFontDescription class>>clearDefault (in category 'instance creation') ----- clearDefault " self clearDefault " Default := nil. ! Item was changed: + ----- Method: TTFontDescription class>>clearDescriptions (in category 'house keeping') ----- - ----- Method: TTFontDescription class>>clearDescriptions (in category 'instance creation') ----- clearDescriptions " self clearDescriptions " Descriptions := Set new. Default ifNotNil: [Descriptions add: Default]. ! Item was changed: + ----- Method: TTFontDescription class>>default (in category 'defaults') ----- - ----- Method: TTFontDescription class>>default (in category 'instance creation') ----- default ^ Default! Item was changed: + ----- Method: TTFontDescription class>>descriptionFullNamed: (in category 'instance lookup') ----- - ----- Method: TTFontDescription class>>descriptionFullNamed: (in category 'instance creation') ----- descriptionFullNamed: descriptionFullName ^ Descriptions detect: [:f | f first fullName = descriptionFullName] ifNone: [Default]! Item was changed: + ----- Method: TTFontDescription class>>descriptionFullNamed:at: (in category 'instance lookup') ----- - ----- Method: TTFontDescription class>>descriptionFullNamed:at: (in category 'instance creation') ----- descriptionFullNamed: descriptionFullName at: index | ans | ans := Descriptions detect: [:f | f first fullName = descriptionFullName] ifNone: [Default]. index > 0 ifTrue: [^ ans at: index]. ^ ans. ! Item was changed: + ----- Method: TTFontDescription class>>descriptionNamed: (in category 'instance lookup') ----- - ----- Method: TTFontDescription class>>descriptionNamed: (in category 'instance creation') ----- descriptionNamed: descriptionName ^ Descriptions detect: [:f | f first name = descriptionName] ifNone: [Default]. ! Item was added: + ----- Method: TTFontDescription class>>descriptionNamed:at: (in category 'instance lookup') ----- + descriptionNamed: descriptionName at: index + + | array | + (array := self descriptionNamed: descriptionName) ifNil: [^ nil]. + ^ array at: index. + ! Item was removed: - ----- Method: TTFontDescription class>>foo (in category 'instance creation') ----- - foo! Item was added: + ----- Method: TTFontDescription class>>fromTTFile: (in category 'instance creation') ----- + fromTTFile: fileName + " + self fromTTFile: 'C:\WINDOWS\Fonts\ARIALN.TTF' + " + + | tt | + tt := TTFontReader parseFileNamed: fileName. + tt do: [:ea | ea blankGlyphForSeparators]. + ^ tt! Item was added: + ----- Method: TTFontDescription class>>fromTTStream: (in category 'instance creation') ----- + fromTTStream: readStream + " + self fromTTStream: (FileStream readOnlyFileNamed: 'C:\WINDOWS\Fonts\ARIALN.TTF') + " + + | tt | + tt := TTFontReader readFrom: readStream. + tt blankGlyphForSeparators. + ^ tt! Item was changed: + ----- Method: TTFontDescription class>>removeDescriptionNamed: (in category 'house keeping') ----- - ----- Method: TTFontDescription class>>removeDescriptionNamed: (in category 'instance creation') ----- removeDescriptionNamed: descriptionName | tt | Descriptions ifNil: [^ self]. [(tt := Descriptions detect: [:f | f first name = descriptionName] ifNone: [nil]) notNil] whileTrue:[ Descriptions remove: tt ]. ! Item was changed: + ----- Method: TTFontDescription class>>removeDescriptionNamed:subfamilyName: (in category 'house keeping') ----- - ----- Method: TTFontDescription class>>removeDescriptionNamed:subfamilyName: (in category 'instance creations') ----- removeDescriptionNamed: descriptionName subfamilyName: subfamilyName | tts | Descriptions ifNil: [^ self]. tts := Descriptions select: [:f | f first name = descriptionName and: [f first subfamilyName = subfamilyName]]. tts do: [:f | Descriptions remove: f]. ! Item was changed: + ----- Method: TTFontDescription class>>setDefault (in category 'house keeping') ----- - ----- Method: TTFontDescription class>>setDefault (in category 'instance creation') ----- setDefault Default := Descriptions detect: [:ea | ea isRegular] ifNone: [Descriptions anyOne].! Item was changed: + ----- Method: TTFontDescription>>ascender (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>ascender (in category 'properties') ----- ascender "Ascender of the font. Relative to unitsPerEm. Easily confused with the typographic ascender." ^ascender! Item was changed: + ----- Method: TTFontDescription>>bounds (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>bounds (in category 'properties') ----- bounds ^bounds! Item was changed: + ----- Method: TTFontDescription>>copyright (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>copyright (in category 'information') ----- copyright ^copyright! Item was changed: + ----- Method: TTFontDescription>>descender (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>descender (in category 'properties') ----- descender "Descender of the font. Relative to unitsPerEm. Easily confused with the typographic descender." ^descender! Item was changed: + ----- Method: TTFontDescription>>externalLeading (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>externalLeading (in category 'rendering') ----- externalLeading "https://freetype.org/freetype2/docs/glyphs/glyphs-3.html" ^ lineGap! Item was changed: + ----- Method: TTFontDescription>>extraGap (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>extraGap (in category 'accessing') ----- extraGap "Answer the extra lineGap for the receiver. In combination with #extraScale, this property can be used to balance the legibility of different fonts used side-by-side with the same #pointSize." ^ extraGap ifNil: [extraGap := self class extraGapFor: self]! Item was changed: + ----- Method: TTFontDescription>>extraGap: (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>extraGap: (in category 'accessing') ----- extraGap: anIntegerOrNil "Increase or decrease the receivers line gap" extraGap = anIntegerOrNil ifTrue: [^ self]. extraGap := anIntegerOrNil. TTCFont allSubInstancesDo: [:font | font ttcDescription == self ifTrue: [font reset "keep glyph cache"]]. TextStyle allInstancesDo: [:style | style reset].! Item was changed: + ----- Method: TTFontDescription>>extraScale (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>extraScale (in category 'accessing') ----- extraScale " TTCFont allSubInstancesDo: [:f | f ttcDescription extraScale: nil] " ^ extraScale ifNil: [extraScale := self class extraScaleFor: self]! Item was changed: + ----- Method: TTFontDescription>>extraScale: (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>extraScale: (in category 'accessing') ----- extraScale: aFloatOrNil "EXPERIMENTAL. Increase the glyph size without increasing the pixel size for a certain point size. Consequently, if the scale factor is too large, you may notice overlapping and clipping artifacts." extraScale = aFloatOrNil ifTrue: [^ self]. extraScale := aFloatOrNil. TTCFont allSubInstancesDo: [:font | font ttcDescription == self ifTrue: [font flushCache]].! Item was changed: + ----- Method: TTFontDescription>>familyName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>familyName (in category 'information') ----- familyName ^familyName! Item was changed: + ----- Method: TTFontDescription>>flipAroundY (in category 'initialization') ----- - ----- Method: TTFontDescription>>flipAroundY (in category 'private-initialization') ----- flipAroundY bounds := (bounds origin x @ bounds corner y negated) corner: (bounds corner x @ bounds origin y negated). glyphs do:[:glyph| glyph flipAroundY]! Item was changed: + ----- Method: TTFontDescription>>fontHeight (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>fontHeight (in category 'accessing') ----- fontHeight ^ascender - descender! Item was changed: + ----- Method: TTFontDescription>>fullName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>fullName (in category 'information') ----- fullName ^fullName! Item was changed: + ----- Method: TTFontDescription>>internalLeading (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>internalLeading (in category 'rendering') ----- internalLeading "https://freetype.org/freetype2/docs/glyphs/glyphs-3.html" ^ ascender - descender - unitsPerEm! Item was changed: + ----- Method: TTFontDescription>>lineGap (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>lineGap (in category 'properties') ----- lineGap "Leading of the font. Relative to unitsPerEm. Easily confused with the typographic linegap." ^lineGap! Item was changed: + ----- Method: TTFontDescription>>postscriptName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>postscriptName (in category 'information') ----- postscriptName ^postscriptName! Item was changed: + ----- Method: TTFontDescription>>setAscender:descender:lineGap: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setAscender:descender:lineGap: (in category 'private-initialization') ----- setAscender: asc descender: desc lineGap: lgap ascender := asc. descender := desc. lineGap := lgap! Item was changed: + ----- Method: TTFontDescription>>setBounds:unitsPerEm: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setBounds:unitsPerEm: (in category 'private-initialization') ----- setBounds: aRect unitsPerEm: aNumber bounds := aRect. unitsPerEm := aNumber.! Item was changed: + ----- Method: TTFontDescription>>setGlyphs:mapping: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setGlyphs:mapping: (in category 'private-initialization') ----- setGlyphs: glyphArray mapping: mappingTable glyphs := glyphArray. glyphTable := mappingTable.! Item was changed: + ----- Method: TTFontDescription>>setKernPairs: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setKernPairs: (in category 'private-initialization') ----- setKernPairs: array kernPairs := array! Item was changed: + ----- Method: TTFontDescription>>setStrings: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setStrings: (in category 'private-initialization') ----- setStrings: anArray copyright := anArray at: 1. familyName := anArray at: 2. subfamilyName := anArray at: 3. uniqueName := anArray at: 4. fullName := anArray at: 5. versionName := anArray at: 6. postscriptName := anArray at: 7. trademark := anArray at: 8. ! Item was changed: + ----- Method: TTFontDescription>>setTypographicAscender:descender:lineGap: (in category 'initialization') ----- - ----- Method: TTFontDescription>>setTypographicAscender:descender:lineGap: (in category 'private-initialization') ----- setTypographicAscender: asc descender: desc lineGap: lGap sTypoAscender := asc. sTypoDescender := desc. sTypoLineGap := lGap. ! Item was changed: + ----- Method: TTFontDescription>>subfamilyName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>subfamilyName (in category 'information') ----- subfamilyName ^subfamilyName! Item was changed: + ----- Method: TTFontDescription>>trademark (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>trademark (in category 'information') ----- trademark ^trademark! Item was changed: + ----- Method: TTFontDescription>>typographicAscender (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>typographicAscender (in category 'accessing') ----- typographicAscender "Microsoft defines this as the 'true typographic metrics' of the font." ^sTypoAscender ifNil:[ascender]! Item was changed: + ----- Method: TTFontDescription>>typographicDescender (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>typographicDescender (in category 'accessing') ----- typographicDescender "Microsoft defines this as the 'true typographic metrics' of the font." ^sTypoDescender ifNil:[descender]! Item was changed: + ----- Method: TTFontDescription>>typographicFontHeight (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>typographicFontHeight (in category 'accessing') ----- typographicFontHeight "cope for the fact that typographicAscender and typographicDescender may not be available and 0-height fonts are a bit useless" | tfh | tfh := self typographicAscender - self typographicDescender. ^ tfh = 0 ifTrue: [self fontHeight] ifFalse: [tfh]! Item was changed: + ----- Method: TTFontDescription>>typographicLineGap (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>typographicLineGap (in category 'accessing') ----- typographicLineGap "Microsoft defines this as the 'true typographic metrics' of the font." ^sTypoLineGap ifNil:[lineGap]! Item was changed: + ----- Method: TTFontDescription>>uniqueName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>uniqueName (in category 'information') ----- uniqueName ^uniqueName! Item was changed: + ----- Method: TTFontDescription>>unitsPerEm (in category 'accessing - metrics') ----- - ----- Method: TTFontDescription>>unitsPerEm (in category 'properties') ----- unitsPerEm ^unitsPerEm! Item was changed: + ----- Method: TTFontDescription>>versionName (in category 'accessing - information') ----- - ----- Method: TTFontDescription>>versionName (in category 'information') ----- versionName ^versionName! Item was changed: Object subclass: #TTFontReader + instanceVariableNames: 'charMap charMapENC glyphs nGlyphs kernPairs infoBar fontDescription' - instanceVariableNames: 'charMap glyphs nGlyphs kernPairs infoBar fontDescription' classVariableNames: '' poolDictionaries: '' category: 'TrueType-Support'! !TTFontReader commentStamp: '<historical>' prior: 0! TTFontReader constructs a TTFontDescription from a TrueType font (.ttf).! Item was changed: ----- Method: TTFontReader class>>parseFileNamed: (in category 'instance creation') ----- parseFileNamed: aString + " + TTFontReader parseFileNamed:'c:\windows\fonts\arial.ttf' + TTFontReader parseFileNamed:'c:\windows\times.ttf' + TTFontReader parseFileNamed: 'C:\WINDOWS\Fonts\msgothic.TTC' + " + + | result | + result := ((aString asLowercase endsWith: 'ttf') + ifTrue: [self] ifFalse: [TTCFontReader]) + readFrom: (FileStream readOnlyFileNamed: aString). + ^ result isCollection ifTrue: [result] ifFalse: [{result}]! - "TTFontReader parseFileNamed:'c:\windows\fonts\arial.ttf'" - "TTFontReader parseFileNamed:'c:\windows\times.ttf'" - | contents | - contents := (FileStream readOnlyFileNamed: aString) binary contentsOfEntireFile. - ^self readFrom: (ReadStream on: contents)! Item was removed: - ----- Method: TTFontReader class>>readTTFFrom: (in category 'instance creation') ----- - readTTFFrom: aStream - - ^self new readTTFFrom: aStream! Item was changed: ----- Method: TTFontReader>>getTableDirEntry:from: (in category 'private') ----- + getTableDirEntry: tagString from: dataStream + + ^ self getTableDirEntry: tagString from: dataStream offset: 0! - getTableDirEntry: tagString from: fontData - "Find the table named tagString in fontData and return a table directory entry for it." - | nTables pos currentTag tag | - nTables := fontData shortAt: 5 bigEndian: true. - tag := ByteArray new: 4. - 1 to: 4 do:[:i| tag byteAt: i put: (tagString at: i) asInteger]. - tag := tag longAt: 1 bigEndian: true. - pos := 13. - 1 to: nTables do:[:i| - currentTag := fontData longAt: pos bigEndian: true. - currentTag = tag ifTrue:[^TTFontTableDirEntry on: fontData at: pos]. - pos := pos+16]. - ^nil! Item was added: + ----- Method: TTFontReader>>getTableDirEntry:from:offset: (in category 'private') ----- + getTableDirEntry: tagString from: fontData offset: offset + "Find the table named tagString in fontData and return a table directory entry for it." + + | nTables pos currentTag tag | + nTables := fontData shortAt: 5 + offset bigEndian: true. + tag := ByteArray new: 4. + 1 to: 4 do:[:i| tag byteAt: i put: (tagString at: i) asInteger]. + tag := tag longAt: 1 bigEndian: true. + pos := 13 + offset. + 1 to: nTables do:[:i| + currentTag := fontData longAt: pos bigEndian: true. + currentTag = tag ifTrue:[^TTFontTableDirEntry on: fontData at: pos]. + pos := pos+16]. + ^nil! Item was changed: + ----- Method: TTFontReader>>processCharMap: (in category 'processing - support') ----- - ----- Method: TTFontReader>>processCharMap: (in category 'processing') ----- processCharMap: assoc "Process the given character map" | charTable glyph cmap | cmap := assoc value. assoc key = 0 ifTrue: "Unicode table" [charTable := SparseLargeTable new: cmap size chunkSize: 256 arrayClass: Array base: 1 defaultValue: glyphs first. 1 to: charTable size do: [:i | glyph := glyphs at: (cmap at: i) + 1 ifAbsent: [glyphs first]. charTable at: i put: glyph]. charTable zapDefaultOnlyEntries. ^charTable]. charTable := Array new: 256 withAll: glyphs first. "Initialize with default glyph" assoc key = 1 ifTrue: "Mac encoded table" [1 to: (cmap size min: charTable size) do: [:i | glyph := glyphs at: (cmap at: i) + 1. charTable at: (self macToWin: i) put: glyph]]. assoc key = 3 ifTrue: "Win encoded table" [1 to: (cmap size min: charTable size) do: [:i | glyph := glyphs at: (cmap at: i) + 1. charTable at: i put: glyph]]. ^ charTable! Item was added: + ----- Method: TTFontReader>>processCharMapENC: (in category 'processing - support') ----- + processCharMapENC: assoc + "Process the given character map" + + | glyph cmap encode0 encode1 char value null | + cmap := assoc value. + null := (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. + null contours: #(). + + encode0 := Array new: 256 withAll: glyphs first. + encode1 := Array new: 65536 withAll: glyphs first. + + 0 to: 255 do: [:i | + char := Character value: i. + glyph := glyphs at: (cmap at: char asUnicode + 1) + 1. + encode0 at: i+1 put: glyph. + ]. + Character separators do: [:c | + encode0 at: (c asciiValue + 1) put: null. + ]. + 0 to: 65536 - 1 do: [:i | + value := cmap at: i+1. + value = 65535 ifFalse: [ "???" + | g | + g := glyphs at: value+1 ifAbsent: [ null. ]. + (g isKindOf: TTCompositeGlyph) ifFalse: [ + encode1 at: i+1 put: g. + ] ifTrue: [ + g basicGlyphs: (((glyphs at: value+1) basicGlyphs) collect: [:t | t key->(glyphs at: (t value glyphIndex+1))]). + encode1 at: i+1 put: g + ]. + ] + ]. + + ^ {encode0. encode1}. + ! Item was changed: + ----- Method: TTFontReader>>processCharacterMappingTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processCharacterMappingTable: (in category 'processing') ----- processCharacterMappingTable: entry "Read the font's character to glyph index mapping table. If an appropriate mapping can be found then return an association with the format identifier and the contents of the table" | copy initialOffset nSubTables pID sID offset cmap assoc | initialOffset := entry offset. entry skip: 2. "Skip table version" nSubTables := entry nextUShort. 1 to: nSubTables do:[:i| pID := entry nextUShort. sID := entry nextUShort. offset := entry nextULong. "Check if this is either a Macintosh encoded table or a Windows encoded table" (#(0 1 3) includes: pID) ifTrue: [ (assoc notNil and: [assoc key = pID]) ifFalse: [ "Go to the beginning of the table" copy := entry copy. copy offset: initialOffset + offset. cmap := self decodeCmapFmtTable: copy. (pID = 0 and: [cmap notNil]) "Prefer Unicode encoding over everything else" ifTrue: [^ pID -> cmap]. "(pID = 1 and: [cmap notNil])" "Prefer Macintosh encoding over everything else" "ifTrue: [pID -> cmap]." assoc := pID -> cmap. "Keep it in case we don't find a better table" ]. ]. ]. ^assoc! Item was changed: + ----- Method: TTFontReader>>processCompositeGlyph:contours:from: (in category 'processing - support') ----- - ----- Method: TTFontReader>>processCompositeGlyph:contours:from: (in category 'processing') ----- processCompositeGlyph: glyph contours: nContours from: entry "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 cGlyph ofsX ofsY iLen a11 a12 a21 a22 m | cGlyph := TTCompositeGlyph new. a11 := a22 := 16r4000. "1.0 in F2Dot14" a21 := a12 := 0. "0.0 in F2Dot14" "Copy state" cGlyph bounds: glyph bounds; glyphIndex: glyph glyphIndex. hasInstr := false. [ flags := entry nextUShort. glyphIndex := entry nextUShort + 1. (flags bitAnd: 1) = 1 ifTrue:[ ofsX := entry nextShort. ofsY := entry nextShort. ] ifFalse:[ (ofsX := entry nextByte) > 127 ifTrue:[ofsX := ofsX - 256]. (ofsY := entry nextByte) > 127 ifTrue:[ofsY := ofsY - 256]]. ((flags bitAnd: 2) = 2) ifFalse:[self halt]. (flags bitAnd: 8) = 8 ifTrue:[ a11 := a22 := entry nextShort]. (flags bitAnd: 64) = 64 ifTrue:[ a11 := entry nextShort. a22 := entry nextShort]. (flags bitAnd: 128) = 128 ifTrue:[ "2x2 transformation" a11 := entry nextShort. a21 := entry nextShort. a12 := entry nextShort. a22 := entry nextShort]. 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. cGlyph addGlyph: (glyphs at: glyphIndex) 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 := entry nextUShort. entry skip: iLen]. ^cGlyph! Item was added: + ----- Method: TTFontReader>>processData:offset: (in category 'public') ----- + processData: fontData offset: anOffset + + | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry os2Entry glyphOffset cmap numHMetrics indexToLocFormat | + + "Read the raw font byte data" + fontDescription := TTFontDescription new. + + "Search the tables required to build the font" + (headerEntry := self getTableDirEntry: 'head' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a header table']. + (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a maximum profile table']. + (nameEntry := self getTableDirEntry: 'name' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a name table']. + (indexLocEntry := self getTableDirEntry: 'loca' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a relocation table']. + (charMapEntry := self getTableDirEntry: 'cmap' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a character map table']. + (glyphEntry := self getTableDirEntry: 'glyf' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a glyph table']. + (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a horizontal header table']. + (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData offset: anOffset) == nil ifTrue:[ + ^self error:'This font does not have a horizontal metrics table']. + (kerningEntry := self getTableDirEntry: 'kern' from: fontData offset: anOffset) == nil ifTrue:[ + Transcript cr; show:'This font does not have a kerning table';endEntry]. + (os2Entry := self getTableDirEntry: 'OS/2' from: fontData offset: anOffset) == nil ifTrue:[ + Transcript cr; show: 'This font does not have a OS/2 table'; endEntry]. + + + "Process the data" + indexToLocFormat := self processFontHeaderTable: headerEntry. + self processMaximumProfileTable: maxProfileEntry. + self processNamingTable: nameEntry. + glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. + cmap := self processCharacterMappingTable: charMapEntry. + (cmap == nil or:[cmap value == nil]) + ifTrue:[^self error:'This font has no suitable character mappings']. + self processGlyphDataTable: glyphEntry offsets: glyphOffset. + numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. + self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. + kerningEntry isNil + ifTrue:[kernPairs := #()] + ifFalse:[self processKerningTable: kerningEntry]. + os2Entry ifNotNil: [self processOS2Table: os2Entry]. + charMap := self processCharMap: cmap. + charMapENC := self processCharMapENC: cmap. self flag: #leadingChar. + fontDescription setGlyphs: glyphs mapping: charMap. + fontDescription setKernPairs: kernPairs. + ^fontDescription! Item was added: + ----- Method: TTFontReader>>processData:offset:encoding: (in category 'public') ----- + processData: fontData offset: anOffset encoding: encodingTag + + | fontDescription0 fontDescription1 result | + + self processData: fontData offset: anOffset. + + self flag: #leadingChar. + fontDescription0 := fontDescription shallowCopy. + fontDescription1 := fontDescription shallowCopy. + fontDescription0 setGlyphs: (charMapENC at: 1) mapping: (charMapENC at: 1). + fontDescription1 setGlyphs: (charMapENC at: 2) mapping: (charMapENC at: 2). + fontDescription0 setKernPairs: kernPairs. + fontDescription1 setKernPairs: kernPairs. + result := OrderedCollection new. + (encodingTag = nil or: [encodingTag = 0]) ifTrue: [^ Array with: fontDescription1]. + result add: fontDescription0. + encodingTag -1 timesRepeat: [result add: nil]. + result add: fontDescription1. + ^ result asArray! Item was changed: + ----- Method: TTFontReader>>processFontHeaderTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processFontHeaderTable: (in category 'processing') ----- processFontHeaderTable: entry "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." | origin corner units indexToLocFormat | entry skip: 4. "Skip table version number" entry skip: 4. "Skip font revision number" entry skip: 4. "Skip check sum adjustment" entry skip: 4. "Skip magic number" entry skip: 2. "Skip flags" units := entry nextUShort. entry skip: 8. "Skip creation date" entry skip: 8. "Skip modification date" "Get min/max values of all glyphs" origin := entry nextShort @ entry nextShort. corner := entry nextShort @ entry nextShort. entry skip: 2. "Skip mac style" entry skip: 2. "Skip lowest rec PPEM" entry skip: 2. "Skip font direction hint" indexToLocFormat := entry nextShort. fontDescription setBounds: (origin corner: corner) unitsPerEm: units. ^indexToLocFormat! Item was changed: + ----- Method: TTFontReader>>processGlyphDataTable:offsets: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processGlyphDataTable:offsets: (in category 'processing') ----- processGlyphDataTable: entry offsets: offsetArray "Read the actual glyph data from the font. offsetArray contains the start offsets in the data for each glyph." | initialOffset | initialOffset := entry offset. glyphs := Array new: nGlyphs. 1 to: nGlyphs do:[:i | glyphs at: i put: (TTGlyph new glyphIndex: i-1)]. 'Reading glyph data' displayProgressFrom: 1 to: nGlyphs during:[:bar| | nContours glyphOffset origin corner glyphLength glyph nextOffset | 1 to: nGlyphs do:[:glyphIndex | bar value: glyphIndex. glyph := glyphs at: glyphIndex. glyphOffset := offsetArray at: glyphIndex. nextOffset := offsetArray at: glyphIndex+1. glyphLength := nextOffset - glyphOffset. glyphLength = 0 ifFalse:[ entry offset: initialOffset + glyphOffset. nContours := entry nextShort. origin := entry nextShort @ entry nextShort. corner := entry nextShort @ entry nextShort. glyph bounds: (origin corner: corner). nContours >= 0 ifTrue:[ self processSimpleGlyph: glyph contours: nContours from: entry ] ifFalse:[ glyph := self processCompositeGlyph: glyph contours: nContours from: entry. glyphs at: glyphIndex put: glyph]]] ].! Item was changed: + ----- Method: TTFontReader>>processHorizontalHeaderTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processHorizontalHeaderTable: (in category 'processing') ----- processHorizontalHeaderTable: entry " 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. " | asc desc lGap numHMetrics | entry skip: 4. "Skip table version" asc := entry nextShort. desc := entry nextShort. lGap := entry nextShort. entry skip: 2. "Skip advanceWidthMax" entry skip: 2. "Skip minLeftSideBearing" entry skip: 2. "Skip minRightSideBearing" entry skip: 2. "Skip xMaxExtent" entry skip: 2. "Skip caretSlopeRise" entry skip: 2. "Skip caretSlopeRun" entry skip: 10. "Skip 5 reserved shorts" entry skip: 2. "Skip metricDataFormat" numHMetrics := entry nextUShort. fontDescription setAscender: asc descender: desc lineGap: lGap. ^numHMetrics! Item was changed: + ----- Method: TTFontReader>>processHorizontalMetricsTable:length: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processHorizontalMetricsTable:length: (in category 'processing') ----- processHorizontalMetricsTable: entry length: numHMetrics "Extract the advance width, left side bearing, and right side bearing for each glyph from the Horizontal Metrics Table." | index lastAW glyph | index := 1. [index <= numHMetrics] whileTrue:[ glyph := glyphs at: index. glyph advanceWidth: entry nextUShort. glyph leftSideBearing: entry nextShort. glyph updateRightSideBearing. index := index + 1]. index = (nGlyphs +1) ifTrue:[^true]. lastAW := (glyphs at: index-1) advanceWidth. [index <= nGlyphs] whileTrue:[ glyph := glyphs at: index. glyph advanceWidth: lastAW. glyph leftSideBearing: entry nextShort. glyph updateRightSideBearing. index := index + 1].! Item was changed: + ----- Method: TTFontReader>>processIndexToLocationTable:format: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processIndexToLocationTable:format: (in category 'processing') ----- processIndexToLocationTable: entry format: indexToLocFormat "glyphOffset ULONG[numGlyphs] An array that contains each glyph's offset into the Glyph Data Table. " | glyphOffset offset| glyphOffset := Array new: nGlyphs+1. 1 to: nGlyphs+1 do:[:i| (indexToLocFormat = 0) ifTrue:[ "Format0: offset/2 is stored" offset := entry nextUShort * 2. ] ifFalse:["Format1: store actual offset" offset := entry nextULong]. glyphOffset at: i put: offset]. ^glyphOffset! Item was changed: + ----- Method: TTFontReader>>processKerningSubTableType0: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processKerningSubTableType0: (in category 'processing') ----- processKerningSubTableType0: entry | kp nKernPairs | nKernPairs := entry nextUShort. entry skip: 2. "Skip search range" entry skip: 2. "Skip entry selector" entry skip: 2. "Skip range shift" kernPairs := Array new: nKernPairs. 1 to: nKernPairs do:[:i| kp := TTKernPair new. kp left: entry nextUShort. kp right: entry nextUShort. kp value: entry nextShort. kernPairs at: i put: kp]. ^true ! Item was changed: + ----- Method: TTFontReader>>processKerningTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processKerningTable: (in category 'processing') ----- processKerningTable: entry "Extract the kerning information for pairs of glyphs." | version nTables covLow covHigh | version := entry nextUShort. "Skip table version" nTables := entry nextUShort. "Skip number of sub tables -- we're using the first one only" nTables = 0 ifTrue: [" This detection is hacky " entry skip: -4. "rewind" ^ self processOSXKerningTable: entry]. entry skip: 2. "Skip current subtable number" entry skip: 2. "Skip length of subtable" covHigh := entry nextByte. covLow := entry nextByte. "Make sure the format is right (kerning table and format type 0)" ((covLow bitAnd: 2) = 2 or:[ covHigh ~= 0]) ifTrue:[^false]. "Subtable" ^ self processKerningSubTableType0: entry. ! Item was changed: + ----- Method: TTFontReader>>processMaximumProfileTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processMaximumProfileTable: (in category 'processing') ----- processMaximumProfileTable: entry " numGlyphs USHORT The number of glyphs in the font. " entry skip: 4. "Skip Table version number" nGlyphs := entry nextUShort.! Item was changed: + ----- Method: TTFontReader>>processNamingTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processNamingTable: (in category 'processing') ----- processNamingTable: entry "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 format storageOffset strings | strings := Array new: 8. strings atAllPut:''. initialOffset := entry offset. format := entry nextUShort. format = 0 ifFalse: [self error: 'Cannot handle format 1 naming tables']. "Get the number of name records" nRecords := entry nextUShort. "Offset from the beginning of this table" storageOffset := entry nextUShort + initialOffset. 1 to: nRecords do:[:i| | pID sID lID nID length offset multiBytes string | pID := entry nextUShort. sID := entry nextUShort. lID := entry nextUShort. nID := entry nextUShort. length := entry nextUShort. offset := entry nextUShort. "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. string := entry stringAt: storageOffset + offset length: length multiByte: multiBytes. "Select only English names. Note: We prefer Macintosh strings about everything." ((pID = 1 and: [lID = 0]) or: [pID = 3 and: [lID = 16r0409]]) ifTrue: [ "Put the name at the right location." nID < strings size ifTrue:[ (pID = 1 or:[(strings at: nID+1) = '']) ifTrue:[strings at: nID+1 put: string]. ]. ]. ]. ]. fontDescription setStrings: strings.! Item was changed: + ----- Method: TTFontReader>>processOS2Table: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processOS2Table: (in category 'processing') ----- processOS2Table: entry " USHORT version 0x0004 SHORT xAvgCharWidth USHORT usWeightClass USHORT usWidthClass USHORT fsType SHORT ySubscriptXSize SHORT ySubscriptYSize SHORT ySubscriptXOffset SHORT ySubscriptYOffset SHORT ySuperscriptXSize SHORT ySuperscriptYSize SHORT ySuperscriptXOffset SHORT ySuperscriptYOffset SHORT yStrikeoutSize SHORT yStrikeoutPosition SHORT sFamilyClass BYTE panose[10] ULONG ulUnicodeRange1 Bits 0-31 ULONG ulUnicodeRange2 Bits 32-63 ULONG ulUnicodeRange3 Bits 64-95 ULONG ulUnicodeRange4 Bits 96-127 CHAR achVendID[4] USHORT fsSelection USHORT usFirstCharIndex USHORT usLastCharIndex SHORT sTypoAscender SHORT sTypoDescender SHORT sTypoLineGap USHORT usWinAscent USHORT usWinDescent ULONG ulCodePageRange1 Bits 0-31 ULONG ulCodePageRange2 Bits 32-63 SHORT sxHeight SHORT sCapHeight USHORT usDefaultChar USHORT usBreakChar USHORT usMaxContext " | version fsSelection minAscii maxAscii asc desc lGap | version := entry nextShort. "table version" version = 0 ifTrue:[^self]. entry skip: 60. fsSelection := entry nextUShort. minAscii := entry nextUShort. maxAscii := entry nextUShort. asc := entry nextShort. desc := entry nextShort. lGap := entry nextShort. fontDescription setTypographicAscender: asc descender: desc lineGap: lGap.! Item was changed: + ----- Method: TTFontReader>>processOSXKerningTable: (in category 'processing - tables') ----- - ----- Method: TTFontReader>>processOSXKerningTable: (in category 'processing') ----- processOSXKerningTable: entry "From Apple's TrueType reference: Previous versions of the 'kern' table defined both the version and nTables fields in the header as UInt16 values and not UInt32 values. Use of the older format on OS X is discouraged (although AAT can sense an old kerning table and still make correct use of it). Microsoft Windows still uses the older format for the 'kern' table and will not recognize the newer one. Fonts targeted for OS X only should use the new format; fonts targeted for both OS X and Windows should use the old format. " "Extract the kerning information for pairs of glyphs." | version nTables length coverage tupleIndex | version := entry nextULong. "Skip table version" nTables := entry nextULong. "Skip number of sub tables -- we're using the first one only" length := entry nextULong. "Skip length of subtable" coverage := entry nextUShort. tupleIndex := entry nextUShort. "Skip tuple index". "Make sure the format is right (kerning table and format type 0)" coverage = 0 ifFalse: [^false]. "Subtable" ^ self processKerningSubTableType0: entry. ! Item was changed: + ----- Method: TTFontReader>>processSimpleGlyph:contours:from: (in category 'processing - support') ----- - ----- Method: TTFontReader>>processSimpleGlyph:contours:from: (in category 'processing') ----- processSimpleGlyph: glyph contours: nContours from: entry | endPts nPts iLength flags | endPts := Array new: nContours. 1 to: nContours do:[:i| endPts at: i put: entry nextUShort]. glyph initializeContours: nContours with: endPts. nContours = 0 ifTrue: [^ self]. nPts := endPts last + 1. iLength := entry nextUShort. "instruction length" entry skip: iLength. flags := self getGlyphFlagsFrom: entry size: nPts. self readGlyphXCoords: entry glyph: glyph nContours: nContours flags: flags endPoints: endPts. self readGlyphYCoords: entry glyph: glyph nContours: nContours flags: flags endPoints: endPts. glyph buildContours.! Item was changed: ----- Method: TTFontReader>>readFrom: (in category 'public') ----- readFrom: aStream + ^ self + processData: aStream binary contents asByteArray + offset: 0 + "encoding: nil"! - | fontData headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry glyphOffset cmap numHMetrics indexToLocFormat | - - "Read the raw font byte data" - aStream binary. - fontData := aStream contents asByteArray. - fontDescription := TTFontDescription new. - - "Search the tables required to build the font" - (headerEntry := self getTableDirEntry: 'head' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a header table']. - (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a maximum profile table']. - (nameEntry := self getTableDirEntry: 'name' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a name table']. - (indexLocEntry := self getTableDirEntry: 'loca' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a relocation table']. - (charMapEntry := self getTableDirEntry: 'cmap' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a character map table']. - (glyphEntry := self getTableDirEntry: 'glyf' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a glyph table']. - (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a horizontal header table']. - (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData) == nil ifTrue:[ - ^self error:'This font does not have a horizontal metrics table']. - (kerningEntry := self getTableDirEntry: 'kern' from: fontData) == nil ifTrue:[ - Transcript cr; show:'This font does not have a kerning table';endEntry]. - - - "Process the data" - indexToLocFormat := self processFontHeaderTable: headerEntry. - self processMaximumProfileTable: maxProfileEntry. - self processNamingTable: nameEntry. - glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. - cmap := self processCharacterMappingTable: charMapEntry. - (cmap == nil or:[cmap value == nil]) - ifTrue:[^self error:'This font has no suitable character mappings']. - self processGlyphDataTable: glyphEntry offsets: glyphOffset. - numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. - self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. - kerningEntry isNil - ifTrue:[kernPairs := #()] - ifFalse:[self processKerningTable: kerningEntry]. - charMap := self processCharMap: cmap. - fontDescription setGlyphs: glyphs mapping: charMap. - fontDescription setKernPairs: kernPairs. - ^fontDescription!

1 0

The Trunk: Graphics-mt.476.mcz
by commits＠source.squeak.org 06 Feb '22

06 Feb '22

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.476.mcz ==================== Summary ==================== Name: Graphics-mt.476 Author: mt Time: 6 February 2022, 6:57:21.367117 am UUID: 5a801a25-5571-f24d-96a5-23a578caa27f Ancestors: Graphics-mt.475 Revises recent changes to configuration of FixedFaceFont as #fallbackFont. Start with code point 33 when looking for a possible substitution character in the baseFont bc. the glyph should be visible. =============== Diff against Graphics-mt.475 =============== Item was changed: ----- Method: FixedFaceFont>>fixSubstitutionCharacter (in category 'private') ----- fixSubstitutionCharacter substitutionCharacter ifNil: [^ self]. baseFont ifNil: [^ self]. (baseFont hasGlyphOf: substitutionCharacter) ifTrue: [^ self]. + ((baseFont minCodePoint max: 33) to: baseFont maxCodePoint) - (baseFont minCodePoint to: baseFont maxCodePoint) detect: [:codePoint | baseFont hasGlyphOf: (Character value: codePoint)] ifFound: [:codePoint | substitutionCharacter := Character value: codePoint] ifNone: [ baseFont := TextStyle defaultFont. substitutionCharacter := $?]. self assert: [baseFont hasGlyphOf: substitutionCharacter] description: 'Could not find a possible substitution character and font!!'.!

1 0

The Trunk: Sound-dtl.86.mcz
by commits＠source.squeak.org 05 Feb '22

05 Feb '22

David T. Lewis uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-dtl.86.mcz ==================== Summary ==================== Name: Sound-dtl.86 Author: dtl Time: 5 February 2022, 3:47:29.747123 pm UUID: 340d381a-fa79-4de2-aba6-42171c9f2a50 Ancestors: Sound-dto.85 Remove accidental whitespace-only changes from previous commit =============== Diff against Sound-dto.85 =============== Item was changed: ----- Method: SampledInstrument class>>readLoudAndStaccatoInstrument:fromDirectory: (in category 'instance creation') ----- + readLoudAndStaccatoInstrument: instName fromDirectory: orchestraDir - readLoudAndStaccatoInstrument: instName fromDirectory: orchestraDir "SampledInstrument + readLoudAndStaccatoInstrument: 'oboe' + fromDirectory: 'Tosh:Sample Library:Orchestra'" + - readLoudAndStaccatoInstrument: 'oboe' - fromDirectory: 'Tosh:Sample Library:Orchestra'" | sampleSetDir memBefore memAfter loud short snd | + sampleSetDir := orchestraDir, ':', instName. - sampleSetDir := orchestraDir , FileDirectory slash , instName. memBefore := Smalltalk garbageCollect. + loud := SampledInstrument new readSampleSetFrom: sampleSetDir, ' f'. + short := SampledInstrument new readSampleSetFrom: sampleSetDir, ' stacc'. - loud := SampledInstrument new readSampleSetFrom: sampleSetDir , ' f'. - short := SampledInstrument new readSampleSetFrom: sampleSetDir , ' stacc'. memAfter := Smalltalk garbageCollect. + Transcript show: + instName, ': ', (memBefore - memAfter) printString, + ' bytes; ', memAfter printString, ' bytes left'; cr. + AbstractSound soundNamed: instName, '-f&stacc' put: + (snd := SampledInstrument new + allSampleSets: loud; + staccatoLoudAndSoftSampleSet: short). - Transcript show: instName , ': ' , (memBefore - memAfter) printString , ' bytes; ' , memAfter printString , ' bytes left'; - cr. - AbstractSound soundNamed: instName , '-f&stacc' put: (snd := SampledInstrument new allSampleSets: loud; - staccatoLoudAndSoftSampleSet: short). "fix slow attacks" + snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 500)]. + + AbstractSound soundNamed: instName, '-f' put: + (snd := SampledInstrument new + allSampleSets: loud). - snd allNotes - do: [:n | n - firstSample: (n findStartPointForThreshold: 500)]. - AbstractSound soundNamed: instName , '-f' put: (snd := SampledInstrument new allSampleSets: loud). "fix slow attacks" + snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 1000)]. + ! - snd allNotes - do: [:n | n - firstSample: (n findStartPointForThreshold: 1000)]! Item was changed: ----- Method: SampledInstrument class>>readPizzInstrument:fromDirectory: (in category 'instance creation') ----- + readPizzInstrument: instName fromDirectory: orchestraDir - readPizzInstrument: instName fromDirectory: orchestraDir "SampledInstrument + readPizzInstrument: 'violin' + fromDirectory: 'Tosh:Sample Library:Orchestra'" + - readPizzInstrument: 'violin' - fromDirectory: 'Tosh:Sample Library:Orchestra'" | sampleSetDir memBefore memAfter sampleSet snd | + sampleSetDir := orchestraDir, ':', instName, ' pizz'. - sampleSetDir := orchestraDir , FileDirectory slash , instName , ' pizz'. memBefore := Smalltalk garbageCollect. sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. memAfter := Smalltalk garbageCollect. + Transcript show: + instName, ': ', (memBefore - memAfter) printString, + ' bytes; ', memAfter printString, ' bytes left'; cr. + AbstractSound soundNamed: instName, '-pizz' put: + (snd := SampledInstrument new allSampleSets: sampleSet). + - Transcript show: instName , ': ' , (memBefore - memAfter) printString , ' bytes; ' , memAfter printString , ' bytes left'; - cr. - AbstractSound soundNamed: instName , '-pizz' put: (snd := SampledInstrument new allSampleSets: sampleSet). "fix slow attacks" + snd allNotes do: [:n | + n firstSample: (n findStartPointForThreshold: 1000)]. + + ^ snd + ! - snd allNotes - do: [:n | n - firstSample: (n findStartPointForThreshold: 1000)]. - ^ snd! Item was changed: ----- Method: SampledInstrument class>>readSimpleInstrument:fromDirectory: (in category 'instance creation') ----- readSimpleInstrument: instName fromDirectory: orchestraDir "SampledInstrument readSimpleInstrument: 'oboe' fromDirectory: 'Tosh:Sample Library:Orchestra'" | sampleSetDir memBefore memAfter sampleSet snd | + sampleSetDir := orchestraDir, ':', instName, ' f'. - sampleSetDir := orchestraDir, FileDirectory slash, instName, ' f'. memBefore := Smalltalk garbageCollect. sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. memAfter := Smalltalk garbageCollect. Transcript show: instName, ': ', (memBefore - memAfter) printString, ' bytes; ', memAfter printString, ' bytes left'; cr. AbstractSound soundNamed: instName, '-f' put: (snd := SampledInstrument new allSampleSets: sampleSet). "fix slow attacks" snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 1000)]. ^ snd !

1 0

The Trunk: Sound-dto.85.mcz
by commits＠source.squeak.org 05 Feb '22

05 Feb '22

David T. Lewis uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-dto.85.mcz ==================== Summary ==================== Name: Sound-dto.85 Author: dto Time: 5 February 2022, 1:19:37.313377 pm UUID: 1f3917a1-5536-4c9f-80b7-6f3613e7d087 Ancestors: Sound-ct.84 Fixes incorrect AIFF loop marker extraction, and removes obsolete path delimiters in SampledInstrument. =============== Diff against Sound-ct.84 =============== Item was changed: ----- Method: AIFFFileReader>>loopEnd (in category 'accessing') ----- loopEnd + ^ markers second last! - - ^ markers last last - ! Item was changed: ----- Method: AIFFFileReader>>loopLength (in category 'accessing') ----- loopLength + ^ markers second last - markers first last! - - ^ markers last last - markers first last - ! Item was changed: ----- Method: AIFFFileReader>>readInstrumentChunk: (in category 'private') ----- + readInstrumentChunk: chunkSize + | midiKey detune lowNote highNote lowVelocity highVelocity sustainMode sustainStartID sustainEndID releaseMode releaseStartID releaseEndID | - readInstrumentChunk: chunkSize - - | midiKey detune lowNote highNote lowVelocity highVelocity - sustainMode sustainStartID sustainEndID - releaseMode releaseStartID releaseEndID | - midiKey := in next. detune := in next. lowNote := in next. highNote := in next. lowVelocity := in next. highVelocity := in next. gain := in nextNumber: 2. sustainMode := in nextNumber: 2. sustainStartID := in nextNumber: 2. sustainEndID := in nextNumber: 2. releaseMode := in nextNumber: 2. releaseStartID := in nextNumber: 2. releaseEndID := in nextNumber: 2. isLooped := sustainMode = 1. + (isLooped + and: [markers notNil]) + ifTrue: [(markers first last > frameCount + or: [markers second last > frameCount]) + ifTrue: ["bad loop data; some sample CD files claim to be + looped but aren't" + isLooped := false]]. + pitch := self pitchForKey: midiKey! - (isLooped and: [markers notNil]) ifTrue: [ - ((markers first last > frameCount) or: - [markers last last > frameCount]) ifTrue: [ - "bad loop data; some sample CD files claim to be looped but aren't" - isLooped := false]]. - pitch := self pitchForKey: midiKey. - ! Item was changed: ----- Method: SampledInstrument class>>readLoudAndStaccatoInstrument:fromDirectory: (in category 'instance creation') ----- + readLoudAndStaccatoInstrument: instName fromDirectory: orchestraDir - readLoudAndStaccatoInstrument: instName fromDirectory: orchestraDir "SampledInstrument + readLoudAndStaccatoInstrument: 'oboe' + fromDirectory: 'Tosh:Sample Library:Orchestra'" - readLoudAndStaccatoInstrument: 'oboe' - fromDirectory: 'Tosh:Sample Library:Orchestra'" - | sampleSetDir memBefore memAfter loud short snd | + sampleSetDir := orchestraDir , FileDirectory slash , instName. - sampleSetDir := orchestraDir, ':', instName. memBefore := Smalltalk garbageCollect. + loud := SampledInstrument new readSampleSetFrom: sampleSetDir , ' f'. + short := SampledInstrument new readSampleSetFrom: sampleSetDir , ' stacc'. - loud := SampledInstrument new readSampleSetFrom: sampleSetDir, ' f'. - short := SampledInstrument new readSampleSetFrom: sampleSetDir, ' stacc'. memAfter := Smalltalk garbageCollect. + Transcript show: instName , ': ' , (memBefore - memAfter) printString , ' bytes; ' , memAfter printString , ' bytes left'; + cr. + AbstractSound soundNamed: instName , '-f&stacc' put: (snd := SampledInstrument new allSampleSets: loud; + staccatoLoudAndSoftSampleSet: short). - Transcript show: - instName, ': ', (memBefore - memAfter) printString, - ' bytes; ', memAfter printString, ' bytes left'; cr. - AbstractSound soundNamed: instName, '-f&stacc' put: - (snd := SampledInstrument new - allSampleSets: loud; - staccatoLoudAndSoftSampleSet: short). "fix slow attacks" + snd allNotes + do: [:n | n + firstSample: (n findStartPointForThreshold: 500)]. + AbstractSound soundNamed: instName , '-f' put: (snd := SampledInstrument new allSampleSets: loud). - snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 500)]. - - AbstractSound soundNamed: instName, '-f' put: - (snd := SampledInstrument new - allSampleSets: loud). "fix slow attacks" + snd allNotes + do: [:n | n + firstSample: (n findStartPointForThreshold: 1000)]! - snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 1000)]. - ! Item was changed: ----- Method: SampledInstrument class>>readPizzInstrument:fromDirectory: (in category 'instance creation') ----- + readPizzInstrument: instName fromDirectory: orchestraDir - readPizzInstrument: instName fromDirectory: orchestraDir "SampledInstrument + readPizzInstrument: 'violin' + fromDirectory: 'Tosh:Sample Library:Orchestra'" - readPizzInstrument: 'violin' - fromDirectory: 'Tosh:Sample Library:Orchestra'" - | sampleSetDir memBefore memAfter sampleSet snd | + sampleSetDir := orchestraDir , FileDirectory slash , instName , ' pizz'. - sampleSetDir := orchestraDir, ':', instName, ' pizz'. memBefore := Smalltalk garbageCollect. sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. memAfter := Smalltalk garbageCollect. + Transcript show: instName , ': ' , (memBefore - memAfter) printString , ' bytes; ' , memAfter printString , ' bytes left'; + cr. + AbstractSound soundNamed: instName , '-pizz' put: (snd := SampledInstrument new allSampleSets: sampleSet). - Transcript show: - instName, ': ', (memBefore - memAfter) printString, - ' bytes; ', memAfter printString, ' bytes left'; cr. - AbstractSound soundNamed: instName, '-pizz' put: - (snd := SampledInstrument new allSampleSets: sampleSet). - "fix slow attacks" + snd allNotes + do: [:n | n + firstSample: (n findStartPointForThreshold: 1000)]. + ^ snd! - snd allNotes do: [:n | - n firstSample: (n findStartPointForThreshold: 1000)]. - - ^ snd - ! Item was changed: ----- Method: SampledInstrument class>>readSimpleInstrument:fromDirectory: (in category 'instance creation') ----- readSimpleInstrument: instName fromDirectory: orchestraDir "SampledInstrument readSimpleInstrument: 'oboe' fromDirectory: 'Tosh:Sample Library:Orchestra'" | sampleSetDir memBefore memAfter sampleSet snd | + sampleSetDir := orchestraDir, FileDirectory slash, instName, ' f'. - sampleSetDir := orchestraDir, ':', instName, ' f'. memBefore := Smalltalk garbageCollect. sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. memAfter := Smalltalk garbageCollect. Transcript show: instName, ': ', (memBefore - memAfter) printString, ' bytes; ', memAfter printString, ' bytes left'; cr. AbstractSound soundNamed: instName, '-f' put: (snd := SampledInstrument new allSampleSets: sampleSet). "fix slow attacks" snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 1000)]. ^ snd !

1 0

← Newer
1
...
13
14
15
16
17
18
19
20
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2022