'From Cuis 1.0 of 16 July 2009 [latest update: #228] on 27 July 2009 at 2:05:34 pm'!
!classDefinition: #CharacterScanner category: #'Graphics-Text'!
Object subclass: #CharacterScanner
	instanceVariableNames: 'destX lastIndex xTable map destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel '
	classVariableNames: 'DefaultStopConditions '
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #Text category: #'System-Text'!
ArrayedCollection subclass: #Text
	instanceVariableNames: 'string runs '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'fontArray lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading defaultFontIndex '
	classVariableNames: 'AXXvailableTextStyles AvailableTextStyles DXXefaultTextStyle DefaultTextStyle '
	poolDictionaries: ''
	category: 'Graphics-Text'!

!CharacterScanner methodsFor: 'private' stamp: 'jmv 7/27/2009 12:54'!
setFont
	| priorFont |
	"Set the font and other emphasis."
	priorFont _ font.
	text == nil ifFalse:[
		emphasisCode _ 0.
		kern _ 0.
		indentationLevel _ 0.
		alignment _ textStyle alignment.
		font _ nil.
		(text attributesAt: lastIndex forStyle: textStyle)
			do: [:att | att emphasizeScanner: self]].
	font == nil ifTrue:
		[self setFont: textStyle defaultFontIndex].
	font _ font emphasized: emphasisCode.
	priorFont ifNotNil: [destX _ destX + priorFont descentKern].
	destX _ destX - font descentKern.
	"NOTE: next statement should be removed when clipping works"
	leftMargin ifNotNil: [destX _ destX max: leftMargin].
	kern _ kern - font baseKern.

	"Install various parameters from the font."
	spaceWidth _ font widthOf: Character space.
	xTable _ font xTable.
	map _ font characterToGlyphMap.
	stopConditions _ DefaultStopConditions.! !

!CharacterScanner methodsFor: 'scanning' stamp: 'jmv 7/27/2009 12:57'!
leadingTab
	"return true if only tabs lie to the left"
	line first to: lastIndex do:
		[:i | (text at: i) == Character tab ifFalse: [^ false]].
	^ true! !

!CharacterScanner methodsFor: 'scanning' stamp: 'jmv 7/27/2009 12:45'!
plainTab
	"This is the basic method of adjusting destX for a tab."
	destX _ (alignment = CharacterScanner justifiedCode and: [self leadingTab not])
		ifTrue:		"embedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: 
			[textStyle nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin]! !

!CharacterScanner methodsFor: 'scanning' stamp: 'jmv 7/27/2009 12:51'!
scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
	"Primitive. This is the inner loop of text display--but see 
	scanCharactersFrom: to:rightX: which would get the string, 
	stopConditions and displaying from the instance. March through source 
	String from startIndex to stopIndex. If any character is flagged with a 
	non-nil entry in stops, then return the corresponding value. Determine 
	width of each character from xTable, indexed by map. 
	If dextX would exceed rightX, then return stops at: 258. 
	Advance destX by the width of the character. If stopIndex has been
	reached, then return stops at: 257. Optional. 
	See Object documentation whatIsAPrimitive."
	| ascii nextDestX char |
	<primitive: 103>
	lastIndex _ startIndex.
	[lastIndex <= stopIndex]
		whileTrue: 
			[char _ (sourceString at: lastIndex).
			ascii _ char asciiValue + 1.
			(stops at: ascii) == nil ifFalse: [^stops at: ascii].
			"Note: The following is querying the font about the width
			since the primitive may have failed due to a non-trivial
			mapping of characters to glyphs or a non-existing xTable."
			nextDestX _ destX + (font widthOf: char).
			nextDestX > rightX ifTrue: [^stops at: CharacterScanner crossedXCode].
			destX _ nextDestX + kernDelta.
			lastIndex _ lastIndex + 1].
	lastIndex _ stopIndex.
	^stops at: CharacterScanner endOfRunCode! !

!CharacterScanner methodsFor: 'initialize' stamp: 'jmv 7/27/2009 12:50'!
initializeStringMeasurer
	stopConditions _ Array new: 258.
	stopConditions at: CharacterScanner crossedXCode put: #crossedX.
	stopConditions at: CharacterScanner endOfRunCode put: #endOfRun.
! !

!CharacterScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:59'!
lf
	(lastIndex > 1 and: [ (text at: lastIndex-1) = Character cr ])
		ifTrue: [ 
			destX _ destX + (font widthOf: Character lf).
			lastIndex _ lastIndex + 1.
			^ false ].
	^self cr! !


!CanvasCharacterScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:54'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	stopConditions 
		at: Character space asciiValue + 1 
		put: (alignment = CharacterScanner justifiedCode ifTrue: [#paddedSpace])! !

!CanvasCharacterScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:44'!
tab

	destX _ (alignment == CharacterScanner justifiedCode and: [self leadingTab not])
		ifTrue:		"imbedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: 
			[textStyle nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin].

	lastIndex _ lastIndex + 1.
	^ false! !


!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:59'!
cr 
	"Answer a CharacterBlock that specifies the current location of the mouse 
	relative to a carriage return stop condition that has just been 
	encountered. The ParagraphEditor convention is to denote selections by 
	CharacterBlocks, sometimes including the carriage return (cursor is at 
	the end) and sometimes not (cursor is in the middle of the text)."

	((characterIndex ~= nil
		and: [characterIndex > text size])
			or: [(line last = text size)
				and: [(destY + line lineHeight) < characterPoint y]])
		ifTrue:	["When off end of string, give data for next character"
				destY _ destY +  line lineHeight.
				lastCharacter _ nil.
				characterPoint _ (nextLeftMargin ifNil: [leftMargin]) @ destY.
				lastIndex _ lastIndex + 1.
				self lastCharacterExtentSetX: 0.
				^ true].
		lastCharacter _ Character cr.
		characterPoint _ destX @ destY.
		self lastCharacterExtentSetX: rightMargin - destX.
		^true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 13:02'!
crossedX
	"Text display has wrapping. The scanner just found a character past the x 
	location of the cursor. We know that the cursor is pointing at a character 
	or before one."

	| leadingTab currentX |
	characterIndex == nil ifFalse: [
		"If the last character of the last line is a space,
		and it crosses the right margin, then locating
		the character block after it is impossible without this hack."
		characterIndex > text size ifTrue: [
			lastIndex _ characterIndex.
			characterPoint _ (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
			^true]].
	characterPoint x <= (destX + (lastCharacterExtent x // 2))
		ifTrue:	[lastCharacter _ (text at: lastIndex).
				characterPoint _ destX @ destY.
				^true].
	lastIndex >= line last 
		ifTrue:	[lastCharacter _ (text at: line last).
				characterPoint _ destX @ destY.
				^true].

	"Pointing past middle of a character, return the next character."
	lastIndex _ lastIndex + 1.
	lastCharacter _ text at: lastIndex.
	currentX _ destX + lastCharacterExtent x + kern.
	self lastCharacterExtentSetX: (font widthOf: lastCharacter).
	characterPoint _ currentX @ destY.
	lastCharacter = Character space ifFalse: [^ true].

	"Yukky if next character is space or tab."
	alignment = CharacterScanner justifiedCode ifTrue:
		[self lastCharacterExtentSetX:
			(lastCharacterExtent x + 	(line justifiedPadFor: (spaceCount + 1))).
		^ true].

	true ifTrue: [^ true].
	"NOTE:  I find no value to the following code, and so have defeated it - DI"

	"See tabForDisplay for illumination on the following awfulness."
	leadingTab _ true.
	line first to: lastIndex - 1 do:
		[:index | (text at: index) ~= Character tab ifTrue: [leadingTab _ false]].
	(alignment ~= CharacterScanner justifiedCode or: [leadingTab])
		ifTrue:	[self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX
					leftMargin: leftMargin rightMargin: rightMargin) -
						currentX]
		ifFalse:	[self lastCharacterExtentSetX:  (((currentX + (textStyle tabWidth -
						(line justifiedTabDeltaFor: spaceCount))) -
							currentX) max: 0)].
	^ true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:57'!
endOfRun
	"Before arriving at the cursor location, the selection has encountered an 
	end of run. Answer false if the selection continues, true otherwise. Set 
	up indexes for building the appropriate CharacterBlock."

	| runLength lineStop |
	((characterIndex ~~ nil and:
		[runStopIndex < characterIndex and: [runStopIndex < text size]])
			or:	[characterIndex == nil and: [lastIndex < line last]])
		ifTrue:	["We're really at the end of a real run."
				runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)).
				characterIndex ~~ nil
					ifTrue:	[lineStop _ characterIndex	"scanning for index"]
					ifFalse:	[lineStop _ line last			"scanning for point"].
				(runStopIndex _ lastIndex + (runLength - 1)) > lineStop
					ifTrue: 	[runStopIndex _ lineStop].
				self setStopConditions.
				^false].

	lastCharacter _ text at: lastIndex.
	characterPoint _ destX @ destY.
	((lastCharacter = Character space and: [alignment = CharacterScanner justifiedCode])
		or: [lastCharacter = Character tab and: [lastSpaceOrTabExtent notNil]])
		ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent].
	characterIndex ~~ nil
		ifTrue:	["If scanning for an index and we've stopped on that index,
				then we back destX off by the width of the character stopped on
				(it will be pointing at the right side of the character) and return"
				runStopIndex = characterIndex
					ifTrue:	[self characterPointSetX: destX - lastCharacterExtent x.
							^true].
				"Otherwise the requested index was greater than the length of the
				string.  Return string size + 1 as index, indicate further that off the
				string by setting character to nil and the extent to 0."
				lastIndex _  lastIndex + 1.
				lastCharacter _ nil.
				self lastCharacterExtentSetX: 0.
				^true].

	"Scanning for a point and either off the end of the line or off the end of the string."
	runStopIndex = text size
		ifTrue:	["off end of string"
				lastIndex _  lastIndex + 1.
				lastCharacter _ nil.
				self lastCharacterExtentSetX: 0.
				^true].
	"just off end of line without crossing x"
	lastIndex _ lastIndex + 1.
	^true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:54'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	alignment = CharacterScanner justifiedCode ifTrue:[
		"Make a local copy of stop conditions so we don't modify the default"
		stopConditions == DefaultStopConditions 
			ifTrue:[stopConditions _ stopConditions copy].
		stopConditions at: Character space asciiValue + 1 put: #paddedSpace]! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:45'!
tab
	| currentX |
	currentX _ (alignment = CharacterScanner justifiedCode and: [self leadingTab not])
		ifTrue:		"imbedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse:
			[textStyle
				nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin].
	lastSpaceOrTabExtent _ lastCharacterExtent copy.
	self lastSpaceOrTabExtentSetX: (currentX - destX max: 0).
	currentX >= characterPoint x
		ifTrue: 
			[lastCharacterExtent _ lastSpaceOrTabExtent copy.
			^ self crossedX].
	destX _ currentX.
	lastIndex _ lastIndex + 1.
	^false! !


!CharacterScanner class methodsFor: 'class initialization' stamp: 'jmv 7/27/2009 12:59'!
initialize
	"CharacterScanner initialize"
	"NewCharacterScanner initialize"
	| stopConditions |
	stopConditions _ Array new: 258.
	stopConditions atAllPut: nil.
	stopConditions at: 1+1 put: #embeddedObject.
	stopConditions at: Character space asciiValue + 1 put: nil.
	stopConditions at: Character tab asciiValue + 1 put: #tab.
	stopConditions at: Character lf asciiValue + 1 put: #lf.
	stopConditions at: Character cr asciiValue + 1 put: #cr.
	stopConditions at: CharacterScanner endOfRunCode put: #endOfRun.
	stopConditions at: CharacterScanner crossedXCode put: #crossedX.
	DefaultStopConditions _ stopConditions.! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:41'!
centeredCode
	^2! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:49'!
crossedXCode
	^258! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:49'!
endOfRunCode
	^ 257! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:41'!
justifiedCode
	^3! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:42'!
leftFlushCode
	^0! !

!CharacterScanner class methodsFor: 'constants' stamp: 'jmv 7/27/2009 12:42'!
rightFlushCode
	^1! !


!CompositionScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 13:03'!
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."

	spaceCount >= 1 ifTrue:
		["The common case. First back off to the space at which we wrap."
		line stop: spaceIndex.
		lineHeight _ lineHeightAtSpace.
		baseline _ baselineAtSpace.
		spaceCount _ spaceCount - 1.
		spaceIndex _ spaceIndex - 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: spaceIndex) = Character space])]
			whileTrue:
				[spaceCount _ spaceCount - 1.
				"Account for backing over a run which might
					change width of space."
				font _ text fontAt: spaceIndex withStyle: textStyle.
				spaceIndex _ spaceIndex - 1.
				spaceX _ spaceX - (font widthOf: Character space)].
		line paddingWidth: rightMargin - spaceX.
		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.
		line stop: (lastIndex max: line first)].
	^true! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:55'!
setFont
	super setFont.
	stopConditions == DefaultStopConditions 
		ifTrue:[stopConditions _ stopConditions copy].
	stopConditions at: Character space asciiValue + 1 put: #space.! !


!DisplayScanner methodsFor: 'stop conditions' stamp: 'jmv 7/27/2009 12:55'!
setStopConditions
	"Set the font and the stop conditions for the current run."
	
	self setFont.
	alignment = CharacterScanner justifiedCode ifTrue:[
		"Make a local copy of stop conditions so we don't modify the default"
		stopConditions == DefaultStopConditions 
			ifTrue:[stopConditions _ stopConditions copy].
		stopConditions at: Character space asciiValue + 1 put: #paddedSpace]! !


!Text class methodsFor: 'class initialization' stamp: 'jmv 7/27/2009 13:11'!
initialize	"Text initialize"
	"Initialize constants shared by classes associated with text display."! !


!TextStyle methodsFor: 'accessing' stamp: 'jmv 7/27/2009 12:32'!
alignment: anInteger 
	"Set the current setting of the alignment to be anInteger:
	0=left flush, 1=right flush, 2=centered, 3=justified."
	
	| justified |
	justified _ 3.
	alignment _ anInteger \\ (justified + 1)! !

!TextStyle methodsFor: 'tabs and margins' stamp: 'jmv 7/27/2009 13:05'!
tabWidth
	"Answer the width of a tab."

	^TextStyle defaultTab! !

!TextStyle methodsFor: 'private' stamp: 'jmv 7/27/2009 13:10'!
newFontArray: anArray
	"Currently there is no supporting protocol for changing these arrays. If an editor wishes to implement margin setting, then a copy of the default should be stored with these instance variables.  
	, Make size depend on first font."

	fontArray _ anArray.
	lineGrid _ (fontArray at: 1) height + leading.	"For whole family"
	baseline _ (fontArray at: 1) ascent + leading.
	alignment _ 0.
	firstIndent _ 0.
	restIndent _ 0.
	rightIndent _ 0.
	tabsArray _ TextStyle defaultTabsArray.
	marginTabsArray _ TextStyle defaultMarginTabsArray
"
TextStyle allInstancesDo: [:ts | ts newFontArray: TextStyle default fontArray].
"! !


!TextStyle class methodsFor: 'class initialization' stamp: 'jmv 7/27/2009 12:23'!
initialize
	AvailableTextStyles _ Dictionary new! !

!TextStyle class methodsFor: 'constants' stamp: 'jmv 7/27/2009 13:07'!
defaultMarginTabsArray
	^#(#(24 24) #(48 48) #(72 72) #(96 96) #(120 120) #(144 144) #(168 168) #(192 192) #(216 216) #(240 240) #(264 264) #(288 288) #(312 312) #(336 336) #(360 360) #(384 384) #(408 408) #(432 432) #(456 456) #(480 480) #(504 504) #(528 528) #(552 552) #(576 576) #(600 600) #(624 624) #(648 648) #(672 672) #(696 696) #(720 720) #(744 744) #(768 768))! !

!TextStyle class methodsFor: 'constants' stamp: 'jmv 7/27/2009 13:05'!
defaultTab
	^24! !

!TextStyle class methodsFor: 'constants' stamp: 'jmv 7/27/2009 13:07'!
defaultTabsArray
	^#(24 48 72 96 120 144 168 192 216 240 264 288 312 336 360 384 408 432 456 480 504 528 552 576 600 624 648 672 696 720 744 768 792 816 840 864 888 912 936 960 984 1008 1032 1056 1080 1104 1128 1152 1176 1200 1224 1248 1272 1296 1320 1344 1368 1392 1416 1440 1464 1488 1512 1536 1560)! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
availableTextStyles
	"Answer the names of the known text styles, sorted in alphabetical order"

	"TextStyle availableTextStyles"
	^ AvailableTextStyles! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
default
	"Answer the system default text style."

	^DefaultTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
default: aTextStyle
	"Answer the system default text style."

	DefaultTextStyle _ aTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
named: aSymbol

	^ AvailableTextStyles at: aSymbol! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
named: aSymbol put: aTextStyle

	AvailableTextStyles at: aSymbol put: aTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 12:23'!
removeNamed: aSymbol

	AvailableTextStyles removeKey: aSymbol! !

TextStyle initialize!
!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'fontArray lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading defaultFontIndex'
	classVariableNames: 'AvailableTextStyles DefaultTextStyle'
	poolDictionaries: ''
	category: 'Graphics-Text'!
Text class removeSelector: #initTextConstants!
Text initialize!
!classDefinition: #Text category: #'System-Text'!
ArrayedCollection subclass: #Text
	instanceVariableNames: 'string runs'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!
CharacterScanner initialize!
!classDefinition: #CharacterScanner category: #'Graphics-Text'!
Object subclass: #CharacterScanner
	instanceVariableNames: 'destX lastIndex xTable map destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel'
	classVariableNames: 'DefaultStopConditions'
	poolDictionaries: ''
	category: 'Graphics-Text'!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
Smalltalk removeKey: #TextConstants.
Undeclared removeUnreferencedKeys!

