'From etoys2.3 of 28 November 2007 [latest update: #1820] on 6 December 2007 at 12:20:54 am'!
"Change Set:		UnicodeFontLoading-bf-yo
Date:			5 December 2007
Author:			Yoshiki Ohshima

Enable to load a part of a large set of font and save it to a file."!


!Locale class methodsFor: 'accessing' stamp: 'yo 12/6/2007 00:09'!
switchAndInstallFontToID: localeID gently: gentlyFlag

	| locale |
	locale := Locale localeID: localeID.
	locale languageEnvironment isFontAvailable
		ifFalse: [(self confirm: 'This language needs additional fonts.
Do you want to install the fonts?' translated)
				ifTrue: [locale languageEnvironment installFont. StrikeFont setupDefaultFallbackTextStyle]
				ifFalse: [ self]].

	self switchTo: locale gently: gentlyFlag
! !


!TTCFontDescription methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 22:22'!
compactForRanges: rangesArray

	| newGlyphs |
	newGlyphs :=  SparseLargeTable new: rangesArray last last chunkSize: 32 arrayClass: Array base: 0 + 1 defaultValue: (glyphs at: 1).
	rangesArray do: [:pair |
		pair first to: pair second do: [:i |
			newGlyphs at: i put: (glyphs at: i)
		]
	].
	glyphs _ newGlyphs.
! !


!TTCFontDescription class methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 23:07'!
addFromSmartRefStream: ref

	| tt old |
	tt := ref nextAndClose.

	old _ TTCDescriptions detect: [:f | f first name = tt first name] ifNone: [nil].
	old ifNotNil: [TTCDescriptions remove: old].
	TTCDescriptions add: tt.
	^ tt.
! !


!TTCFontReader methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 22:06'!
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: [
			"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! !


!TTCFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 23:30'!
installExternalFontFileName: aFileName
"
	TTCFontSet installExternalFontFileName: 'greekDeja.out'.
"
	| f |
	f _ FileStream readOnlyFileNamed: aFileName.
	TTCFontSet newTextStyleFromSmartRefStream: (SmartRefStream on: f)..
	f close.
! !

!TTCFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 23:30'!
makeSmartRefFileFrom: aTTFFileName encodingTag: anInteger ranges: ranges
"
	TTCFontSet
		makeSmartRefFileFrom: 'C:\tmp\DejaVuSans.ttf'
		encodingTag: GreekEnvironment leadingChar
		ranges: EFontBDFFontReaderForRanges rangesForGreek.
"
	| newStyle f ref |
	TTCFontReader encodingTag: anInteger.
	newStyle _ TTCFontSet newTextStyleFromTTFile: aTTFFileName.
	((TTCFontDescription descriptionNamed: newStyle fontArray first fontArray first familyName) at: anInteger + 1) compactForRanges: ranges.

	f _ FileStream newFileNamed:  'greekDeja.out'.
	TextConstants at: #forceFontWriting put: true.
	ref _ SmartRefStream on: f.
	ref nextPut: (TTCFontDescription descriptionNamed: 'DejaVuSans').
	ref close.
	TextConstants at: #forceFontWriting put: false.
	f close.! !

!TTCFontSet class methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2007 23:19'!
newTextStyleFromSmartRefStream: ref

	| description |
	description _ TTCFontDescription addFromSmartRefStream: ref.
	^ self newTextStyleFromTT: description.
! !