'From Cuis 1.0 of 4 September 2009 [latest update: #290] on 29 September 2009 at 11:08:24 am'!
!classDefinition: #DisplayScanner category: #'Graphics-Text'!
CharacterScanner subclass: #DisplayScanner
	instanceVariableNames: 'bitBlt lineY runX foregroundColor lineHeight paragraphColor morphicOffset ignoreColorChanges lastBulletNumber '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #TextLine category: #'Morphic-Text Support'!
Object subclass: #TextLine
	instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline isFirstLine '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!

!TextLine commentStamp: '<historical>' prior: 0!
A TextLine embodies the layout of a line of composed text.
	left right top bottom		The full line rectangle
	firstIndex lastIndex			Starting and stopping indices in the full text
	internalSpaces				Number of spaces to share paddingWidth
	paddingWidth				Number of pixels of extra space in full line
	baseline					Distance of baseline below the top of the line
	isFirstLine					A boolean indicating if it is the first line in a paragraph
TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.!

!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'name font alignment tabsArray color firstIndent restIndent rightIndent paragraphSpacingBefore paragraphSpacingAfter listBulletPattern '
	classVariableNames: 'AvailableTextStyles DefaultTextStyle '
	poolDictionaries: ''
	category: 'Graphics-Text'!

!TextStyle commentStamp: '<historical>' prior: 0!
A TextStyle comprises the formatting information for composing and displaying a unit (usually a paragraph) of text.
TextStyle instances are shared. They are not modified often, and any change will affect the style's many users.
They should not be copied, but new instances might be created.

Each of my instances consists of...
	name						If available for general use in the AvailableTextStyles dictionary, it is also the key for access
	font						The default font to use
	alignment					An integer; text alignment, see TextStyle alignment:
	tabsArray					An array of integers giving tab offsets in pixels
	color						Color of the text
	firstIndent					Left indent (margin) of the first line of a paragraph
	restIndent					Left indent (margin) for the rest of the paragraph
	rightIndent					Right indent (margin) of the paragraph
	paragraphSpacingBefore	Additional vertical spacing to add before a paragraph
	paragraphSpacingAfter		Additional verital spacing to add after a paragraph
	listBulletPattern			String pattern for bulleted lists. See the comment at #privateListBulletPattern:

For a concrete example, look at TextStyle default inspect!


!CompositionScanner methodsFor: 'scanning' stamp: 'jmv 9/29/2009 09:40'!
composeFrom: startIndex inRectangle: lineRectangle firstLine: firstLine leftSide: leftSide rightSide: rightSide

	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength done stopCondition xtraSpaceBefore spaceAfterParagraph |
	
	lastIndex _ startIndex.	"scanning sets last index"
	destY _ lineRectangle top.
	lineHeight _ baseline _ 0.  "Will be increased by setFont"
	self setStopConditions.	"also sets font, style, etc"

	"Set up margins"
	leftMargin _ lineRectangle left.
	leftSide ifTrue: [
		leftMargin _ leftMargin +
			((firstLine and: [actualTextStyle isListStyle not])
				ifTrue: [actualTextStyle firstIndent]
				ifFalse: [actualTextStyle restIndent])].
	destX _ spaceX _ leftMargin.
	rightMargin _ lineRectangle right.
	rightSide ifTrue: [
		rightMargin _ rightMargin - actualTextStyle rightIndent].

	runLength _ text runLengthFor: startIndex.
	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
	line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	line isFirstLine: firstLine.
	spaceCount _ 0.
	leftMargin _ destX.
	line leftMargin: leftMargin.

	done _ false.
	xtraSpaceBefore _ firstLine
		ifTrue: [ actualTextStyle paragraphSpacingBefore ]
		ifFalse: [ 0 ].
	spaceAfterParagraph _ actualTextStyle paragraphSpacingAfter.
	[ done ]
		whileFalse: [
			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) ifTrue: [
				^ line 
					lineHeight: lineHeight + xtraSpaceBefore + 
						(stopCondition = #cr ifTrue: [spaceAfterParagraph] ifFalse: [0]) 
					baseline: baseline + xtraSpaceBefore ]]! !


!DisplayScanner methodsFor: 'scanning' stamp: 'jmv 9/29/2009 11:03'!
displayBulletOffset: offset
	| pattern i bullet bulletPos |
	pattern _ actualTextStyle listBulletPattern.
	(i _ pattern indexOf: $%) > 0
		ifTrue: [ lastBulletNumber _ self nextBulletNumber]
		ifFalse: [
			(i _ pattern indexOf: $z) > 0
				ifTrue: [ lastBulletNumber _ self nextBulletLowerChar ]
				ifFalse: [
					(i _ pattern indexOf: $Z) > 0
						ifTrue: [ lastBulletNumber _ self nextBulletUpperChar ]]].
	bullet _ i > 0
		ifTrue: [ (pattern copyFrom: 1 to: i-1), lastBulletNumber asString, (pattern copyFrom: i+1 to: pattern size) ]
		ifFalse: [ pattern ].
	bulletPos _ actualTextStyle firstIndent + offset x@destY.
	font displayString: bullet on: bitBlt from: 1 to: bullet size at: bulletPos kern: kern.
		! !

!DisplayScanner methodsFor: 'scanning' stamp: 'jmv 9/29/2009 10:12'!
displayLine: textLine offset: offset leftInRun: leftInRun
	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
	| done stopCondition nowLeftInRun startIndex string lastPos |
	line _ textLine.
	morphicOffset _ offset.
	lineY _ line top + offset y.
	lineHeight _ line lineHeight.
	rightMargin _ line rightMargin + offset x.
	lastIndex _ line first.
	leftInRun <= 0 ifTrue: [self setStopConditions].
	leftMargin _ (line leftMarginForAlignment: alignment) + offset x.
	destX _ runX _ leftMargin.
	lastIndex _ line first.
	leftInRun <= 0
		ifTrue: [nowLeftInRun _ text runLengthFor: lastIndex]
		ifFalse: [nowLeftInRun _ leftInRun].
	destY _ lineY + line baseline - font ascent.
	runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last.
	spaceCount _ 0.
	done _ false.
	string _ text string.
	
	actualTextStyle isListStyle ifTrue: [
		textLine isFirstLine ifTrue: [
			self displayBulletOffset: offset]
	] ifFalse: [ lastBulletNumber _ nil ].

	[done] whileFalse:[
		startIndex _ lastIndex.
		lastPos _ destX@destY.
		stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
						in: string rightX: rightMargin stopConditions: stopConditions
						kern: kern.
		lastIndex >= startIndex ifTrue:[
			font displayString: string on: bitBlt 
				from: startIndex to: lastIndex at: lastPos kern: kern].
		"see setStopConditions for stopping conditions for displaying."
		done _ self perform: stopCondition].
	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"! !

!DisplayScanner methodsFor: 'numbered lists' stamp: 'jmv 9/29/2009 10:26'!
nextBulletLowerChar

	lastBulletNumber ifNotNil: [
		lastBulletNumber isNumber
			ifTrue: [ lastBulletNumber _ nil ]
			ifFalse: [
				lastBulletNumber isLowercase ifFalse: [ lastBulletNumber _ nil ]].
	].
	^lastBulletNumber ifNil: [ $a ] ifNotNil: [ Character value: lastBulletNumber asciiValue + 1 ]! !

!DisplayScanner methodsFor: 'numbered lists' stamp: 'jmv 9/29/2009 10:20'!
nextBulletNumber

	lastBulletNumber isNumber ifFalse: [ lastBulletNumber _ nil ].
	^lastBulletNumber ifNil: [ 1 ] ifNotNil: [ lastBulletNumber + 1 ]! !

!DisplayScanner methodsFor: 'numbered lists' stamp: 'jmv 9/29/2009 10:27'!
nextBulletUpperChar

	lastBulletNumber ifNotNil: [
		lastBulletNumber isNumber
			ifTrue: [ lastBulletNumber _ nil ]
			ifFalse: [
				lastBulletNumber isUppercase ifFalse: [ lastBulletNumber _ nil ]].
	].
	^lastBulletNumber ifNil: [ $A ] ifNotNil: [ Character value: lastBulletNumber asciiValue + 1 ]! !


!Scanner methodsFor: 'initialize-release' stamp: 'jmv 9/29/2009 09:52'!
release! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 9/29/2009 09:32'!
addNullLineWithIndex: index andRectangle: r
	"The line to add is always the first line of a new paragraph"
	| ts f h bs |
	editor
	ifNotNil: [
		ts _ editor lastParagraphStyle.
		f _ editor lastFont.
		h _ f height + ts paragraphSpacingBefore + ts paragraphSpacingAfter.
		bs _ f ascent + ts paragraphSpacingBefore.
		]
	ifNil: [
		f _ theText fontAt: theText size + 1.
		h _ f height.
		bs _ f ascent.
	].
	lines addLast: (
		(
			TextLine 
				start: index 
				stop: index - 1
				internalSpaces: 0 
				paddingWidth: 0
		)
			rectangle: r;
			lineHeight: h baseline: bs;
			isFirstLine: true
	)! !


!TextLine methodsFor: 'accessing' stamp: 'jmv 9/29/2009 09:29'!
isFirstLine
	^isFirstLine! !

!TextLine methodsFor: 'accessing' stamp: 'jmv 9/29/2009 09:29'!
isFirstLine: aBoolean
	isFirstLine _ aBoolean! !

!TextLine methodsFor: 'initialize-release' stamp: 'jmv 9/29/2009 09:28'!
initialize
	isFirstLine _ false! !


!TextStyle methodsFor: 'accessing' stamp: 'jmv 9/29/2009 09:39'!
isListStyle
	^listBulletPattern notNil! !

!TextStyle methodsFor: 'accessing' stamp: 'jmv 9/29/2009 09:15'!
listBulletPattern
	"Answer the string patter to be used to display bullets at the start of each line."

	^listBulletPattern! !

!TextStyle methodsFor: 'initialization' stamp: 'jmv 9/29/2009 09:00'!
initialize
	firstIndent _ restIndent _ rightIndent _ paragraphSpacingBefore _ paragraphSpacingAfter _ 0.
	listBulletPattern _ nil! !

!TextStyle methodsFor: 'initialization' stamp: 'jmv 9/29/2009 08:59'!
privateListBulletPattern: aString 
	"If this is notNil, then this style is a Bullet List Style
	Some examples are:
		'%. ' -> '1. ' '2. ' etc.
		'z) ' -> 'a) ' 'b) ' etc.
		'Z- ' -> 'A- ' 'B- ' etc
	"
	"To be used from TextStyle instance creation methods.
	If used on existing instances, existing text will be modified."

	listBulletPattern _ aString.
	self class someStyleChanged! !


!TextStyle class methodsFor: 'examples' stamp: 'jmv 9/29/2009 11:02'!
createExamples
	"
	TextStyle createExamples
	"
	| dejaVu22 dejaVu17 dejaVu14 dejaVu11 dejaVu10 heading1 heading2 heading3 emphasized normal numbered alphabetic bulleted |

	dejaVu22 _ AbstractFont familyName: 'DejaVu' pointSize: 22.
	dejaVu17 _ AbstractFont familyName: 'DejaVu' pointSize: 17.
	dejaVu14 _ AbstractFont familyName: 'DejaVu' pointSize: 14.
	dejaVu11 _ AbstractFont familyName: 'DejaVu' pointSize: 11.
	dejaVu10 _ AbstractFont familyName: 'DejaVu' pointSize: 10.
	
	heading1 _ TextStyle withFont: dejaVu22 name: 'Heading 1' alignment: CharacterScanner centeredCode.
	heading1
		privateParagraphSpacingBefore: 34;
		privateParagraphSpacingAfter: 18.
	self makeAvailable: heading1.

	heading2 _ TextStyle withFont: dejaVu17 bold name: 'Heading 2' alignment: CharacterScanner leftFlushCode.
	heading2
		privateParagraphSpacingBefore: 24;
		privateParagraphSpacingAfter: 8.
	self makeAvailable: heading2.

	heading3 _ TextStyle withFont: dejaVu14 italic name: 'Heading 3' alignment: CharacterScanner leftFlushCode.
	heading3
		privateParagraphSpacingBefore: 18;
		privateParagraphSpacingAfter: 4.
	self makeAvailable: heading3.

	emphasized _ TextStyle withFont: dejaVu10 bold name: 'Emphasized' alignment: CharacterScanner justifiedCode.
	emphasized
		privateFirstIndent: 60;
		privateRestIndent: 60;
		privateRightIndent: 60;
		privateParagraphSpacingBefore: 10;
		privateParagraphSpacingAfter: 2.
	self makeAvailable: emphasized.
	
	normal _ TextStyle withFont: dejaVu11 name: 'Normal' alignment: CharacterScanner justifiedCode.
	normal
		privateFirstIndent: 30;
		privateRestIndent: 10;
		privateRightIndent: 10;
		privateParagraphSpacingBefore: 8;
		privateParagraphSpacingAfter: 2.
	self makeAvailable: normal.
	
	numbered _ TextStyle withFont: dejaVu11 name: 'Numbered List' alignment: CharacterScanner justifiedCode.
	numbered
		privateFirstIndent: 10;
		privateRestIndent: 30;
		privateRightIndent: 10;
		privateParagraphSpacingBefore: 8;
		privateParagraphSpacingAfter: 2;
		privateListBulletPattern: '%. '.
	self makeAvailable: numbered.
	
	alphabetic _ TextStyle withFont: dejaVu11 name: 'Alphabetic List' alignment: CharacterScanner justifiedCode.
	alphabetic
		privateFirstIndent: 10;
		privateRestIndent: 30;
		privateRightIndent: 10;
		privateParagraphSpacingBefore: 8;
		privateParagraphSpacingAfter: 2;
		privateListBulletPattern: 'z) '.
	self makeAvailable: alphabetic.
	
	bulleted _ TextStyle withFont: dejaVu11 name: 'Bulleted List' alignment: CharacterScanner justifiedCode.
	bulleted
		privateFirstIndent: 10;
		privateRestIndent: 30;
		privateRightIndent: 10;
		privateParagraphSpacingBefore: 8;
		privateParagraphSpacingAfter: 2;
		privateListBulletPattern: '° '.
	self makeAvailable: bulleted.! !

!classDefinition: #TextStyle category: #'Graphics-Text'!
Object subclass: #TextStyle
	instanceVariableNames: 'name font alignment tabsArray color firstIndent restIndent rightIndent paragraphSpacingBefore paragraphSpacingAfter listBulletPattern'
	classVariableNames: 'AvailableTextStyles DefaultTextStyle'
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #TextLine category: #'Morphic-Text Support'!
Object subclass: #TextLine
	instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline isFirstLine'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Text Support'!
!classDefinition: #DisplayScanner category: #'Graphics-Text'!
CharacterScanner subclass: #DisplayScanner
	instanceVariableNames: 'bitBlt lineY runX foregroundColor lineHeight paragraphColor morphicOffset ignoreColorChanges lastBulletNumber'
	classVariableNames: ''
	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."
TextLine allInstancesDo: [ :l | l isFirstLine ifNil: [ l isFirstLine: false ]]!

