[Pkg] Squeak3.10bc: TrueType-kph.6.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:49:45 UTC 2008


A new version of TrueType was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/TrueType-kph.6.mcz

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

Name: TrueType-kph.6
Author: kph
Time: 13 December 2008, 4:49:43 am
UUID: 4c17d8e1-230a-4f7e-bceb-7af104c3b680
Ancestors: TrueType-edc.5

Saved from SystemVersion

==================== Snapshot ====================

SystemOrganization addCategory: #'TrueType-Fonts'!
SystemOrganization addCategory: #'TrueType-Support'!

Object subclass: #TTContourConstruction
	instanceVariableNames: 'points'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Support'!

!TTContourConstruction commentStamp: '<historical>' prior: 0!
This class represents a temporary contour structure during the construction of a TTGlyph from a TrueType file.

Instance variables:
	points	<Array of: TTPoint>	The points defining this contour!

----- Method: TTContourConstruction class>>on: (in category 'instance creation') -----
on: points

	^self new points: points!

----- Method: TTContourConstruction>>asCompressedPoints (in category 'converting') -----
asCompressedPoints
	"Return the receiver compressed into a PointArray.
	All lines will be converted into bezier segments with
	the control point set to the start point"
	| out minPt maxPt fullRange |
	minPt := -16r7FFF asPoint.
	maxPt := 16r8000 asPoint.
	"Check if we need full 32bit range"
	fullRange := points anySatisfy: [:any| any asPoint < minPt or:[any asPoint > maxPt]].
	fullRange ifTrue:[
		out := WriteStream on: (PointArray new: points size).
	] ifFalse:[
		out := WriteStream on: (ShortPointArray new: points size).
	].
	self segmentsDo:[:segment|
		out nextPut: segment start.
		segment isBezier2Segment 
			ifTrue:[out nextPut: segment via]
			ifFalse:[out nextPut: segment start].
		out nextPut: segment end.
	].
	^out contents!

----- Method: TTContourConstruction>>points (in category 'accessing') -----
points
	^points!

----- Method: TTContourConstruction>>points: (in category 'accessing') -----
points: anArray
	points := anArray asArray.!

----- Method: TTContourConstruction>>printOn: (in category 'printing') -----
printOn: aStream

	aStream
		nextPutAll: self class name;
		nextPut:$(;
		print: points size;
		"space;
		print: self type;"
		nextPut:$)!

----- Method: TTContourConstruction>>segments (in category 'accessing') -----
segments

	| segments |
	segments := OrderedCollection new.
	self segmentsDo:[:seg| segments add: seg].
	^segments!

----- Method: TTContourConstruction>>segmentsDo: (in category 'enumerating') -----
segmentsDo: aBlock
	"Evaluate aBlock with the segments of the receiver. This may either be straight line
	segments or quadratic bezier curves. The decision is made upon the type flags
	in TTPoint as follows:
	a) 	Two subsequent #OnCurve points define a straight segment
	b) 	An #OnCurve point followed by an #OffCurve point followed 
		by an #OnCurve point defines a quadratic bezier segment
	c)	Two subsequent #OffCurve points have an implicitely defined 
		#OnCurve point at half the distance between them"
	| last next mid index i |
	last := points first.
	"Handle case where first point is off-curve"
	(last type == #OnCurve) ifFalse: [
		i := points findFirst: [:pt | pt type == #OnCurve].
		i = 0
			ifTrue: [mid := TTPoint new
							type: #OnCurve;
							x: points first x + points last x // 2;
							y: points first y + points last y // 2.
					points := (Array with: mid), points]
			ifFalse: [points := (points copyFrom: i to: points size), (points copyFrom: 1 to: i)].
		last := points first].
	index := 2.
	[index <= points size] whileTrue:[
		mid := points at: index.
		mid type == #OnCurve ifTrue:[
			"Straight segment"
			aBlock value: (LineSegment from: last asPoint to: mid asPoint).
			last := mid.
		] ifFalse:["Quadratic bezier"
			"Read ahead if the next point is on curve"
			next := (index < points size) ifTrue:[points at: (index+1)] ifFalse:[points first].
			next type == #OnCurve ifTrue:[
				"We'll continue after the end point"
				index := index + 1.
			] ifFalse:[ "Calculate center"
				next := (next asPoint + mid asPoint) // 2].
			aBlock value:(Bezier2Segment from: last asPoint via: mid asPoint to: next asPoint).
			last := next].
		index := index + 1].
	(index = (points size + 1)) ifTrue:[
		aBlock value:(LineSegment from: points last asPoint to: points first asPoint)]!

Object subclass: #TTFontDescription
	instanceVariableNames: 'glyphTable glyphs kernPairs copyright familyName fullName subfamilyName uniqueName versionName postscriptName trademark bounds unitsPerEm ascender descender lineGap'
	classVariableNames: 'Descriptions Default'
	poolDictionaries: ''
	category: 'TrueType-Fonts'!

!TTFontDescription commentStamp: '<historical>' prior: 0!
Holds a TrueType font in memory.  Is used by TTSampleStringMorph as its font.  

Class owns a default example.  !

----- Method: TTFontDescription class>>addFromTTFile: (in category 'instance creations') -----
addFromTTFile: fileName
"
	self addFromTTFile: 'C:\WINDOWS\Fonts\ARIALN.TTF'
"
	^self addFromTTStream: (FileStream readOnlyFileNamed: fileName).
!

----- Method: TTFontDescription class>>addFromTTStream: (in category 'instance creations') -----
addFromTTStream: readStream
"
	self addFromTTFile: 'C:\WINDOWS\Fonts\ARIALN.TTF'
"

	| tt old |
	tt := TTFontReader readFrom: readStream.
	old := Descriptions detect: [:f | f name = tt name and: [f subfamilyName = tt subfamilyName]] ifNone: [nil].
	old ifNotNil: [Descriptions remove: old].
	Descriptions add: tt.
	^ tt.
!

----- Method: TTFontDescription class>>clearDefault (in category 'instance creations') -----
clearDefault
"
	self clearDefault
"

	Default := nil.
!

----- Method: TTFontDescription class>>clearDescriptions (in category 'instance creations') -----
clearDescriptions
"
	self clearDescriptions
"

	Descriptions := Set new.
	Default ifNotNil: [Descriptions add: Default].
!

----- Method: TTFontDescription class>>default (in category 'instance creations') -----
default
	^ Default!

----- Method: TTFontDescription class>>descriptionFullNamed: (in category 'instance creations') -----
descriptionFullNamed: descriptionFullName 
	^ Descriptions
		detect: [:f | f fullName = descriptionFullName]
		ifNone: [Default]!

----- Method: TTFontDescription class>>descriptionNamed: (in category 'instance creations') -----
descriptionNamed: descriptionName

	^ Descriptions detect: [:f | f name = descriptionName] ifNone: [Default].
!

----- Method: TTFontDescription class>>initialize (in category 'instance creations') -----
initialize
"
	self initialize
"

	self clearDescriptions.
!

----- Method: TTFontDescription class>>removeDescriptionNamed: (in category 'instance creations') -----
removeDescriptionNamed: descriptionName

	| tt |
	Descriptions ifNil: [^ self].
	[(tt :=  Descriptions detect: [:f | f name = descriptionName] ifNone: [nil]) notNil] whileTrue:[
		 Descriptions remove: tt
	].
!

----- Method: TTFontDescription class>>removeDescriptionNamed:subfamilyName: (in category 'instance creations') -----
removeDescriptionNamed: descriptionName subfamilyName: subfamilyName

	| tts |
	Descriptions ifNil: [^ self].
	tts := Descriptions select: [:f | f name = descriptionName and: [f subfamilyName = subfamilyName]].
	tts do: [:f | Descriptions remove: f].
!

----- Method: TTFontDescription class>>setDefault (in category 'instance creations') -----
setDefault
"
	self setDefault
"

	Default := TTFontReader readFrom: (FileStream readOnlyFileNamed: 'C:\WINDOWS\Fonts\comic.ttf').
!

----- Method: TTFontDescription>>asStrikeFontScale: (in category 'converting') -----
asStrikeFontScale: scale
	"Generate a StrikeFont (actually a FormSetFont) for this TTF font at a given scale."

	| forms |
	forms := (0 to: 255) collect:
		[:i |
		(self at: i)
			asFormWithScale: scale
			ascender: ascender
			descender: descender].
	^ FormSetFont new
		fromFormArray: forms
		asciiStart: 0
		ascent: (ascender * scale) rounded!

----- Method: TTFontDescription>>ascender (in category 'properties') -----
ascender
	^ascender!

----- Method: TTFontDescription>>at: (in category 'accessing') -----
at: aCharOrInteger
	^glyphTable at: aCharOrInteger asInteger+1!

----- Method: TTFontDescription>>at:put: (in category 'accessing') -----
at: index put: value
	^self shouldNotImplement!

----- Method: TTFontDescription>>blankGlyphForSeparators (in category 'migration') -----
blankGlyphForSeparators

	| space |
	space := (self at: Character space charCode) copy.
	space contours: #().
	Character separators do: [:s | 
		glyphTable at: s charCode +1 put: space.
	].
!

----- Method: TTFontDescription>>bounds (in category 'properties') -----
bounds
	^bounds!

----- Method: TTFontDescription>>copyright (in category 'information') -----
copyright
	^copyright!

----- Method: TTFontDescription>>deepCopy (in category 'copying') -----
deepCopy

	"Since it shouldn't be copied for transmitting or any reason, it returns self."
	^ self.
!

----- Method: TTFontDescription>>descender (in category 'properties') -----
descender
	^descender!

----- Method: TTFontDescription>>familyName (in category 'information') -----
familyName
	^familyName!

----- 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]!

----- Method: TTFontDescription>>fullName (in category 'information') -----
fullName
	^fullName!

----- Method: TTFontDescription>>lineGap (in category 'properties') -----
lineGap
	^lineGap!

----- Method: TTFontDescription>>name (in category 'accessing') -----
name

	^ self familyName copyWithout: Character space.
!

----- Method: TTFontDescription>>objectForDataStream: (in category 'copying') -----
objectForDataStream: refStrm
	| dp |
	"I am about to be written on an object file.  Write a reference to a known Font in the other system instead.  "

	"A path to me"
	(TextConstants at: #forceFontWriting ifAbsent: [false]) ifTrue: [^ self].
		"special case for saving the default fonts on the disk.  See collectionFromFileNamed:"

	dp := DiskProxy global: #TTFontDescription selector: #descriptionFullNamed:
			args: {self fullName}.
	refStrm replace: self with: dp.
	^ dp.
!

----- Method: TTFontDescription>>postscriptName (in category 'information') -----
postscriptName
	^postscriptName!

----- Method: TTFontDescription>>printOn: (in category 'printing') -----
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	familyName printOn: aStream.
	aStream nextPut:$).!

----- Method: TTFontDescription>>setAscender:descender:lineGap: (in category 'private-initialization') -----
setAscender: asc descender: desc lineGap: lgap
	ascender := asc.
	descender := desc.
	lineGap := lgap!

----- Method: TTFontDescription>>setBounds:unitsPerEm: (in category 'private-initialization') -----
setBounds: aRect unitsPerEm: aNumber
	bounds := aRect.
	unitsPerEm := aNumber.!

----- Method: TTFontDescription>>setGlyphs:mapping: (in category 'private-initialization') -----
setGlyphs: glyphArray mapping: mappingTable
	glyphs := glyphArray.
	glyphTable := mappingTable.!

----- Method: TTFontDescription>>setKernPairs: (in category 'private-initialization') -----
setKernPairs: array
	kernPairs := array!

----- 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.
!

----- Method: TTFontDescription>>size (in category 'accessing') -----
size
	"Answer the logical number of characters in this font"
	^glyphTable size - 1
!

----- Method: TTFontDescription>>subfamilyName (in category 'information') -----
subfamilyName
	^subfamilyName!

----- Method: TTFontDescription>>trademark (in category 'information') -----
trademark
	^trademark!

----- Method: TTFontDescription>>uniqueName (in category 'information') -----
uniqueName
	^uniqueName!

----- Method: TTFontDescription>>unitsPerEm (in category 'properties') -----
unitsPerEm
	^unitsPerEm!

----- Method: TTFontDescription>>versionName (in category 'information') -----
versionName
	^versionName!

----- Method: TTFontDescription>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
	"Return self.  I am shared.  Do not record me."
!

Object subclass: #TTFontReader
	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).!

----- Method: TTFontReader class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
fileReaderServicesForFile: fullName suffix: suffix


	^(suffix = 'fnt')  | (suffix = '*') 
		ifTrue: [ self services]
		ifFalse: [#()]
!

----- Method: TTFontReader class>>initialize (in category 'class initialization') -----
initialize
	"self initialize"

	FileList registerFileReader: self!

----- Method: TTFontReader class>>installTTF:asTextStyle:sizes: (in category 'instance creation') -----
installTTF: ttfFileName asTextStyle: textStyleName sizes: sizeArray
	"Sizes are in pixels."
	"TTFontReader
		installTTF: 'F:\fonts\amazon:=:=.TTF' 
		asTextStyle: #Amazon
		sizes: #(24 60)"

	| ttf fontArray |
	ttf := self parseFileNamed: ttfFileName.
	fontArray := sizeArray collect:
		[:each |
		(ttf asStrikeFontScale: each / ttf unitsPerEm)
			name: textStyleName;
			pixelSize: each].
	TextConstants at: textStyleName asSymbol put: (TextStyle fontArray: fontArray)!

----- Method: TTFontReader class>>openTTFFile: (in category 'class initialization') -----
openTTFFile: fullName 

	(TTFontReader parseFileNamed: fullName) asMorph open!

----- Method: TTFontReader class>>parseFileNamed: (in category 'instance creation') -----
parseFileNamed: aString
	"TTFontReader parseFileNamed:'c:\windows\arial.ttf'"
	"TTFontReader parseFileNamed:'c:\windows\times.ttf'"
	| contents |
	contents := (FileStream readOnlyFileNamed: aString) binary contentsOfEntireFile.
	^self readFrom: (ReadStream on: contents)!

----- Method: TTFontReader class>>readFrom: (in category 'instance creation') -----
readFrom: aStream

	^self new readFrom: aStream!

----- Method: TTFontReader class>>readTTFFrom: (in category 'instance creation') -----
readTTFFrom: aStream

	^self new readTTFFrom: aStream!

----- Method: TTFontReader class>>serviceOpenTrueTypeFont (in category 'class initialization') -----
serviceOpenTrueTypeFont

	^ SimpleServiceEntry 
				provider: self 
				label: 'open true type font'
				selector: #openTTFFile:
				description: 'open true type font'!

----- Method: TTFontReader class>>services (in category 'class initialization') -----
services

	^ Array with: self serviceOpenTrueTypeFont
!

----- Method: TTFontReader class>>unload (in category 'class initialization') -----
unload

	FileList unregisterFileReader: self !

----- Method: TTFontReader>>decodeCmapFmtTable: (in category 'private') -----
decodeCmapFmtTable: entry
	| cmapFmt length cmap firstCode entryCount segCount segments offset code |
	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 |
			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!

----- Method: TTFontReader>>getGlyphFlagsFrom:size: (in category 'private') -----
getGlyphFlagsFrom: entry size: nPts
	"Read in the flags for this glyph.  The outer loop gathers the flags that
	are actually contained in the table.  If the repeat bit is set in a flag
	then the next byte is read from the table; this is the number of times
	to repeat the last flag.  The inner loop does this, incrementing the
	outer loops index each time."
	| flags index repCount flagBits |
	flags := ByteArray new: nPts.
	index := 1.
	[index <= nPts] whileTrue:[
		flagBits := entry nextByte.
		flags at: index put: flagBits.
		(flagBits bitAnd: 8) = 8 ifTrue:[
			repCount := entry nextByte.
			repCount timesRepeat:[
				index := index + 1.
				flags at: index put: flagBits]].
		index := index + 1].
	^flags!

----- Method: TTFontReader>>getTableDirEntry:from: (in category 'private') -----
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!

----- Method: TTFontReader>>macToWin: (in category 'private') -----
macToWin: index
	^ (index - 1) asCharacter macToSqueak asciiValue + 1!

----- 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!

----- 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 Unicode (0), Macintosh (1),
		or a Windows (3) encoded table"
		(#(0 1 3) includes: pID) ifTrue:[
			"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].
			assoc := pID -> cmap. "Keep it in case we don't find a better table"
		].
	].
	^assoc!

----- 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!

----- 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!

----- 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 glyph nextOffset glyphLength glyphOffset nContours origin corner |
	initialOffset := entry offset.
	glyphs := Array new: nGlyphs.
	1 to: nGlyphs do:[:i | 
		glyphs at: i put: (TTGlyph new glyphIndex: i-1)].
	'Reading glyph data' 
		displayProgressAt: Sensor cursorPoint
		from: 1 to: nGlyphs during:[:bar|

	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]]]
	].!

----- 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!

----- 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].!

----- 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!

----- Method: TTFontReader>>processKerningTable: (in category 'processing') -----
processKerningTable: entry
	"Extract the kerning information for pairs of glyphs."
	| covLow covHigh nKernPairs kp |
	entry skip: 2. "Skip table version"
	entry skip: 2. "Skip number of sub tables -- we're using the first one only"
	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].
	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!

----- 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.!

----- 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 storageOffset pID sID lID nID length offset multiBytes string strings |
	strings := Array new: 8.
	strings atAllPut:''.
	initialOffset := entry offset.
	entry skip: 2. "Skip format selector"
	"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 := 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.
			"Put the name at the right location.
			Note: We prefer Macintosh strings about everything else."
			nID < strings size ifTrue:[
				(pID = 1 or:[(strings at: nID+1) = ''])
					ifTrue:[strings at: nID+1 put: string].
			].
		].
	].
	fontDescription setStrings: strings.!

----- 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.
	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.!

----- Method: TTFontReader>>readFrom: (in category 'public') -----
readFrom: aStream

	| 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!

----- Method: TTFontReader>>readGlyphXCoords:glyph:nContours:flags:endPoints: (in category 'private') -----
readGlyphXCoords:entry glyph: glyph nContours: nContours flags: flags endPoints: endPts
	"Read the x coordinates for the given glyph from the font file."
	| startPoint endPoint flagBits xValue contour ttPoint |
	startPoint := 1.
	1 to: nContours do:[:i|
		contour := glyph contours at: i.
		"Get the end point"
		endPoint := (endPts at: i) + 1.
		"Store number of points"
		startPoint to: endPoint do:[:j|
			ttPoint := contour points at: (j - startPoint + 1).
			flagBits := flags at: j.
			"If bit zero in the flag is set then this point is an on-curve
			point, if not, then it is an off-curve point."
			(flagBits bitAnd: 1) = 1 
				ifTrue:[ ttPoint type: #OnCurve]
				ifFalse:[ttPoint type: #OffCurve].
			"First we check to see if bit one is set.  This would indicate that
			the corresponding coordinate data in the table is 1 byte long.
			If the bit is not set, then the coordinate data is 2 bytes long."
			(flagBits bitAnd: 2) = 2 ifTrue:[ "one byte"
				xValue := entry nextByte.
				xValue := (flagBits bitAnd: 16)=16 ifTrue:[xValue] ifFalse:[xValue negated].
				ttPoint x: xValue.
			] ifFalse:[ "two byte"
				"If bit four is set, then this coordinate is the same as the
				last one, so the relative offset (of zero) is stored.  If bit
				is not set, then read in two bytes and store it as a signed value."
				(flagBits bitAnd: 16) = 16 ifTrue:[ ttPoint x: 0 ]
				ifFalse:[
					xValue := entry nextShort.
					ttPoint x: xValue]]].
		startPoint := endPoint + 1]!

----- Method: TTFontReader>>readGlyphYCoords:glyph:nContours:flags:endPoints: (in category 'private') -----
readGlyphYCoords:entry glyph: glyph nContours: nContours flags: flags endPoints: endPts
	"Read the y coordinates for the given glyph from the font file."
	| startPoint endPoint flagBits yValue contour ttPoint |
	startPoint := 1.
	1 to: nContours do:[:i|
		contour := glyph contours at: i.
		"Get the end point"
		endPoint := (endPts at: i) + 1.
		"Store number of points"
		startPoint to: endPoint do:[:j|
			ttPoint := contour points at: (j - startPoint + 1).
			flagBits := flags at: j.
			"Check if this value one or two byte encoded"
			(flagBits bitAnd: 4) = 4 ifTrue:[ "one byte"
				yValue := entry nextByte.
				yValue := (flagBits bitAnd: 32)=32 ifTrue:[yValue] ifFalse:[yValue negated].
				ttPoint y: yValue.
			] ifFalse:[ "two byte"
				(flagBits bitAnd: 32) = 32 ifTrue:[ ttPoint y: 0 ]
				ifFalse:[
					yValue := entry nextShort.
					ttPoint y: yValue]]].
		startPoint := endPoint + 1]!

----- Method: TTFontReader>>warn: (in category 'private') -----
warn: aString
	Transcript cr; show: aString; endEntry.!

----- Method: TTFontReader>>winToMac: (in category 'private') -----
winToMac: index
	^ (index - 1) asCharacter squeakToMac asciiValue + 1!

Object subclass: #TTFontTableDirEntry
	instanceVariableNames: 'tag fontData offset length checkSum'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Support'!

!TTFontTableDirEntry commentStamp: '<historical>' prior: 0!
This class represents an entry in a truetype font table directory. Used by TTFontReader only.!

----- Method: TTFontTableDirEntry class>>on:at: (in category 'instance creation') -----
on: fontData at: index

	^self new on: fontData at: index!

----- Method: TTFontTableDirEntry>>nextByte (in category 'accessing') -----
nextByte

	| value |
	value := fontData byteAt: offset.
	offset := offset + 1.
	^value!

----- Method: TTFontTableDirEntry>>nextBytes:into:startingAt: (in category 'accessing') -----
nextBytes: numBytes into: array startingAt: byteOffset

	1 to: numBytes do:[:i|
		array at: i put: (fontData byteAt: byteOffset + i - 1)].!

----- Method: TTFontTableDirEntry>>nextLong (in category 'accessing') -----
nextLong

	| value |
	value := fontData longAt: offset bigEndian: true.
	offset := offset + 4.
	^value!

----- Method: TTFontTableDirEntry>>nextShort (in category 'accessing') -----
nextShort

	| value |
	value := fontData shortAt: offset bigEndian: true.
	offset := offset + 2.
	^value!

----- Method: TTFontTableDirEntry>>nextULong (in category 'accessing') -----
nextULong

	| value |
	value := fontData unsignedLongAt: offset bigEndian: true.
	offset := offset + 4.
	^value!

----- Method: TTFontTableDirEntry>>nextUShort (in category 'accessing') -----
nextUShort

	| value |
	value := fontData unsignedShortAt: offset bigEndian: true.
	offset := offset + 2.
	^value!

----- Method: TTFontTableDirEntry>>offset (in category 'accessing') -----
offset
	^offset!

----- Method: TTFontTableDirEntry>>offset: (in category 'accessing') -----
offset: newOffset
	offset := newOffset!

----- Method: TTFontTableDirEntry>>on:at: (in category 'initialize-release') -----
on: fd at: index

	fontData := fd.
	tag := fontData longAt: index bigEndian: true.
	checkSum := fontData longAt: index+4 bigEndian: true.
	offset := (fontData longAt: index+8 bigEndian: true) + 1.
	length := fontData longAt: index+12 bigEndian: true.!

----- Method: TTFontTableDirEntry>>skip: (in category 'accessing') -----
skip: n
	"Skip n bytes"
	offset := offset + n.!

----- Method: TTFontTableDirEntry>>stringAt:length:multiByte: (in category 'accessing') -----
stringAt: stringOffset length: byteLength multiByte: aBoolean

	| string index stringLength |
	aBoolean ifFalse:[
		stringLength := byteLength.
		string := String new: stringLength.
		index := stringOffset.
		1 to: stringLength do:[:i|
			string at: i put: (Character value: (fontData byteAt: index + i - 1))].
		^string
	] ifTrue:[
		stringLength := byteLength // 2.
		string := String new: stringLength.
		index := stringOffset.
		1 to: stringLength do:[:i|
			string at: i put: (Character value: (fontData byteAt: index + 1)).
			index := index + 2].
		^string]!

Object subclass: #TTGlyph
	instanceVariableNames: 'bounds contours advanceWidth leftSideBearing rightSideBearing glyphIndex'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Fonts'!

!TTGlyph commentStamp: '<historical>' prior: 0!
This class represents a glyph of a TrueType font.

Instance variables:
	bounds			<Rectangle>	The receiver's bounds
	contours		<Array of: PointArray> The compressed contours in the receiver
	advanceWidth	<Integer>	advance width of the glyph
	leftSideBearing	<Integer>	left side bearing
	rightSideBearing <Integer>	right side bearing
	glyphIndex 		<Integer>	the original index of the glyph (used for kerning)!

TTGlyph subclass: #TTCompositeGlyph
	instanceVariableNames: 'glyphs'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Fonts'!

!TTCompositeGlyph commentStamp: '<historical>' prior: 0!
This class represents a composite TrueType glyph, e.g.one which contains many simple TTGlyphs.!

----- Method: TTCompositeGlyph>>addGlyph:transformation: (in category 'accessing') -----
addGlyph: aGlyph transformation: aMatrix
	glyphs := glyphs copyWith: (aMatrix -> aGlyph)!

----- Method: TTCompositeGlyph>>computeContours (in category 'private') -----
computeContours
	| out |
	out := WriteStream on: (Array new: glyphs size * 4).
	self glyphsAndTransformationsDo:[:glyph :transform|
		glyph contours do:[:ptArray|
			out nextPut: (transform localPointsToGlobal: ptArray).
		].
	].
	^out contents!

----- Method: TTCompositeGlyph>>contours (in category 'accessing') -----
contours
	^contours ifNil:[contours := self computeContours]!

----- Method: TTCompositeGlyph>>flipAroundY (in category 'private') -----
flipAroundY
	bounds := (bounds origin x @ bounds corner y negated) corner:
				(bounds corner x @ bounds origin y negated).
	contours := nil.!

----- Method: TTCompositeGlyph>>glyphs (in category 'accessing') -----
glyphs

	^glyphs collect:[:assoc| assoc value].!

----- Method: TTCompositeGlyph>>glyphsAndTransformationsDo: (in category 'accessing') -----
glyphsAndTransformationsDo: aBlock
	glyphs do:[:assoc|
		aBlock value: assoc value value: assoc key.
	].!

----- Method: TTCompositeGlyph>>initialize (in category 'initialize') -----
initialize
	glyphs := #().!

----- Method: TTCompositeGlyph>>isComposite (in category 'testing') -----
isComposite
	^true!

----- Method: TTGlyph>>advanceWidth (in category 'accessing') -----
advanceWidth
	^advanceWidth!

----- Method: TTGlyph>>advanceWidth: (in category 'accessing') -----
advanceWidth: aNumber
	advanceWidth := aNumber.!

----- Method: TTGlyph>>asFormWithScale:ascender:descender: (in category 'converting') -----
asFormWithScale: scale ascender: ascender descender: descender
	^ self
		asFormWithScale: scale
		ascender: ascender
		descender: descender
		fgColor: Color black
		bgColor: Color white
		depth: 8
		replaceColor: true.
!

----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth: (in category 'converting') -----
asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth

	^ self
		asFormWithScale: scale
		ascender: ascender
		descender: descender
		fgColor: fgColor
		bgColor: bgColor
		depth: depth
		replaceColor: false.
!

----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor: (in category 'converting') -----
asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag

	^ self
		asFormWithScale: scale
		ascender: ascender
		descender: descender
		fgColor: fgColor
		bgColor: bgColor
		depth: depth
		replaceColor: replaceColorFlag
		lineGlyph: nil
		lingGlyphWidth: 0
		emphasis: 0.!

----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor:lineGlyph:lingGlyphWidth:emphasis: (in category 'converting') -----
asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag lineGlyph: lineGlyph lingGlyphWidth: lWidth emphasis: code

	| form canvas newScale |
	form := Form extent: (advanceWidth @ (ascender - descender) * scale) rounded depth: depth.
	form fillColor: bgColor.
	canvas := BalloonCanvas on: form.
	canvas aaLevel: 4.
	canvas transformBy: (MatrixTransform2x3 withScale: scale asPoint * (1 @ -1)).
	canvas transformBy: (MatrixTransform2x3 withOffset: 0 @ ascender negated).
	canvas
		drawGeneralBezierShape: self contours
		color: fgColor 
		borderWidth: 0 
		borderColor: fgColor.
	((code bitAnd: 4) ~= 0 or: [(code bitAnd: 16) ~= 0]) ifTrue: [
		newScale := (form width + 1) asFloat / lineGlyph calculateWidth asFloat.
		canvas transformBy: (MatrixTransform2x3 withScale: (newScale / scale)@1.0).

		(code bitAnd: 4) ~= 0 ifTrue: [
			canvas
				drawGeneralBezierShape: lineGlyph contours
				color: fgColor 
				borderWidth: 0 
				borderColor: fgColor.
		].

		(code bitAnd: 16) ~= 0 ifTrue: [
			canvas transformBy: (MatrixTransform2x3 withOffset: 0@(ascender // 2)).
			canvas
				drawGeneralBezierShape: lineGlyph contours
				color: fgColor 
				borderWidth: 0 
				borderColor: fgColor.
		].
	].

	replaceColorFlag ifTrue: [
		form replaceColor: bgColor withColor: Color transparent.
	].
	^ form!

----- Method: TTGlyph>>bounds (in category 'accessing') -----
bounds
	^bounds!

----- Method: TTGlyph>>bounds: (in category 'accessing') -----
bounds: aRectangle
	bounds := aRectangle!

----- Method: TTGlyph>>buildContours (in category 'private-initialization') -----
buildContours
	"Build the contours in the receiver glyph.
	The contour is constructed by converting the points
	form each contour into an absolute value and then
	compressing the contours into PointArrays."
	| tx ty points |
	tx := ty := 0.
	contours := contours collect:[:contour|
		points := contour points.
		points do:[:pt|
			pt x: (tx := tx + pt x).
			pt y: (ty := ty + pt y)].
		contour asCompressedPoints].!

----- Method: TTGlyph>>calculateWidth (in category 'private') -----
calculateWidth

	| min max |
	min := SmallInteger maxVal.
	max := SmallInteger minVal.
	self contours do: [:a | a do: [:p |
		p x > max ifTrue: [max := p x].
		p x < min ifTrue: [min := p x].
	]].
	^ max - min.
!

----- Method: TTGlyph>>contours (in category 'accessing') -----
contours
	^contours!

----- Method: TTGlyph>>contours: (in category 'accessing') -----
contours: aCollection
	contours := aCollection asArray.!

----- Method: TTGlyph>>display (in category 'private') -----
display
	| canvas |
	canvas := Display getCanvas.
	self contours do:[:ptArray|
		1 to: ptArray size by: 3 do:[:i|
			canvas line: (ptArray at: i) // 10
					to: (ptArray at: i+2) // 10
					width: 1 color: Color black.
		].
	].!

----- Method: TTGlyph>>flipAroundY (in category 'private') -----
flipAroundY
	bounds := (bounds origin x @ bounds corner y negated) corner:
				(bounds corner x @ bounds origin y negated).
	contours := self contours collect:[:contour| contour collect:[:pt| pt x @ pt y negated]].!

----- Method: TTGlyph>>glyphIndex (in category 'accessing') -----
glyphIndex
	^glyphIndex!

----- Method: TTGlyph>>glyphIndex: (in category 'accessing') -----
glyphIndex: anInteger
	glyphIndex := anInteger!

----- Method: TTGlyph>>glyphsAndTransformationsDo: (in category 'accessing') -----
glyphsAndTransformationsDo: aBlock
	aBlock value: self value: MatrixTransform2x3 identity!

----- Method: TTGlyph>>initialize (in category 'initialize-release') -----
initialize

	bounds := 0 at 0 corner: 0 at 0.
	contours := #().
	advanceWidth := 0.
	leftSideBearing := 0.
	rightSideBearing := 0.!

----- Method: TTGlyph>>initializeContours:with: (in category 'private-initialization') -----
initializeContours: numContours with: endPoints
	"Initialize the contours for creation of the glyph."
	| startPt pts endPt |
	contours := Array new: numContours.
	startPt := -1.
	1 to: numContours do:[:i|
		endPt := endPoints at: i.
		pts := Array new: endPt - startPt.
		1 to: pts size do:[:j| pts at: j put: TTPoint new].
		contours at: i put: (TTContourConstruction on: pts).
		startPt := endPt].!

----- Method: TTGlyph>>isComposite (in category 'testing') -----
isComposite
	^false!

----- Method: TTGlyph>>leftSideBearing (in category 'accessing') -----
leftSideBearing
	^leftSideBearing!

----- Method: TTGlyph>>leftSideBearing: (in category 'accessing') -----
leftSideBearing: aNumber
	leftSideBearing := aNumber.!

----- Method: TTGlyph>>printOn: (in category 'printing') -----
printOn: aStream

	aStream
		nextPutAll: self class name;
		nextPut:$(;
		print: (contours ifNil: [0] ifNotNil: [contours size]);
		nextPut:$).!

----- Method: TTGlyph>>rightSideBearing (in category 'accessing') -----
rightSideBearing
	^rightSideBearing!

----- Method: TTGlyph>>rightSideBearing: (in category 'accessing') -----
rightSideBearing: aNumber
	rightSideBearing := aNumber.!

----- Method: TTGlyph>>updateRightSideBearing (in category 'private-initialization') -----
updateRightSideBearing
	"Update the right side bearing value"
	"@@: Is the following really correct?!!?!!"
	rightSideBearing := advanceWidth - leftSideBearing - bounds corner x + bounds origin x!

Object subclass: #TTKernPair
	instanceVariableNames: 'left right value mask'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Fonts'!

!TTKernPair commentStamp: '<historical>' prior: 0!
A TTKernPair represents a TrueType kerning pair.

Instance variables:
	left	<Integer>	The glyph index for the left character.
	right <Integer>	The glyph index for the right character.
	value <Integer>	The amount of kerning.
	mask <Integer>	An efficient representation for the left and the right value.!

----- Method: TTKernPair class>>maskFor:with: (in category 'accessing') -----
maskFor: left with: right
	^(left bitShift: 12) + right!

----- Method: TTKernPair>>left (in category 'accessing') -----
left
	^left!

----- Method: TTKernPair>>left: (in category 'accessing') -----
left: aNumber

	left := aNumber!

----- Method: TTKernPair>>mask (in category 'accessing') -----
mask
	^mask ifNil:[mask := self class maskFor: left with: right]!

----- Method: TTKernPair>>right (in category 'accessing') -----
right
	^right!

----- Method: TTKernPair>>right: (in category 'accessing') -----
right: aNumber

	right := aNumber!

----- Method: TTKernPair>>value (in category 'accessing') -----
value
	^value!

----- Method: TTKernPair>>value: (in category 'accessing') -----
value: aNumber

	value := aNumber!

Object subclass: #TTPoint
	instanceVariableNames: 'x y type'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TrueType-Support'!

!TTPoint commentStamp: '<historical>' prior: 0!
A representation of a TrueType point which includes a 'type' flag defining whether this point is an 'on' or an 'off' curve point.!

----- Method: TTPoint>>asPoint (in category 'converting') -----
asPoint
	^x at y!

----- Method: TTPoint>>printOn: (in category 'printing') -----
printOn: aStream

	aStream 
		nextPutAll: self class name;
		nextPut:$(;
		print: x;
		nextPut:$@;
		print: y;
		nextPut:$|;
		print: type;
		nextPut:$)!

----- Method: TTPoint>>type (in category 'accessing') -----
type
	^type!

----- Method: TTPoint>>type: (in category 'accessing') -----
type: aSymbol

	type := aSymbol!

----- Method: TTPoint>>x (in category 'accessing') -----
x
	^x!

----- Method: TTPoint>>x: (in category 'accessing') -----
x: aNumber

	x := aNumber!

----- Method: TTPoint>>y (in category 'accessing') -----
y
	^y!

----- Method: TTPoint>>y: (in category 'accessing') -----
y: aNumber
	y := aNumber!



More information about the Packages mailing list