[Pkg] The Trunk: Multilingual-nice.171.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Sep 24 20:58:57 UTC 2013


Nicolas Cellier uploaded a new version of Multilingual to project The Trunk:
http://source.squeak.org/trunk/Multilingual-nice.171.mcz

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

Name: Multilingual-nice.171
Author: nice
Time: 24 September 2013, 10:58:23.55 pm
UUID: 672082da-ae06-4d9b-9b44-7baa41ce72e3
Ancestors: Multilingual-tpr.170

Remove presentation* from MultiCharacterScanner

=============== Diff against Multilingual-tpr.170 ===============

Item was changed:
  Object subclass: #MultiCharacterScanner
+ 	instanceVariableNames: 'destX lastIndex destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks pendingKernX baselineY firstDestX lastWidth'
- 	instanceVariableNames: 'destX lastIndex destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks pendingKernX baselineY firstDestX presentation presentationLine numOfComposition lastWidth'
  	classVariableNames: 'DefaultStopConditions NilCondition PaddedSpaceCondition SpaceCondition'
  	poolDictionaries: 'TextConstants'
  	category: 'Multilingual-Scanning'!

Item was changed:
  ----- Method: MultiCharacterScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
  scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
  "appears to be unused"
  	| charCode encoding f startEncoding combining combined combiningIndex c |
  	lastIndex := startIndex.
  	lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun].
  	startEncoding := (sourceString at: startIndex) leadingChar.
  	font ifNil: [font := (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
  	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
  		f := [font fontArray at: startEncoding + 1]
  			on: Exception do: [:ex | nil].
  		f ifNil: [ f := font fontArray at: 1].
  	].
  
  	spaceWidth := font widthOf: Space.
  	combining := nil.
  	[lastIndex <= stopIndex] whileTrue: [
  		charCode := (sourceString at: lastIndex) charCode.
  		c := (sourceString at: lastIndex).
  		combining ifNil: [
  			combining := CombinedChar new.
  			combining add: c.
  			combiningIndex := lastIndex.
  			lastIndex := lastIndex + 1.
  		] ifNotNil: [
  			(combining add: c) ifFalse: [
  				self addCharToPresentation: (combined := combining combined).
  				combining := CombinedChar new.
  				combining add: c.
  				charCode := combined charCode.
  				encoding := combined leadingChar.
  				encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1.
  					(encoding = 0 and: [charCode < 256 and:[(stops at: charCode + 1) notNil]]) ifTrue: [
  						^ stops at: charCode + 1
  					] ifFalse: [
  						 ^ stops endOfRun
  					].
  				].
  				(encoding = 0 and: [charCode < 256 and:[(stops at: charCode + 1) notNil]]) ifTrue: [
  					combining ifNotNil: [
  						self addCharToPresentation: (combining combined).
  					].
  					^ stops at: charCode + 1
  				].
  				(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) ifTrue: [
  					self registerBreakableIndex.
  				].		
  				destX > rightX ifTrue: [
  					destX ~= firstDestX ifTrue: [
  						lastIndex := combiningIndex.
  						self removeLastCharFromPresentation.
  						^ stops crossedX]].
  				combiningIndex := lastIndex.
  				lastIndex := lastIndex + 1.
  			] ifTrue: [
  				lastIndex := lastIndex + 1.
- 				numOfComposition := numOfComposition + 1.
  			].
  		].
  	].
  	lastIndex := stopIndex.
  	combining ifNotNil: [
  		combined := combining combined.
  		self addCharToPresentation: combined.
  	].
  	^ stops endOfRun!

Item was removed:
- ----- Method: MultiCompositionScanner>>addCharToPresentation: (in category 'multilingual scanning') -----
- addCharToPresentation: char
- "appears to be unused, see also scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern:"
- 	presentation nextPut: char.
- 	super addCharToPresentation: char!

Item was changed:
  ----- Method: MultiCompositionScanner>>columnBreak (in category 'stop conditions') -----
  columnBreak
  
  	"Answer true. Set up values for the text line interval currently being 
  	composed."
  
  	pendingKernX := 0.
  	line stop: lastIndex.
- 	presentationLine stop: lastIndex - numOfComposition.
  	spaceX := destX.
  	line paddingWidth: rightMargin - spaceX.
- 	presentationLine paddingWidth: rightMargin - spaceX.
  	^true!

Item was changed:
  ----- Method: MultiCompositionScanner>>composeLine:fromCharacterIndex:inParagraph: (in category 'scanning') -----
  composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph 
  	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
  	| runLength stopCondition |
  	destX := spaceX := leftMargin := aParagraph leftMarginForCompositionForLine: lineIndex.
  	destY := 0.
  	rightMargin := aParagraph rightMarginForComposition.
  	leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose'].
  	lastIndex := startIndex.	"scanning sets last index"
  	lineHeight := textStyle lineGrid.  "may be increased by setFont:..."
  	baseline := textStyle baseline.
  	baselineY := destY + baseline.
  	self setStopConditions.	"also sets font"
  	self handleIndentation.
  	runLength := text runLengthFor: startIndex.
  	runStopIndex := (lastIndex := startIndex) + (runLength - 1).
  	line := TextLineInterval
  		start: lastIndex
  		stop: 0
  		internalSpaces: 0
  		paddingWidth: 0.
- 	presentationLine := TextLineInterval
- 		start: lastIndex
- 		stop: 0
- 		internalSpaces: 0
- 		paddingWidth: 0.
- 	numOfComposition := 0.
- 	presentation := TextStream on: (Text fromString: (WideString new: text size)).
  	spaceCount := 0.
  	
  	[stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
  		in: text string rightX: rightMargin stopConditions: stopConditions
  		kern: kern.
  	"See setStopConditions for stopping conditions for composing."
  	self perform: stopCondition] whileFalse.
  
- 	presentationLine
- 		lineHeight: lineHeight + textStyle leading
- 		baseline: baseline + textStyle leading.
  	^line
  		lineHeight: lineHeight + textStyle leading
  		baseline: baseline + textStyle leading!

Item was changed:
  ----- Method: MultiCompositionScanner>>cr (in category 'stop conditions') -----
  cr
  	"Answer true. Set up values for the text line interval currently being 
  	composed."
  
  	pendingKernX := 0.
  	(lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 1].
  	line stop: lastIndex.
- 	presentationLine stop: lastIndex - numOfComposition.
  	spaceX := destX.
  	line paddingWidth: rightMargin - spaceX.
- 	presentationLine paddingWidth: rightMargin - spaceX.
  	^true!

Item was changed:
  ----- Method: MultiCompositionScanner>>crossedX (in category 'stop conditions') -----
  crossedX
  	"There is a word that has fallen across the right edge of the composition 
  	rectangle. This signals the need for wrapping which is done to the last 
  	space that was encountered, as recorded by the space stop condition."
  
  	pendingKernX := 0.
  	(breakAtSpace) ifTrue: [
  		spaceCount >= 1 ifTrue:
  			["The common case. First back off to the space at which we wrap."
  			line stop: breakableIndex.
- 			presentationLine stop: breakableIndex - numOfComposition.
  			lineHeight := lineHeightAtBreak.
  			baseline := baselineAtBreak.
  			spaceCount := spaceCount - 1.
  			breakableIndex := breakableIndex - 1.
  
  			"Check to see if any spaces preceding the one at which we wrap.
  				Double space after punctuation, most likely."
  			[(spaceCount > 1 and: [(text at: breakableIndex) = Space])]
  				whileTrue:
  					[spaceCount := spaceCount - 1.
  					"Account for backing over a run which might
  						change width of space."
  					font := text fontAt: breakableIndex withStyle: textStyle.
  					breakableIndex := breakableIndex - 1.
  					spaceX := spaceX - (font widthOf: Space)].
  			line paddingWidth: rightMargin - spaceX.
- 			presentationLine paddingWidth: rightMargin - spaceX.
- 			presentationLine internalSpaces: spaceCount.
  			line internalSpaces: spaceCount]
  		ifFalse:
  			["Neither internal nor trailing spaces -- almost never happens."
  			lastIndex := lastIndex - 1.
  			[destX <= rightMargin]
  				whileFalse:
  					[destX := destX - (font widthOf: (text at: lastIndex)).
  					lastIndex := lastIndex - 1].
  			spaceX := destX.
  			line paddingWidth: rightMargin - destX.
- 			presentationLine paddingWidth: rightMargin - destX.
- 			presentationLine stop: (lastIndex max: line first).
  			line stop: (lastIndex max: line first)].
  		^true
  	].
  
  	(breakableIndex isNil or: [breakableIndex < line first]) ifTrue: [
  		"Any breakable point in this line.  Just wrap last character."
  		breakableIndex := lastIndex - 1.
  		lineHeightAtBreak := lineHeight.
  		baselineAtBreak := baseline.
  	].
  
  	"It wasn't a space, but anyway this is where we break the line."
  	line stop: breakableIndex.
- 	presentationLine stop: breakableIndex.
  	lineHeight := lineHeightAtBreak.
  	baseline := baselineAtBreak.
  	^ true.
  !

Item was changed:
  ----- Method: MultiCompositionScanner>>endOfRun (in category 'stop conditions') -----
  endOfRun
  	"Answer true if scanning has reached the end of the paragraph. 
  	Otherwise step conditions (mostly install potential new font) and answer 
  	false."
  
  	| runLength |
  	lastIndex = text size
  	ifTrue:	[line stop: lastIndex.
- 			presentationLine stop: lastIndex - numOfComposition.
  			spaceX := destX.
  			line paddingWidth: rightMargin - destX.
- 			presentationLine paddingWidth: rightMargin - destX.
  			^true]
  	ifFalse:	[
  			"(text at: lastIndex) charCode = 32 ifTrue: [destX := destX + spaceWidth]."
  			runLength := (text runLengthFor: (lastIndex := lastIndex + 1)).
  			runStopIndex := lastIndex + (runLength - 1).
  			self setStopConditions.
  			^false]
  !

Item was removed:
- ----- Method: MultiCompositionScanner>>getPresentation (in category 'multilingual scanning') -----
- getPresentation
- 
- 	^ presentation contents.
- 
- !

Item was removed:
- ----- Method: MultiCompositionScanner>>getPresentationLine (in category 'multilingual scanning') -----
- getPresentationLine
- 
- 	^ presentationLine.
- !

Item was changed:
  ----- Method: MultiCompositionScanner>>placeEmbeddedObject: (in category 'stop conditions') -----
  placeEmbeddedObject: anchoredMorph
  	| descent |
  	"Workaround: The following should really use #textAnchorType"
  	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
  	(super placeEmbeddedObject: anchoredMorph) ifFalse: ["It doesn't fit"
  		"But if it's the first character then leave it here"
  		lastIndex < line first ifFalse:[
  			line stop: lastIndex-1.
  			^ false]].
  	descent := lineHeight - baseline.
  	lineHeight := lineHeight max: anchoredMorph height.
  	baseline := lineHeight - descent.
  	line stop: lastIndex.
- 	presentationLine stop: lastIndex - numOfComposition.
  	^ true!

Item was removed:
- ----- Method: MultiCompositionScanner>>presentation (in category 'accessing') -----
- presentation
- 
- 	^ presentation.
- !

Item was removed:
- ----- Method: MultiCompositionScanner>>presentationLine (in category 'accessing') -----
- presentationLine
- 
- 	^ presentationLine.
- !

Item was removed:
- ----- Method: MultiCompositionScanner>>removeLastCharFromPresentation (in category 'multilingual scanning') -----
- removeLastCharFromPresentation
- "appears to be unused"
- 
- 	presentation ifNotNil: [
- 		presentation position: presentation position - 1.
- 	].
- 	super removeLastCharFromPresentation!



More information about the Packages mailing list