'From etoys3.0 of 24 February 2008 [latest update: #1931] on 24 March 2008 at 6:13:05 pm'!
"Change Set:		romepango
Date:			11 June 2007
Author:			Yoshiki Ohshima

The image-side Pango support."!

NewParagraph subclass: #MultiNewParagraph
	instanceVariableNames: 'presentationText presentationLines'
	classVariableNames: ''
	poolDictionaries: 'TextConstants'
	category: 'Morphic-Text Support'!
MultiNewParagraph subclass: #PangoParagraph
	instanceVariableNames: 'paragraphs'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Rome-Pango'!
RomeFont subclass: #RomePangoFont
	instanceVariableNames: 'descriptionIndex size'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Rome-Pango'!
ArrayedCollection subclass: #RunArray
	instanceVariableNames: 'runs values lastIndex lastRun lastOffset pangoAttrCache '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Arrayed'!
Morph subclass: #StringMorph
	instanceVariableNames: 'font emphasis contents hasFocus usePango '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!
RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'textStyle text wrapFlag paragraph editor container predecessor successor backgroundColor margins fillStyle usePango '
	classVariableNames: 'CaretForm '
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!FormCanvas methodsFor: 'drawing' stamp: 'yo 6/7/2007 15:17'!
paragraph: para bounds: bounds color: c

	| scanner |
	(para isMemberOf: PangoParagraph) ifTrue: [
		RomePluginCanvas pangoIsAvailable ifTrue: [
			^ para pangoDrawOn: self in: bounds color: c]].
	self setPaintColor: c.
	scanner _ (port clippedBy: (bounds translateBy: origin)) displayScannerFor: para
		foreground: (self shadowColor ifNil:[c]) background: Color transparent
		ignoreColorChanges: self shadowColor notNil.
	para displayOn: (self copyClipRect: bounds) using: scanner at: origin+ bounds topLeft.
! !


!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 6/7/2007 15:24'!
characterBlockAtPoint: aPoint

	| r b rect index |
	r := RomePluginCanvas composingCanvas.
	r ifNil: [^ super characterBlockAtPoint: aPoint].
	rect := self compositionRectangle.
	b := CharacterBlock new.
	index := r pangoIndexIn: text string attributeArray: text asPangoAttributes at: (aPoint - positionWhenComposed) width: rect width height: rect height into: b.
	b stringIndex = nil ifTrue: [^ b stringIndex: 1 text: text topLeft: positionWhenComposed extent: 10@10].
	^ b textLine: (self textLineIncludes: index).! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 6/7/2007 15:24'!
characterBlockForIndex: index

	| r b rect |
	r := RomePluginCanvas composingCanvas.
	r ifNil: [^ super characterBlockForIndex: index].
	rect := self compositionRectangle.
	b := CharacterBlock new.
	r pangoBlockIn: text string attributeArray: text asPangoAttributes at: index at: positionWhenComposed width: rect width height: rect height into: b.
	^ b textLine: (self textLineIncludes: index).
! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 6/7/2007 15:25'!
composeAll

	| r rect myLines w |
	r := RomePluginCanvas composingCanvas.
	r ifNil: [^ super composeAll].
	rect := self compositionRectangle.
	myLines := (1 to: 100) collect: [:i | TextLine new].
	w := r pangoComposeString: text string attributeArray: text asPangoAttributes at: rect origin width: rect width height: rect height into: myLines withWrap: true.
	lines := self validLines: myLines.
	maxRightX := w.
! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 6/11/2007 10:29'!
pangoDrawOn: aCanvas in: bnds color: c

	| r start stop |
	(aCanvas isKindOf: FormCanvas) ifFalse: [^ self].
	r := RomePluginCanvas drawingCanvasFor: aCanvas.
	r clipRectangle: ((bnds intersect: aCanvas clipRect) translateBy: aCanvas origin).
	start := selectionStart ifNil: [-1] ifNotNil: [selectionStart stringIndex].
	stop := selectionStop ifNil: [-1] ifNotNil: [selectionStop stringIndex].
	r
		pangoString: text string
		attributeArray: text asPangoAttributes
		at: (positionWhenComposed + aCanvas origin)
		width: bnds width
		height: bnds height
		selectionStart: start
		selectionEnd: stop
		selectionColorPixel: (self insertionPointColor pixelValueForDepth: 32).
	r finish.
! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 6/11/2007 10:53'!
replaceFrom: start to: stop with: aText displaying: displayBoolean 
	text replaceFrom: start to: stop with: aText.
	self composeAll.
! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 5/27/2007 23:06'!
textLineIncludes: index

	lines do: [:l |
		(l first <= index and: [index <= l last]) ifTrue: [^ l]
	].
	^ lines last.
! !

!PangoParagraph methodsFor: 'as yet unclassified' stamp: 'yo 5/25/2007 13:03'!
validLines: dataLines

	1 to: dataLines size do: [:i |
		((dataLines at: i) left) ifNil: [^ dataLines copyFrom: 1 to: i-1].
	].
	^  dataLines.
! !


!RomePangoFont methodsFor: 'system primitives' stamp: 'yo 12/25/2006 18:06'!
clearDescriptionIndex

	descriptionIndex := nil.
! !

!RomePangoFont methodsFor: 'system primitives' stamp: 'yo 6/9/2007 21:44'!
descriptionIndex

	^ descriptionIndex ifNil: [descriptionIndex := self primGetDescriptionIndex: familyName size: size].
! !

!RomePangoFont methodsFor: 'system primitives' stamp: 'yo 12/22/2006 16:39'!
familyName: fmName size: sz

	familyName := fmName.
	size := sz asInteger.
! !

!RomePangoFont methodsFor: 'system primitives' stamp: 'yo 12/22/2006 16:51'!
primGetDescriptionIndex: fName size: ptSize

	<primitive: 'primitivePangoFontDescriptionIndex' module: 'RomePlugin'>
	^ -1.
! !


!RomePangoFont class methodsFor: 'as yet unclassified' stamp: 'yo 12/22/2006 16:34'!
familyName: familyName size: size

	^ self new familyName: familyName size: size.
! !


!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/5/2007 21:19'!
pangoBlockIn: string attributeArray: squeakAttributeArray at: sqIndex at: aPoint width: w height: h into: charBlock
	| ret pair |
	pair := self utf8StringFor: string andIndexFor: sqIndex.

	self preserveStateDuring: [
		ret := self primPangoBlockInString: pair first at: pair second x: aPoint x asInteger y: aPoint y asInteger squeakAttributeArray: squeakAttributeArray width: w asInteger height: h asInteger withWrap: true into: charBlock.
	].
	^ ret.

	! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/4/2007 16:39'!
pangoComposeString: string attributeArray: squeakAttributeArray at: aPoint width: w height: h into: lines withWrap: wrapFlag

	| utf8String newW pair |
	pair := self utf8StringFor: string andIndexFor: 0.
	utf8String := pair first.

	self preserveStateDuring: [
		newW := self primPangoComposeString: utf8String x: aPoint x asInteger y: aPoint y asInteger squeakAttributeArray: squeakAttributeArray width: w asInteger height: h asInteger withWrap: wrapFlag into: lines.
	].
	^ newW.
	
	! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/4/2007 16:39'!
pangoIndexIn: string attributeArray: squeakAttributeArray at: aPoint width: w height: h into: charBlock
	| utf8String ret pair |
	pair := self utf8StringFor: string andIndexFor: 0.
	utf8String := pair first.

	self preserveStateDuring: [
		ret := self primPangoIndexInString: utf8String x: aPoint x asInteger y: aPoint y asInteger squeakAttributeArray: squeakAttributeArray width: w asInteger height: h asInteger withWrap: true into: charBlock.
	].
	^ ret.

	! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/4/2007 16:50'!
pangoString: string attributeArray: squeakAttributeArray at: aPoint width: w height: h selectionStart: selStart selectionEnd: selEnd selectionColorPixel: cPixel
	"selected font is a RomeFreetypeFont, render directly"
	| newW triplet |
	triplet := self utf8StringFor: string andIndexFor: selStart andIndexFor: selEnd.

	self preserveStateDuring: [
		newW := self primPangoShowString: triplet first x: aPoint x asInteger y: aPoint y asInteger squeakAttributeArray: squeakAttributeArray width: w asInteger height: h asInteger withWrap: true selectionStart: triplet second selectionEnd: triplet third selectionColorPixel: cPixel.
	].
	^ newW.
	
	! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 5/29/2007 15:54'!
primPangoBlockInString: utf8String at: index x: x y: y squeakAttributeArray: sqAttrArray width: w height: h withWrap: wrap into: charBlock
	"ignores pen"
	<primitive: 'primitivePangoBlockAtIndex' module: 'RomePlugin'>
	^self primitiveOpenAndRetry
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 5/25/2007 21:48'!
primPangoComposeString: utf8String x: x y: y squeakAttributeArray: sqAttrArray width: w height: h withWrap: wrap into: lines
	"ignores pen"
	<primitive: 'primitivePangoComposeString' module: 'RomePlugin'>
	^self primitiveOpenAndRetry
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 5/25/2007 22:21'!
primPangoIndexInString: utf8String x: x y: y squeakAttributeArray: sqAttrArray width: w height: h withWrap: wrap into: charBlock
	"ignores pen"
	<primitive: 'primitivePangoIndexAtPoint' module: 'RomePlugin'>
	^self primitiveOpenAndRetry
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/7/2007 15:35'!
primPangoIsAvailable

	<primitive: 'primitivePangoIsAvailable' module: 'RomePlugin'>
	^ false.
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/1/2007 17:56'!
primPangoShowString: utf8String x: x y: y squeakAttributeArray: sqAttrArray width: w height: h withWrap: wrap selectionStart: selStart selectionEnd: selEnd selectionColorPixel: cPixel
	"ignores pen"
	<primitive: 'primitivePangoShowString' module: 'RomePlugin'>
	^self primitiveOpenAndRetry
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/5/2007 21:08'!
utf8StringFor: aString andIndexFor: sqIndex

	| converter newIndex utf8String char |
	converter := UTF8TextConverter new.
	newIndex := -1.
	utf8String := String streamContents: [:stream |
		1 to: aString size do: [:i |
			char := aString at: i.
			i = sqIndex ifTrue: [newIndex := stream position].
			converter nextPut: char toStream: stream.
		].
		stream nextPut: (Character value: 0)].
	^ Array with: utf8String with: (newIndex = -1 ifTrue: [sqIndex = -1 ifTrue: [-1] ifFalse: [utf8String size]] ifFalse: [newIndex]).
! !

!RomePluginCanvas methodsFor: '*pango' stamp: 'yo 6/5/2007 21:07'!
utf8StringFor: aString andIndexFor: sqIndex1 andIndexFor: sqIndex2

	| converter newIndex1 newIndex2 utf8String char |
	converter := UTF8TextConverter new.
	newIndex1 := -1.
	newIndex2 := -1.
	utf8String := String streamContents: [:stream |
		1 to: aString size do: [:i |
			char := aString at: i.
			i = sqIndex1 ifTrue: [newIndex1 := stream position].
			i = sqIndex2 ifTrue: [newIndex2 := stream position].
			converter nextPut: char toStream: stream.
		].
		stream nextPut: (Character value: 0)].
	^ Array with: utf8String
		with: (newIndex1 = -1 ifTrue: [sqIndex1 = -1 ifTrue: [-1] ifFalse: [utf8String size]] ifFalse: [newIndex1])
		with: (newIndex2 = -1 ifTrue: [sqIndex2 = -1 ifTrue: [-1] ifFalse: [utf8String size]] ifFalse: [newIndex2])
! !


!RomePluginCanvas class methodsFor: 'accessing' stamp: 'yo 6/7/2007 15:38'!
composingCanvas

	self pangoIsAvailable ifFalse: [^ nil].
	^ ComposingCanvas ifNil: [ComposingCanvas := RomeCanvas on: (Form extent: 4@4 depth: 32)].
! !

!RomePluginCanvas class methodsFor: 'accessing' stamp: 'yo 6/5/2007 18:43'!
drawingCanvasFor: aCanvas

	^ RomeCanvas on: aCanvas form.
"
	aCanvas form == Display ifTrue: [
		DrawingCanvas
			ifNotNil: [
				DrawingCanvas open.
				DrawingCanvas clipRectangle: (0@0 corner: Display extent).
				DrawingCanvas clear]
			ifNil: [DrawingCanvas _  RomeCanvas on: Display].
		^ DrawingCanvas.
	].
	^ RomeCanvas on: aCanvas form.
"! !

!RomePluginCanvas class methodsFor: 'testing' stamp: 'yo 6/7/2007 15:37'!
pangoIsAvailable

	^ PangoAvailable ifNil: [
		PangoAvailable := (self pluginAvailable and: [(self on: (Form extent: 4@4 depth: 16)) primPangoIsAvailable]).
	].
! !

!RomePluginCanvas class methodsFor: 'testing' stamp: 'yo 6/7/2007 14:56'!
primPangoIsAvailable

	<primitive: 'primitivePangoIsAvailable' module: 'RomePlugin'>
	^ false.
! !

!RomePluginCanvas class methodsFor: 'system shutdown' stamp: 'yo 6/7/2007 14:31'!
shutDown
	ComposingCanvas := DrawingCanvas := PangoAvailable := nil.
	self allSubInstancesDo: [:each | each shutDown].
	RomePluginForm allSubInstancesDo: [:each | each shutDown].
! !


!RunArray methodsFor: 'adding' stamp: 'yo 6/4/2007 12:08'!
addFirst: value
	"Add value as the first element of the receiver."
	self clearCache.  "flush access cache"
	(runs size=0 or: [values first ~= value])
	  ifTrue:
		[runs := {1}, runs.
		values := {value}, values]
	  ifFalse:
		[runs at: 1 put: runs first+1]! !

!RunArray methodsFor: 'adding' stamp: 'yo 6/4/2007 12:08'!
addLast: value
	"Add value as the last element of the receiver."
	self clearCache.  "flush access cache"
	(runs size=0 or: [values last ~= value])
	  ifTrue:
		[runs := runs copyWith: 1.
		values := values copyWith: value]
	  ifFalse:
		[runs at: runs size put: runs last+1]! !

!RunArray methodsFor: 'adding' stamp: 'yo 6/4/2007 12:08'!
addLast: value  times: times
	"Add value as the last element of the receiver, the given number of times"
	times = 0 ifTrue: [ ^self ].
	self clearCache.  "flush access cache"
	(runs size=0 or: [values last ~= value])
	  ifTrue:
		[runs := runs copyWith: times.
		values := values copyWith: value]
	  ifFalse:
		[runs at: runs size put: runs last+times]! !

!RunArray methodsFor: 'adding' stamp: 'yo 6/4/2007 12:09'!
repeatLastIfEmpty: defaultBlock
	"add the last value back again.  If we are empty, add (defaultBlock value)"
	self clearCache.  "flush access cache"
	(runs size=0)
	  ifTrue:[
		 runs := runs copyWith: 1.
		values := values copyWith: defaultBlock value]
	  ifFalse:
		[runs at: runs size put: runs last+1]! !

!RunArray methodsFor: 'adding' stamp: 'yo 6/4/2007 12:09'!
repeatLast: times  ifEmpty: defaultBlock
	"add the last value back again, the given number of times.  If we are empty, add (defaultBlock value)"
	times = 0 ifTrue: [^self ].
	self clearCache.  "flush access cache"
	(runs size=0)
	  ifTrue:
		[runs := runs copyWith: times.
		values := values copyWith: defaultBlock value]
	  ifFalse:
		[runs at: runs size put: runs last+times] ! !

!RunArray methodsFor: 'private' stamp: 'yo 6/4/2007 12:22'!
setRuns: newRuns setValues: newValues
	self clearCache.  "flush access cache"
	runs := newRuns asArray.
	values := newValues asArray.! !

!RunArray methodsFor: '*pango' stamp: 'yo 6/4/2007 12:08'!
asPangoAttributesFor: aString

	| stream currentStart currentEnd n converter myStream utf8Stream |
	pangoAttrCache ifNotNil: [^ pangoAttrCache].
	stream := WriteStream on: (Array new: runs size * 4).
	converter := UTF8TextConverter new.
	myStream := ReadStream on: aString.
	utf8Stream := WriteStream on: (String new: self size).
	currentEnd := 0.
	self runsAndValuesDo: [:run :value |
		currentStart := currentEnd.
		run timesRepeat: [converter nextPut: myStream next toStream: utf8Stream].
		currentEnd := utf8Stream position.
		value do: [:v |
			n := v asPangoValueFrom: currentStart to: currentEnd.
			n ifNotNil: [stream nextPut: n].
		].
		n := self pangoFontAttributeFromArray: value from: currentStart to: currentEnd.
		n ifNotNil: [stream nextPut: n].
	].
	^ pangoAttrCache := stream contents.
! !

!RunArray methodsFor: '*pango' stamp: 'yo 12/12/2006 09:52'!
clearCache

	pangoAttrCache := nil.
	lastIndex := nil.
! !

!RunArray methodsFor: '*pango' stamp: 'yo 5/22/2007 11:26'!
pangoFontAttributeFromArray: a from: start to: end

	| font fontName fontSize fontRef fontChange r |
	fontRef := a detect: [:e | e isMemberOf: TextFontReference] ifNone: [nil].
	font := fontRef ifNil: [TextStyle defaultFont] ifNotNil: [fontRef font].
	fontName := font familyName.
	(fontName beginsWith: 'Accuny') ifTrue: [
		fontName := 'Times New Roman'.
	].
	(fontName beginsWith: 'Accujen') ifTrue: [
		fontName := 'Arial'.
	].
	fontChange := a detect: [:e | e isMemberOf: TextFontChange] ifNone: [nil].
	fontSize := fontChange ifNil: [font pointSize] ifNotNil: [
		(font textStyle fontArray at: fontChange fontNumber) pointSize].
	r := RomePangoFont familyName: fontName size: fontSize asInteger.

	^ Array with: #F with: start with: end with: r descriptionIndex with: r.
! !


!RunArray class methodsFor: '*system-support' stamp: 'yo 6/9/2007 22:04'!
initialize
"
	RunArray initialize
"
	Smalltalk addToShutDownList: RunArray.
! !

!RunArray class methodsFor: '*system-support' stamp: 'yo 6/9/2007 22:05'!
shutDown

	self allInstancesDo: [:e | e clearCache].! !


!String methodsFor: 'pango' stamp: 'yo 12/12/2006 11:52'!
asPangoAttributes

	^ Array new: 0.
! !


!StringMorph methodsFor: 'accessing' stamp: 'yo 6/7/2007 15:26'!
measureContents

	| f |
	(self usePango and: [RomePluginCanvas pangoIsAvailable]) ifTrue: [
		^ self pangoMeasureContents
	].
	f := self fontToUse.
	^(((f widthOfString: contents) max: self minimumWidth)  @ f height).! !

!StringMorph methodsFor: 'drawing' stamp: 'yo 6/7/2007 15:17'!
drawOn: aCanvas

	self usePango ifTrue: [
		RomePluginCanvas pangoIsAvailable ifTrue: [
			^ self pangoDrawOn: aCanvas in: bounds color: self color]].
	aCanvas drawString: contents in: bounds font: self fontToUse color: color.! !

!StringMorph methodsFor: 'editing' stamp: 'yo 5/31/2007 19:26'!
launchMiniEditor: evt

	| textMorph |
	hasFocus _ true.  "Really only means edit in progress for this morph"
	textMorph _ StringMorphEditor new contentsAsIs: contents.
	textMorph beAllFont: self fontToUse.
	textMorph usePango: self usePango.
	textMorph bounds: (self bounds expandBy: 0@2).
	self addMorphFront: textMorph.
	evt hand newKeyboardFocus: textMorph.
	textMorph editor selectFrom: 1 to: textMorph paragraph text string size! !

!StringMorph methodsFor: 'initialization' stamp: 'yo 6/11/2007 13:40'!
initialize
"initialize the state of the receiver"
	super initialize.
""
	font _ nil.
	emphasis _ 0.
	hasFocus _ false.
	usePango _ Preferences usePangoRenderer.
! !

!StringMorph methodsFor: 'pango' stamp: 'yo 6/11/2007 14:17'!
asPangoAttributes

	| usedFont fontName fontSize colorArray emphasisArray r utf8Contents |
	usedFont := font ifNil: [TextStyle defaultFont] ifNotNil: [font].
	utf8Contents := (contents ifNotNil: [contents convertToWithConverter: UTF8TextConverter new] ifNil: ['']).
	fontName := usedFont familyName.
	(fontName beginsWith: 'Accuny') ifTrue: [
		fontName := 'Times New Roman'.
	].
	(fontName beginsWith: 'Accujen') ifTrue: [
		fontName := 'Arial'.
	].
	fontSize := usedFont pixelSize.
	colorArray :=  Array with: #C with: 0 with: utf8Contents size with: color pixelValue32.
	emphasisArray :=  Array with: #E with: 0 with: utf8Contents size with: emphasis.
	r := RomePangoFont familyName: fontName size: (fontSize *0.6) asInteger.
	^ Array with: (Array with: #F with: 0 with: utf8Contents size with: r descriptionIndex with: r)
		with: colorArray
		with: emphasisArray.
! !

!StringMorph methodsFor: 'pango' stamp: 'yo 6/5/2007 21:06'!
pangoDrawOn: aCanvas in: bnds color: c

	| r pos rect |
	(aCanvas isKindOf: FormCanvas) ifFalse: [^ self].
	r := RomePluginCanvas drawingCanvasFor: aCanvas.
	rect := (aCanvas origin = (0@0)) ifTrue: [bnds] ifFalse: [(0@0 corner: aCanvas extent)].
	r clipRectangle: rect.
	pos := (aCanvas origin = (0@0)) ifTrue: [self position] ifFalse: [self position + aCanvas origin].
	r pangoString: contents attributeArray: self asPangoAttributes at: pos width: bnds width height: self height selectionStart: -1 selectionEnd: -1 selectionColorPixel: 16rFF0000FF.
	r finish.
! !

!StringMorph methodsFor: 'pango' stamp: 'yo 6/5/2007 18:47'!
pangoMeasureContents

	| r myLines |
	r := RomePluginCanvas composingCanvas.
	myLines := Array with: TextLine new.
	r pangoComposeString: contents attributeArray: self asPangoAttributes at: self position width:  SmallInteger maxVal height: SmallInteger maxVal into: myLines withWrap: false.
	^ myLines first bottomRight.
! !

!StringMorph methodsFor: 'pango' stamp: 'yo 5/22/2007 20:31'!
usePango

	^ usePango ifNil: [usePango := false].
! !

!StringMorph methodsFor: 'pango' stamp: 'yo 12/12/2006 14:38'!
usePango: aBoolean

	usePango := aBoolean.
! !


!Text methodsFor: '*rome-pango' stamp: 'yo 5/22/2007 14:15'!
asPangoAttributes

	^ self pangoLanguageAttributes, (runs asPangoAttributesFor: string).
! !

!Text methodsFor: '*rome-pango' stamp: 'yo 6/4/2007 12:23'!
pangoLanguageAttributes

	| stream currentTag currentStart currentEnd leadingChar converter myStream utf8Stream |
	self size = 0 ifTrue: [^ Array new: 0].
	(string isMemberOf: ByteString)
		ifTrue: [^ Array new: 0].

	converter := UTF8TextConverter new.
	myStream := ReadStream on: self string.
	utf8Stream := WriteStream on: (String new: self size).
	stream := WriteStream on: (Array new: self size//20).
	currentTag := (string at: 1) leadingChar.
	currentStart := 0.
	converter nextPut: myStream next toStream: utf8Stream.
	currentEnd := utf8Stream position.
	2 to: self size do: [:e |
		((leadingChar := (string at: e) leadingChar) ~= currentTag) ifTrue: [
			stream nextPut: (Array with: #L with: currentStart with: currentEnd with: currentTag).
			currentTag := leadingChar.
			currentStart := currentEnd.
		].
		converter nextPut: myStream next toStream: utf8Stream.
		currentEnd := utf8Stream position.
	].
	stream nextPut: (Array with: #L with: currentStart with: currentEnd with: currentTag).
	^ stream contents.

	
! !


!TextAttribute methodsFor: '*pango' stamp: 'yo 5/22/2007 10:36'!
asPangoValueFrom: start to: end

	^ nil.
! !


!TextAlignment methodsFor: 'pango' stamp: 'yo 12/6/2006 13:12'!
asPangoValueFrom: start to: end

	^ Array with: #A with: start with: end with: alignment
! !


!TextColor methodsFor: 'pango' stamp: 'yo 12/6/2006 13:13'!
asPangoValueFrom: start to: end

	^ Array with: #C with: start with: end with: color pixelValue32.
! !


!TextEmphasis methodsFor: '*pango' stamp: 'yo 5/22/2007 10:36'!
asPangoValueFrom: start to: end

	^ Array with: #E with: start with: end with: emphasisCode.
! !


!TextMorph methodsFor: 'copying' stamp: 'yo 3/24/2008 14:14'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables. Some need to be not copied at all, but shared.
	Warning!!!! Every instance variable defined in this class must be handled.
	We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

	super veryDeepInner: deepCopier.
	textStyle _ textStyle veryDeepCopyWith: deepCopier.
	text _ text veryDeepCopyWith: deepCopier.
	wrapFlag _ wrapFlag veryDeepCopyWith: deepCopier.
	paragraph _ paragraph veryDeepCopyWith: deepCopier.
	editor _ editor veryDeepCopyWith: deepCopier.
	container _ container veryDeepCopyWith: deepCopier.
	predecessor _ predecessor.
	successor _ successor.
	backgroundColor _ backgroundColor veryDeepCopyWith: deepCopier.
	margins _ margins veryDeepCopyWith: deepCopier.
	usePango _ usePango.! !

!TextMorph methodsFor: 'drawing' stamp: 'sw 4/25/2002 00:52'!
drawOn: aCanvas
	"Draw the receiver on a canvas"

	| fauxBounds |
	self setDefaultContentsIfNil.
	super drawOn: aCanvas.  "Border and background if any"
	false ifTrue: [self debugDrawLineRectsOn: aCanvas].  "show line rects for debugging"
	(self startingIndex > text size)
		ifTrue: [self drawNullTextOn: aCanvas].
	"Hack here:  The canvas expects bounds to carry the location of the text, but we also need to communicate clipping."
	fauxBounds _ self bounds topLeft corner: self innerBounds bottomRight.
	aCanvas paragraph: self paragraph bounds: fauxBounds color: color! !

!TextMorph methodsFor: 'initialization' stamp: 'yo 6/11/2007 11:35'!
initialize
	super initialize.
	borderWidth _ 0.
	textStyle _ TextStyle default copy.
	wrapFlag _ true.
	usePango := Preferences usePangoRenderer.
! !

!TextMorph methodsFor: 'private' stamp: 'yo 6/7/2007 15:22'!
paragraph
	"Paragraph instantiation is lazy -- create it only when needed"
	paragraph ifNotNil: [
		(RomePluginCanvas pangoIsAvailable not
			and: [paragraph isMemberOf: PangoParagraph]) ifTrue: [
				paragraph := nil] ifFalse: [^ paragraph]].

self setProperty: #CreatingParagraph toValue: true.

	self setDefaultContentsIfNil.

	"...Code here to recreate the paragraph..."
	paragraph _ (self paragraphClass new textOwner: self owner).
	paragraph wantsColumnBreaks: successor notNil.
	paragraph
		compose: text
		style: textStyle copy
		from: self startingIndex
		in: self container.
	wrapFlag ifFalse:
		["Was given huge container at first... now adjust"
		paragraph adjustRightX].
	paragraph focused: (self currentHand keyboardFocus == self).
	self fit.
self removeProperty: #CreatingParagraph.


	^ paragraph! !

!TextMorph methodsFor: 'private' stamp: 'yo 6/7/2007 15:17'!
paragraphClass
	container ifNil: [
		^ (RomePluginCanvas pangoIsAvailable and: [self usePango]) ifFalse: [MultiNewParagraph] ifTrue: [PangoParagraph]].
	^ container paragraphClass! !

!TextMorph methodsFor: '*pango' stamp: 'yo 5/22/2007 20:31'!
usePango

	^ usePango ifNil: [usePango := false].
! !

!TextMorph methodsFor: '*pango' stamp: 'yo 6/7/2007 15:58'!
usePango: aBoolean

	usePango := aBoolean.
	paragraph := nil.
	text runs clearCache.
! !


!TextMorph class methodsFor: 'class initialization' stamp: 'yo 6/11/2007 11:32'!
usePango: aBoolean

	self allSubInstancesDo: [:inst | inst usePango: aBoolean].
	StringMorph allSubInstancesDo: [:inst | inst usePango: aBoolean].
! !


!TextMorphEditor methodsFor: 'mvc compatibility' stamp: 'yo 6/1/2007 19:06'!
storeSelectionInParagraph
	paragraph selectionStart: self startBlock selectionStop: self stopBlock.
	(paragraph isMemberOf: PangoParagraph) ifTrue: [morph changed]! !

RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'textStyle text wrapFlag paragraph editor container predecessor successor backgroundColor margins fillStyle usePango'
	classVariableNames: 'CaretForm'
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!TextMorph reorganize!
('accessing' asText autoFit: backgroundColor backgroundColor: borderWidth: contents contentsAsIs: contentsWrapped: contents: contents:wrappedTo: crAction crAction: cursor cursorWrapped: editor elementCount fontName:pointSize: fontName:size: font: getFirstCharacter getLastCharacter hasTranslucentColor isAutoFit isWrapped margins margins: newContents: restoreText: selectAll selectFrom:to: selection setCharacters: setFirstCharacter: setLastCharacter: text textAlignment textAlignmentSymbol textColor textColor: textStyle userString wrapFlag:)
('alignment' centered justified leftFlush rightFlush)
('anchors' adjustTextAnchor: anchorMorph:at:type:)
('caching' loadCachedState releaseCachedState)
('change reporting' ownerChanged)
('classification' isTextMorph)
('containment' avoidsOcclusions fillingOnOff fillsOwner fillsOwner: occlusionsOnOff recognizerArena setContainer:)
('copying' copy veryDeepFixupWith: veryDeepInner:)
('drawing' areasRemainingToFill: debugDrawLineRectsOn: drawNullTextOn: drawOnTest: drawOn:)
('editing' acceptContents acceptOnCR cancelEdits chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle enterClickableRegion: handleEdit: handleInteraction:fromEvent: hasUnacceptedEdits: passKeyboardFocusTo: prefereredKeyboardPosition setCompositionWindow xeqLinkText:withParameter:)
('event handling' handlesKeyboard: handlesMouseDown: hasFocus keyboardFocusChange: keyStroke: mouseDown: mouseMove: mouseUp: wouldAcceptKeyboardFocusUponTab yellowButtonActivity)
('events-processing' handleKeystroke: handleMouseMove:)
('geometry' bounds container defaultLineHeight extent: minimumExtent privateMoveBy: textBounds)
('geometry testing' containsPoint:)
('initialization' beAllFont: defaultColor initialize setTextStyle: string:fontName:size: string:fontName:size:wrap:)
('layout' acceptDroppingMorph:event:)
('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:)
('menu' addCustomMenuItems:hand: addFillStyleMenuItems:hand: autoFitOnOff autoFitString changeColorSimply changeMargins: changeTextColor changeTextColorSimply followCurve holderForCharacters promptForFont reverseCurveDirection setCurveBaseline: shiftedYellowButtonActivity wrapOnOff wrapString)
('multi level undo')
('objects from disk' convertToCurrentVersion:refStream: fixUponLoad:seg:)
('scripting access' getAllButFirstCharacter insertCharacters: insertContentsOf: setAllButFirstCharacter:)
('submorphs-add/remove' addMorphFront:fromWorldPosition: delete goBehind)
('testing' basicType)
('visual properties' color: fillStyle fillStyle:)
('*eToys-card in a stack' couldHoldSeparateDataForEachInstance)
('*eToys-card & stack' newContents:fromCard: setNewContentsFrom:)
('*eToys-e-toy support' configureForKids getNumericValue setNumericValue:)
('*eToys-player' currentDataValue variableDocks)
('*MorphicExtras-accessing' getCharacters)
('*MorphicExtras-copying' updateReferencesUsing:)
('*MorphicExtras-printing' fullPrintOn:)
('private' adjustLineIndicesBy: clippingRectangle composeToBounds compositionRectangle editorClass fit installEditor installEditorToReplace: paragraph paragraphClass predecessorChanged predecessor:successor: privateOwner: releaseEditor releaseParagraph releaseParagraphReally removedMorph: selectionChanged selectionColor selectionColor: setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph)
('*pango' usePango usePango:)
('localization' addTranslationItemsTo: localeChanged setLocale: toggleTranslatable translatable translatableString translatable: translations)
('menus' addFitAndWrapItemsTo: addTextMenuItemsTo:event:)
('property sheet' openAppropriatePropertySheet openATextPropertySheet)
('drop outside' mimeTypes)
!


!TextEmphasis reorganize!
('as yet unclassified' dominatedByCmd0 dominates: emphasisCode emphasisCode: emphasizeScanner: hash printOn: set turnOff writeScanOn: =)
('pango')
('html')
('*pango' asPangoValueFrom:to:)
!


!TextColor reorganize!
('accessing' color color:)
('comparing' hash =)
('printing' printOn:)
('scanning' dominates: emphasizeScanner: writeScanOn:)
('html')
('pango' asPangoValueFrom:to:)
!


!TextAttribute reorganize!
('as yet unclassified' actOnClickFor: actOnClickFor:in: actOnClickFor:in:at: actOnClickFor:in:at:editor: anchoredMorph couldDeriveFromPrettyPrinting dominatedByCmd0 dominates: emphasisCode emphasizeScanner: forFontInStyle:do: mayActOnClick mayBeExtended oldEmphasisCode: reset set)
('testing' isKern)
('html')
('pango')
('*pango' asPangoValueFrom:to:)
!


!Text reorganize!
('accessing' append: at: at:put: embeddedMorphs embeddedMorphsFrom:to: findString:startingAt: findString:startingAt:caseSensitive: lineCount prepend: rangeOf:startingAt: rangeOf:startingAt:forStyle: replaceFrom:to:with: runs: size string)
('attributes' askIfAddStyle:req: basicType couldDeriveFromPrettyPrinting unembellished)
('comparing' hash howManyMatch: isText =)
('converting' asDisplayText asNumber asOctetStringText asParagraph asString asStringOrText asText asUrl asUrlRelativeTo: isoToSqueak macToSqueak removeAttributesThat:replaceAttributesThat:by: replaceFrom:to:with:startingAt: reversed squeakToIso squeakToMac translated withSqueakLineEndings)
('copying' copy copyFrom:to: copyReplaceFrom:to:with: copyReplaceTokens:with: deepCopy)
('emphasis' addAttribute: addAttribute:from:to: alignmentAt:ifAbsent: allBold attributesAt: attributesAt:do: attributesAt:forStyle: emphasisAt: find: fontAt:withStyle: fontNumberAt: makeBoldFrom:to: makeSelectorBold makeSelectorBoldIn: removeAttribute:from:to: runLengthFor:)
('printing' printOn: storeOn:)
('*Morphic-converting' asMorph asStringMorph asTextMorph)
('private' runs setString:setRunsChecking: setString:setRuns:)
('html')
('pango')
('*rome-pango' asPangoAttributes pangoLanguageAttributes)
('*siss-private' sissInstVarNamed:put:in:)
!

Morph subclass: #StringMorph
	instanceVariableNames: 'font emphasis contents hasFocus usePango'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!StringMorph reorganize!
('accessing' contents contentsClipped: contents: fitContents font fontName:size: fontToUse font:emphasis: interimContents: label:font: measureContents minimumWidth setWidth: userString valueFromContents)
('connectors-layout' minHeight)
('drawing' drawOn: lookTranslucent)
('editing' acceptContents acceptValue: cancelEdits doneWithEdits launchMiniEditor: lostFocusWithoutAccepting wantsKeyboardFocusOnShiftClick)
('event handling' handlesMouseDown: hasFocus mouseDown: wouldAcceptKeyboardFocus)
('font' emphasis:)
('halos and balloon help' addOptionalHandlesTo:box: boundsForBalloon)
('initialization' defaultColor initialize initWithContents:font:emphasis:)
('layout' fullBounds)
('menu' addCustomMenuItems:hand: changeEmphasis changeFont)
('objects from disk' fixUponLoad:seg:)
('parts bin' initializeToStandAlone)
('printing' font: printOn:)
('*MorphicExtras-accessing' getCharacters handsWithMeForKeyboardFocus)
('*MorphicExtras-printing' fullPrintOn:)
('*Tools' balloonTextForClassAndMethodString balloonTextForLexiconString balloonTextForMethodString)
('pango' asPangoAttributes pangoDrawOn:in:color: pangoMeasureContents usePango usePango:)
('drop outside' mimeTypes)
('*connectors-testing' isStringMorph)
!


!String reorganize!
('accessing' byteAt: byteAt:put: byteSize do:toFieldNumber: endsWithDigit findAnySubStr:startingAt: findBetweenSubStrs: findCloseParenthesisFor: findDelimiters:startingAt: findLastOccuranceOfString:startingAt: findLastOccurrenceOfString:startingAt: findString: findString:startingAt: findString:startingAt:caseSensitive: findTokens: findTokens:includes: findTokens:keep: findWordStart:startingAt: includesSubString: includesSubstring:caseSensitive: indexOfAnyOf: indexOfAnyOf:ifAbsent: indexOfAnyOf:startingAt: indexOfAnyOf:startingAt:ifAbsent: indexOfSubCollection: indexOfSubCollection:startingAt:ifAbsent: indexOf: indexOf:startingAt: indexOf:startingAt:ifAbsent: lastIndexOfPKSignature: leadingCharRunLengthAt: lineCorrespondingToIndex: lineCount lineNumber: linesDo: skipAnySubStr:startingAt: skipDelimiters:startingAt: startsWithDigit tabDelimitedFieldsDo:)
('arithmetic' * + - / // \\)
('comparing' alike: beginsWith: caseInsensitiveLessOrEqual: caseSensitiveLessOrEqual: charactersExactlyMatching: compare: compare:caseSensitive: compare:with:collated: crc16 endsWithAnyOf: endsWith: hash hashMappedBy: howManyMatch: match: sameAs: startingAt:match:startingAt: < <= = > >=)
('converting' adaptToCollection:andSend: adaptToNumber:andSend: adaptToPoint:andSend: adaptToString:andSend: asByteArray asByteString asCharacter asDate asDateAndTime asDefaultDecodedString asDisplayText asDuration asFileName asFourCode asHex asHtml asIdentifier: asInteger asIntegerIfAllDigits asIRCLowercase askIfAddStyle:req: asLegalSelector asLowercase asLowercaseAlphabetic asNumber asOctetString asPacked asParagraph asSignedInteger asSmalltalkComment asSqueakPathName asString asStringOrText asSymbol asText asTime asTimeStamp asUnHtml asUnsignedInteger asUppercase asUrl asUrlRelativeTo: asVmPathName asWideString capitalized composeAccents compressWithTable: contractTo: convertFromEncoding: convertFromSuperSwikiServerString convertFromWithConverter: convertToEncoding: convertToSuperSwikiServerString convertToSystemString convertToWithConverter: correctAgainstDictionary:continuedFrom: correctAgainst: correctAgainst:continuedFrom: encodeForHTTP encodeForHTTPWithTextEncoding: encodeForHTTPWithTextEncoding:conditionBlock: findSelector fromCamelCase initialIntegerOrNil keywords numericSuffix onlyLetters romanNumber sansPeriodSuffix splitInteger squeakToUtf8 stemAndNumericSuffix subStrings subStrings: substrings surroundedBySingleQuotes toCamelCase translateFrom:to:table: translateToLowercase translateToUppercase translateWith: truncateTo: truncateWithElipsisTo: unescapePercents unescapePercentsWithTextEncoding: unparenthetically unzipped utf8ToSqueak withBlanksCondensed withBlanksTrimmed withFirstCharacterDownshifted withNoLineLongerThan: withoutLeadingDigits withoutTrailingBlanks withoutTrailingDigits withSeparatorsCompacted)
('copying' copy copyReplaceTokens:with: deepCopy padded:to:with: shallowCopy)
('displaying' displayAt: displayOn: displayOn:at: displayOn:at:textColor: displayProgressAt:from:to:during:)
('encoding' getInteger32: putInteger32:at: writeLeadingCharRunsOn:)
('filter streaming' byteEncode: putOn:)
('formatting' format: withCRs)
('internet' decodeMimeHeader decodeQuotedPrintable isoToSqueak isoToUtf8 macToSqueak squeakToIso squeakToMac utf8ToIso withInternetLineEndings withoutQuoting withSqueakLineEndings)
('paragraph support' indentationIfBlank:)
('printing' basicType encodeDoublingQuoteOn: isLiteral printOn: storeOn: stringRepresentation)
('system primitives' endsWithAColon findSubstring:in:startingAt:matchTable: numArgs)
('testing' hasContentsInExplorer includesUnifiedCharacter isAllDigits isAllSeparators isAsciiString isByteString isOctetString isReallyString isString isWideString lastSpacePosition)
('translating' literalStringsDo: translated translatedIfCorresponds translatedNoop translatedTo: translatedTo:inDomain:)
('user interface' asExplorerString openInWorkspaceWithTitle:)
('*eToys-*Morphic' newTileMorphRepresentative)
('*Morphic' asMorph asStringMorph)
('*MorphicExtras-*morphic-Postscript Canvases' asPostscript)
('*Morphic-converting' openAsMorph)
('*monticello')
('*network-uri')
('*packageinfo-base' escapeEntities)
('*services-base')
('*versionnumber' asVersion)
('private' correctAgainstEnumerator:continuedFrom: evaluateExpression:parameters: getEnclosedExpressionFrom: replaceFrom:to:with:startingAt: stringhash)
('pango' asPangoAttributes)
('Camp Smalltalk' sunitAsSymbol sunitMatch: sunitSubStrings)
('*network-mime' asMIMEType)
('*connectors-converting' splitOnCapBoundaries)
('*DBus-Core' dbusType)
('*network-HTML' replaceHtmlCharRefs)
('*xml-parser' applyLanguageInfomation:)
('*FSM-events' eventType)
('*connectors-comparing' beginsWith2:)
('*siss-converting' sissEscape sissUnescape)
!

RunArray initialize!

!RunArray class reorganize!
('instance creation' new newFrom: new:withAll: readFrom: runs:values: scanFrom:)
('*system-support' initialize shutDown)
('*siss-instance creation' sissCreateInstanceFromSexp:idref:from:to:)
!

ArrayedCollection subclass: #RunArray
	instanceVariableNames: 'runs values lastIndex lastRun lastOffset pangoAttrCache'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Arrayed'!

!RunArray reorganize!
('accessing' at: first last runLengthAt: size withStartStopAndValueDo: =)
('adding' addFirst: addLast: addLast:times: coalesce rangeOf:startingAt: repeatLastIfEmpty: repeatLast:ifEmpty:)
('converting' reversed)
('copying' copyFrom:to: copyReplaceFrom:to:with: ,)
('enumerating' runsAndValuesDo: runsFrom:to:do:)
('printing' printOn: storeOn: writeOn: writeScanOn:)
('self evaluating')
('private' at:setRunOffsetAndValue: mapValues: runs setRuns:setValues: values)
('*pango' asPangoAttributesFor: clearCache pangoFontAttributeFromArray:from:to:)
('*siss-interface' sissExportSpecification)
('*siss-private' sissInstVarNamed:put:in:)
!

"Postscript:
"
Preferences addPreference: #usePangoRenderer category: #morphic default: false balloonHelp: 'governs whether to use external pango library to render text'.
!