'From Cuis 1.0 of 16 July 2009 [latest update: #228] on 27 July 2009 at 12:18:26 pm'!
!classDefinition: #AbstractFont category: #'Graphics-Text'!
Object subclass: #AbstractFont
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterBlock category: #'Graphics-Text'!
Rectangle subclass: #CharacterBlock
	instanceVariableNames: 'stringIndex text textLine '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterBlockScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CharacterBlockScanner
	instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CompositionScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CompositionScanner
	instanceVariableNames: 'spaceX spaceIndex lineHeight baseline lineHeightAtSpace baselineAtSpace '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #DisplayScanner category: #'Graphics-Text'!
CharacterScanner subclass: #DisplayScanner
	instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraph paragraphColor morphicOffset ignoreColorChanges '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #LimitingLineStreamWrapper category: #'Collections-Streams'!
Object subclass: #LimitingLineStreamWrapper
	instanceVariableNames: 'stream line limitingBlock position '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Streams'!
!classDefinition: #StrikeFont category: #'Graphics-Text'!
AbstractFont subclass: #StrikeFont
	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize '
	classVariableNames: 'DefaultStringScanner '
	poolDictionaries: ''
	category: 'Graphics-Text'!

!AbstractFont methodsFor: 'accessing' stamp: 'jmv 7/27/2009 10:35'!
textStyle
	^ TextStyle availableTextStyles detect:
		[:aStyle | aStyle fontArray includes: self] ifNone: [ TextStyle fontArray: { self } ]! !

!AbstractFont methodsFor: 'accessing' stamp: 'jmv 7/27/2009 11:31'!
textStyleName
	"Answer the name to be used as a key in the TextStyles availableTextStyles dictionary."
	^self familyName! !


!Color class methodsFor: 'color from user' stamp: 'jmv 7/27/2009 11:32'!
colorPaletteForDepth: depth extent: chartExtent
	"Display a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
	"Note: It is slow to build this palette, so it should be cached for quick access."
	"(Color colorPaletteForDepth: 16 extent: 190@60) display"

	| basicHue x y c startHue palette transHt vSteps transCaption grayWidth hSteps |
	palette _ Form extent: chartExtent depth: depth.
	transCaption _ 
		(Form extent: 34@9 depth: 1
			fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
			offset: 0@0).
	transHt _ transCaption height.
	palette fillWhite: (0@0 extent: palette width@transHt).
	palette fillBlack: (0@transHt extent: palette width@1).
	transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
	grayWidth _ 10.
	startHue _ 338.0.
	vSteps _ palette height - transHt // 2.
	hSteps _ palette width - grayWidth.
	x _ 0.
	startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h |
		basicHue _ Color h: h asFloat s: 1.0 v: 1.0.
		y _ transHt+1.
		0 to: vSteps do: [:n |
 			c _ basicHue mixed: (n asFloat / vSteps asFloat) with: Color white.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y _ y + 1].
		1 to: vSteps do: [:n |
 			c _ Color black mixed: (n asFloat / vSteps asFloat) with: basicHue.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y _ y + 1].
		x _ x + 1].
	y _ transHt + 1.
	1 to: vSteps * 2 do: [:n |
 		c _ Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white.
		palette fill: (x@y extent: 10@1) fillColor: c.
		y _ y + 1].
	^ palette
! !

!Color class methodsFor: 'color from user' stamp: 'jmv 7/27/2009 11:32'!
colorTest: depth extent: chartExtent colorMapper: colorMapper
	"Create a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
	"Note: It is slow to build this palette, so it should be cached for quick access."
	"(Color colorTest: 32 extent: 570@180 colorMapper: [:c | c]) display"
	"(Color colorTest: 32 extent: 570@180 colorMapper:
		[:c | Color
			r: (c red * 7) asInteger / 7
			g: (c green * 7) asInteger / 7
			b: (c blue * 3) asInteger / 3]) display"
	"(Color colorTest: 32 extent: 570@180 colorMapper:
		[:c | Color
			r: (c red * 5) asInteger / 5
			g: (c green * 5) asInteger / 5
			b: (c blue * 5) asInteger / 5]) display"
	"(Color colorTest: 32 extent: 570@180 colorMapper:
		[:c | Color
			r: (c red * 15) asInteger / 15
			g: (c green * 15) asInteger / 15
			b: (c blue * 15) asInteger / 15]) display"
	"(Color colorTest: 32 extent: 570@180 colorMapper:
		[:c | Color
			r: (c red * 31) asInteger / 31
			g: (c green * 31) asInteger / 31
			b: (c blue * 31) asInteger / 31]) display"

	| basicHue x y c startHue palette transHt vSteps transCaption grayWidth hSteps |
	palette _ Form extent: chartExtent depth: depth.
	transCaption _ 
		(Form extent: 34@9 depth: 1
			fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
			offset: 0@0).
	transHt _ transCaption height.
	palette fillWhite: (0@0 extent: palette width@transHt).
	palette fillBlack: (0@transHt extent: palette width@1).
	transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
	grayWidth _ 10.
	startHue _ 338.0.
	vSteps _ palette height - transHt // 2.
	hSteps _ palette width - grayWidth.
	x _ 0.
	startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h |
		basicHue _ Color h: h asFloat s: 1.0 v: 1.0.
		y _ transHt+1.
		0 to: vSteps do: [:n |
 			c _ basicHue mixed: (n asFloat / vSteps asFloat) with: Color white.
			c _ colorMapper value: c.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y _ y + 1].
		1 to: vSteps do: [:n |
 			c _ Color black mixed: (n asFloat / vSteps asFloat) with: basicHue.
			c _ colorMapper value: c.
			palette fill: (x@y extent: 1@1) fillColor: c.
			y _ y + 1].
		x _ x + 1].
	y _ transHt + 1.
	1 to: vSteps * 2 do: [:n |
 		c _ Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white.
		c _ colorMapper value: c.
		palette fill: (x@y extent: 10@1) fillColor: c.
		y _ y + 1].
	^ palette
! !


!ParseNode methodsFor: 'private' stamp: 'jmv 7/27/2009 11:35'!
printSingleComment: aString on: aStream indent: indent 
	"Print the comment string, assuming it has been indented indent tabs.
	Break the string at word breaks, given the widths in the default
	font, at 450 points."

	| readStream word position lineBreak font wordWidth tabWidth spaceWidth lastChar |
	readStream _ ReadStream on: aString.
	font _ TextStyle default defaultFont.
	tabWidth _ TextStyle defaultTab.
	spaceWidth _ font widthOf: Character space.
	position _ indent * tabWidth.
	lineBreak _ 450.
	[readStream atEnd]
		whileFalse: 
			[word _ self nextWordFrom: readStream setCharacter: [:lc | lastChar _ lc].
			wordWidth _ word inject: 0 into: [:width :char | width + (font widthOf: char)].
			position _ position + wordWidth.
			position > lineBreak
				ifTrue: 
					[aStream crtab: indent.
					position _ indent * tabWidth + wordWidth + spaceWidth.
					lastChar = Character cr
						ifTrue: [[readStream peekFor: Character tab] whileTrue].
					word isEmpty ifFalse: [aStream nextPutAll: word; space]]
				ifFalse: 
					[aStream nextPutAll: word.
					readStream atEnd
						ifFalse: 
							[position _ position + spaceWidth.
							aStream space].
					lastChar = Character cr
						ifTrue: 
							[aStream crtab: indent.
							position _ indent * tabWidth.
							[readStream peekFor: Character tab] whileTrue]]]! !


!Preferences class methodsFor: 'fonts' stamp: 'jmv 7/27/2009 11:01'!
chooseSystemFont
	self chooseFontWithPrompt: 'Default text font' andSendTo: self withSelector: #setSystemFontTo: highlight: TextStyle defaultFont! !

!Preferences class methodsFor: 'fonts' stamp: 'jmv 7/27/2009 11:01'!
setSystemFontTo: aFont
	"Establish the default text font and style"

	| aStyle newDefaultStyle |
	aFont ifNil: [^ self].
	aStyle _ aFont textStyle ifNil: [^ self].
	newDefaultStyle _ aStyle copy.
	newDefaultStyle defaultFontIndex: (aStyle fontIndexOf: aFont).
	TextStyle default: newDefaultStyle! !


!StrikeFont methodsFor: 'accessing' stamp: 'jmv 7/27/2009 10:35'!
textStyle
	^ TextStyle availableTextStyles detect:
		[:aStyle | aStyle fontArray includes: self] ifNone: [nil]! !

!StrikeFont methodsFor: 'file in/out' stamp: 'jmv 7/27/2009 09:34'!
objectForDataStream: refStrm
	| dp |
	"I am about to be written on an object file.  Write a reference to a known Font in the other system instead.  "

	"A path to me"

	dp _ DiskProxy global: #StrikeFont selector: #familyName:size:emphasized:
			args: (Array with: self familyName   with: self height
					with: self emphasis).
	refStrm replace: self with: dp.
	^ dp! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 7/27/2009 11:38'!
buildFromForm: allGlyphs data: data name: aString
	"
	TextStyle makeAvailable: (TextStyle fontArray: (Array
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 8.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 8.txt') contentsOfEntireFile substrings
			name: 'DejaVu 8')
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 9.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 9.txt') contentsOfEntireFile substrings
			name: 'DejaVu 9')
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 10.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 10.txt') contentsOfEntireFile substrings
			name: 'DejaVu 10')))
		as: #DejaVu
	"
	| x |
	pointSize _ data first asNumber.
	ascent _ data second asNumber.
	descent _ data third asNumber.
	
	minAscii _ 32.
	maxAscii _ 255.
	name _ aString.
	type _ 0.  "ignored for now"
	superscript _ ascent - descent // 3.	
	subscript _ descent - ascent // 3.	
	emphasis _ 0.

	xTable _ (Array new: 258) atAllPut: 0.
	maxWidth _ 0.
	glyphs _ allGlyphs.
	x _ 0.
	minAscii to: maxAscii+1 do: [ :i |
		x _ (data at: i-minAscii+4) asNumber.
		xTable at: i+1 put: x].
	xTable at: 258 put: x.
	self reset.
	derivativeFonts _ Array new: 32! !


!StrikeFont class methodsFor: 'instance creation' stamp: 'jmv 7/27/2009 11:43'!
installDejaVu
"
StrikeFont installDejaVu
"
	| baseF base boldF italicF bold italic sizes boldItalicF boldItalic data |
	sizes _ 5 to: 24.
	baseF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Book ', s printString -> ('DejaVu ', s printString) ].
	boldF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Bold ', s printString -> ('DejaVu ', s printString, 'B') ].
	italicF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Oblique ', s printString -> ('DejaVu ', s printString, 'I') ].
	boldItalicF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Bold Oblique ', s printString -> ('DejaVu ', s printString, 'BI') ].
		
	base := OrderedCollection new.
	bold := OrderedCollection new.
	italic := OrderedCollection new.
	boldItalic := OrderedCollection new.
	
			baseF withIndexDo: [:keyValue :index | |form |	
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					base add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						pointSize: keyValue value substrings last asNumber)].
			boldF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					bold add: ((StrikeFont new buildFromForm: form data: data name: keyValue value) 
						emphasis: 1;
						pointSize: keyValue value substrings last asNumber)].
			italicF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					italic add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						emphasis:2;
						pointSize: keyValue value substrings last asNumber)].
			boldItalicF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					boldItalic add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						emphasis:3;
						pointSize: keyValue value substrings last asNumber)].
			
			1 to: base size do: [ :i |
				(base at: i) derivativeFont: (bold at: i) at: 1.
				(base at: i) derivativeFont: (italic at: i) at: 2.
				(base at: i) derivativeFont: (boldItalic at: i) at: 3 ].

			TextStyle named: #DejaVu put: (TextStyle fontArray: base).
"
			Preferences setDefaultFonts: #(
				(setSystemFontTo: 'DejaVu' 9)
				(setListFontTo: 'DejaVu' 9)
				(setMenuFontTo: 'DejaVu' 10)
				(setWindowTitleFontTo: 'DejaVu' 12)
				(setBalloonHelpFontTo: 'DejaVu' 10)
				(setCodeFontTo: 'DejaVu' 10)
				(setButtonFontTo: 'DejaVu' 9))
"! !

!StrikeFont class methodsFor: 'accessing' stamp: 'jmv 7/27/2009 11:07'!
actualFamilyNames
	"Answer a sorted list of actual family names, without the Default aliases"
	
	^TextStyle availableTextStyles keys asArray sort asOrderedCollection! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 7/27/2009 11:45'!
removeForPDA
"
StrikeFont removeForPDA
"
	| style keep dejaVu |
	style _ TextStyle named: #DejaVu.
	keep _ #(5 6 7 8 9) collect: [ :s |
		style fontNamed: 'DejaVu ', s printString ].
	keep do: [ :f |
		f derivativeFont: nil at: 0 ].
	dejaVu _ TextStyle fontArray: keep.
	self actualFamilyNames do: [ :n |
		TextStyle removeNamed: n ].
	TextStyle named: #DejaVu put: dejaVu.
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 8)
		(setListFontTo: 'DejaVu' 6)
		(setMenuFontTo: 'DejaVu' 7)
		(setWindowTitleFontTo: 'DejaVu' 9)
		(setBalloonHelpFontTo: 'DejaVu' 7)
		(setCodeFontTo: 'DejaVu' 7)
		(setButtonFontTo: 'DejaVu' 7))! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 7/27/2009 11:45'!
removeMostFonts
"
StrikeFont removeMostFonts
"
	| style keep dejaVu |
	style _ TextStyle named: #DejaVu.
	keep _ #(8 10 12 14 16 18 20) collect: [ :s |
		style fontNamed: 'DejaVu ', s printString ].
	keep do: [ :f |
		f derivativeFont: nil at: 0 ].
	dejaVu _ TextStyle fontArray: keep.
	self actualFamilyNames do: [ :n |
		TextStyle removeNamed: n ].
	TextStyle named: #DejaVu put: dejaVu.
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 10)
		(setListFontTo: 'DejaVu' 10)
		(setMenuFontTo: 'DejaVu' 10)
		(setWindowTitleFontTo: 'DejaVu' 12)
		(setBalloonHelpFontTo: 'DejaVu' 8)
		(setCodeFontTo: 'DejaVu' 10)
		(setButtonFontTo: 'DejaVu' 10))! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 7/27/2009 11:45'!
removeSomeFonts
"
StrikeFont removeSomeFonts
"
	| style keep dejaVu |
	style _ TextStyle named: #DejaVu.

	"Remove bold italic (but leave bold and italic)"
	#(5 6 7 8 9 10 11 12 14 16 18 20 24) do: [ :s |
		(style fontNamed: 'DejaVu ', s printString)
			derivativeFont: nil at: 3 ].
	"Remove all derivative fonts for these"
	#(5 6 7 8 11 12 14 16 20 24) do: [ :s |
		(style fontNamed: 'DejaVu ', s printString)
			derivativeFont: nil at: 0 ].

	keep _ #(5 6 7 8 9 10 11 12 14 16 18 20 24) collect: [ :s |
		style fontNamed: 'DejaVu ', s printString ].
	dejaVu _ TextStyle fontArray: keep.
	self actualFamilyNames do: [ :n |
		TextStyle removeNamed: n ].
	TextStyle named: #DejaVu put: dejaVu.
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 9)
		(setListFontTo: 'DejaVu' 9)
		(setMenuFontTo: 'DejaVu' 10)
		(setWindowTitleFontTo: 'DejaVu' 12)
		(setBalloonHelpFontTo: 'DejaVu' 8)
		(setCodeFontTo: 'DejaVu' 9)
		(setButtonFontTo: 'DejaVu' 9))! !


!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 7/27/2009 11:41'!
discardOddsAndEnds
	"This method throws out lots of classes that are not frequently used."
	"Smalltalk discardOddsAndEnds"

	SystemOrganization removeSystemCategory: 'System-Serial Port'.
	SystemOrganization removeSystemCategory: 'ST80-Symbols'.
	SystemOrganization removeSystemCategory: 'Tools-File Contents Browser'.
	SystemOrganization removeSystemCategory: 'System-Compression'.
	SystemOrganization removeSystemCategory: 'Tools-Explorer'.
	SystemOrganization removeSystemCategory: 'System-Digital Signatures'.

	Form removeSelector: #edit.
	Smalltalk removeClassNamed: #FormEditorView.
	Smalltalk removeClassNamed: #FormEditor.
	SystemOrganization removeSystemCategory: 'ST80-Paths'.

	"bit editor (remove Form editor first):"
	Form removeSelector: #bitEdit.
	Form removeSelector: #bitEditAt:scale:.
	StrikeFont removeSelector: #edit:.
	Smalltalk removeClassNamed: #FormButtonCache.
	Smalltalk removeClassNamed: #FormMenuController.
	Smalltalk removeClassNamed: #FormMenuView.
	Smalltalk removeClassNamed: #BitEditor.

	"inspector for Dictionaries of Forms"
	Dictionary removeSelector: #inspectFormsWithLabel:.
	Smalltalk removeClassNamed: #FormHolderView.
	Smalltalk removeClassNamed: #FormInspectView.

	"experimental updating object viewer:"
	Object removeSelector: #evaluate:wheneverChangeIn:.
	Smalltalk removeClassNamed: #ObjectViewer.
	Smalltalk removeClassNamed: #ObjectTracer.

	"miscellaneous classes:"
	Smalltalk removeClassNamed: #Array2D.
	Smalltalk removeClassNamed: #DriveACar.
	Smalltalk removeClassNamed: #EventRecorder.
	Smalltalk removeClassNamed: #FindTheLight.
	Smalltalk removeClassNamed: #PluggableTest.
	Smalltalk removeClassNamed: #SystemMonitor.
	Smalltalk removeClassNamed: #DocLibrary.

	Smalltalk removeClassNamed: #ProtocolBrowser.
	Smalltalk removeClassNamed: #ObjectExplorerWrapper.
	Smalltalk removeClassNamed: #HierarchyBrowser.
	Smalltalk removeClassNamed: #LinkedMessageSet.
	Smalltalk removeClassNamed: #ObjectExplorer.
	Smalltalk removeClassNamed: #PackageBrowser.
	Smalltalk removeClassNamed: #AbstractHierarchicalList.
	Smalltalk removeClassNamed: #ChangeList.
	Smalltalk removeClassNamed: #VersionsBrowser.
	Smalltalk removeClassNamed: #ChangeRecord.
	Smalltalk removeClassNamed: #SelectorBrowser.
	Smalltalk removeClassNamed: #CrLfFileStream.
	Smalltalk removeClassNamed: #FXGrafPort.
	Smalltalk removeClassNamed: #FXBlt.

	Smalltalk at: #SampledSound ifPresent: [:c |c initialize].

Preferences setButtonFontTo:	(StrikeFont familyName: #NewYork size: 12).

#(GZipConstants ZipConstants KlattResonatorIndices ) do:
	[:k | Smalltalk removeKey: k ifAbsent: []].
! !


!Text class methodsFor: 'class initialization' stamp: 'jmv 7/27/2009 12:10'!
initTextConstants 
	"Initialize constants shared by classes associated with text display, e.g., 
	Space, Tab, Cr, Bs, ESC."

	| varAndValue tempArray width |
	
	TextConstants keys do: [ :k |
		TextConstants removeKey: k ].

	varAndValue _ #(
		Space		32
		Tab		9
		CR			13
		Enter		3
		BS			8
	).
	varAndValue size odd ifTrue: [self error: 'unpaired text constant'].
	(2 to: varAndValue size by: 2) do:
		[:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i) asCharacter].

	varAndValue _ #(
			"location of non-character stop conditions"
		EndOfRun			257
		CrossedX			258
			"values for alignment"
		LeftFlush			0
		RightFlush			1
		Centered			2
		Justified			3
		DefaultTab			24
	).
	varAndValue size odd ifTrue: [self error: 'unpaired text constant'].
	(2 to: varAndValue size by: 2) do:
		[:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i)].

	width _ Display width max: 720.
	tempArray _ Array new: width // DefaultTab.
	1 to: tempArray size do:
		[:i | tempArray at: i put: DefaultTab * i].
	TextConstants at: #DefaultTabsArray put: tempArray.
	tempArray _ Array new: (width // DefaultTab) // 2.
	1 to: tempArray size do:
		[:i | tempArray at: i put: (Array with: (DefaultTab*i) with: (DefaultTab*i))].
	TextConstants at: #DefaultMarginTabsArray put: tempArray.

"Text initTextConstants "! !


!TextEditor methodsFor: 'attributes' stamp: 'jmv 7/27/2009 11:08'!
changeStyle
	"Let user change styles for the current text pane."
	| aList reply style theStyle menuList |
	aList _ StrikeFont actualFamilyNames.
	theStyle _ paragraph textStyle.
	menuList _ aList collect: [ :styleName|
		"Hack!! use defaultFont for comparison - we have no name that we could use for compare and the style changes with alignment so they're no longer equal."
		(TextStyle named: styleName) defaultFont == theStyle defaultFont
			ifTrue:['<on>', styleName]
			ifFalse:['<off>',styleName]].
	theStyle = TextStyle default
		ifTrue:[menuList addFirst: '<on>Default Text Style']
		ifFalse:[menuList addFirst: '<off>Default Text Style'].
	aList addFirst: 'Default Text Style'.
	reply _ (SelectionMenu labelList: menuList lines: #(1) selections: aList) startUp.
	reply ifNotNil:
		[(style _ TextStyle named: reply) ifNil: [Beeper beep. ^ true].
		paragraph textStyle: style copy.
		paragraph composeAll.
		self recomputeSelection].
	^ true! !


!TextStyle class methodsFor: 'class initialization' stamp: 'jmv 7/27/2009 11:47'!
initialize
	AXXvailableTextStyles _ Dictionary new! !

!TextStyle class methodsFor: 'constants' stamp: 'jmv 7/27/2009 11:35'!
defaultTab
	^DefaultTab! !

!TextStyle class methodsFor: 'user interface' stamp: 'jmv 7/27/2009 10:35'!
modalStyleSelectorWithTitle: title 
	"Presents a modal font-style choice menu, answers a TextStyle or nil."

	"TextStyle modalStyleSelectorWithTitle: 'testing'"

	| menu |
	menu := MenuMorph entitled: title.
	self availableTextStyles keysAndValuesDo: 
			[:styleName :style | 
			menu 
				add: styleName
				target: menu
				selector: #modalSelection:
				argument: style.
			menu lastItem font: (style fontOfSize: 18)].
	^menu invokeModal! !

!TextStyle class methodsFor: 'user interface' stamp: 'jmv 7/27/2009 10:35'!
promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont
	"Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector."

	"TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector: #setSystemFontTo:"
	"Derived from a method written by Robin Gibson"

        | menu subMenu currentTextStyle currentSize |
        currentTextStyle _ currentFont ifNotNil: [currentFont textStyleName].
        menu _ MenuMorph entitled: aPrompt.
        self availableTextStyles keys do: [:styleName|
                currentSize _  (styleName = currentTextStyle ifTrue: [currentFont pointSize]).
                subMenu _ self fontMenuForStyle: styleName target: aTarget selector: aSelector highlight: currentSize.
                menu add: styleName subMenu: subMenu.
                menu lastItem font: ((self named: styleName) fontOfSize: 18).
                styleName = currentTextStyle ifTrue: [menu lastItem color: Color blue darker]].

        menu popUpInWorld: self currentWorld! !

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

	"TextStyle availableTextStyles"
	^ AXXvailableTextStyles! !

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

	^DXXefaultTextStyle! !

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

	DXXefaultTextStyle _ aTextStyle! !

!TextStyle class methodsFor: 'instance accessing' stamp: 'jmv 7/27/2009 11:34'!
defaultFont
	"Answer the default system font"

	^ self default defaultFont! !

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

	^ AXXvailableTextStyles at: aSymbol! !

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

	AXXvailableTextStyles at: aSymbol put: aTextStyle! !

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

	AXXvailableTextStyles removeKey: aSymbol! !


!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 7/27/2009 10:26'!
helpMenu
        "Build the help menu for the world."
        |  menu |

  	menu := self menu: 'help...' translated.

        self fillIn: menu from:
        {
                {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}.
                {'preferences...'. {Preferences. #openPreferencesInspector}. 'view and change various options.'}.
                nil.
               {'command-key help'. { Utilities . #openCommandKeyHelp}. 'summary of keyboard shortcuts.'}
	}.

	self addGestureHelpItemsTo: menu.

	self fillIn: menu from:
	{
                {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}.
                {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}.
                nil.

                {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}.
                {'vm statistics' . { self . #vmStatistics}.  'obtain some intriguing data about the vm.'}.
			nil.
                {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}.
        }.

	^menu

! !

TextStyle class removeSelector: #actualTextStyles!
TextStyle class removeSelector: #collectionFromCompressedMIMEString:!
TextStyle class removeSelector: #fontPointSizesFor:!
TextStyle class removeSelector: #fontSizeSummary!
TextStyle initialize!
TextStyle class removeSelector: #initializeStyleDecoder!
TextStyle class removeSelector: #knownTextStyles!
TextStyle class removeSelector: #looseFontsFromFamily:!
TextStyle class removeSelector: #replaceFontsIn:with:!
TextStyle class removeSelector: #replaceStyle:with:!
TextStyle class removeSelector: #styleDecoder!

!TextStyle class reorganize!
('TextConstants access' fontArrayForStyle: fontSizesFor: fontWidthsFor: pointSizesFor:)
('class initialization' initialize temporaryInitialize)
('constants' defaultTab)
('instance creation' fontArray: new)
('mime file in/out')
('user interface' fontMenuForStyle:target:selector:highlight: modalStyleSelectorWithTitle: promptForFont:andSendTo:withSelector:highlight:)
('instance accessing' availableTextStyles default default: defaultFont named: named:put: removeNamed:)
!

TextStyle removeSelector: #alignmentSymbol!
TextStyle removeSelector: #collectionFromFileNamed:!
TextStyle removeSelector: #compressedMIMEEncodedStream!

!TextStyle reorganize!
('accessing' alignment alignment: baseline baseline: centered defaultFont firstIndent firstIndent: fontNamed: fontNames fontNamesAndSizes fontNamesWithPointSizes fonts justified leading leading: leftFlush lineGrid lineGrid: pointSizes printOn: restIndent restIndent: rightFlush rightIndent rightIndent:)
('tabs and margins' clearIndents leftMarginTabAt: nextTabXFrom:leftMargin:rightMargin: rightMarginTabAt: tabWidth)
('fonts and font indexes' consistOnlyOf: fontIndexOf: fontIndexOfPointSize: fontIndexOfSize: fontOfPointSize: fontOfSize:)
('private' fontArray fontAt: fontAt:put: gridForFont:withLead: marginTabAt:side: newFontArray:)
('Disk I/O' veryDeepCopyWith:)
('default font' defaultFontIndex defaultFontIndex:)
('comparing' = hash species)
!

StrikeFont class removeSelector: #convertFontsNamed:!
StrikeFont class removeSelector: #decodedFromRemoteCanvas:!
StrikeFont class removeSelector: #example!
StrikeFont class removeSelector: #familyNames!
StrikeFont class removeSelector: #fromStrike:!
StrikeFont class removeSelector: #installAAVera!
StrikeFont class removeSelector: #readStrikeFont2Family:!
StrikeFont removeSelector: #aComment!
StrikeFont removeSelector: #buildFromForm:name:!
StrikeFont removeSelector: #buildFromMarked:name:!
StrikeFont removeSelector: #buildFromTableForm:name:!
StrikeFont removeSelector: #buildfontNamed:fromForms:startingAtAscii:ascent:descent:maxWid:!
StrikeFont removeSelector: #columnMarkersIn:top:!
StrikeFont removeSelector: #displayChar:form:!
StrikeFont removeSelector: #encodedForRemoteCanvas!
StrikeFont removeSelector: #familySizeFace!
StrikeFont removeSelector: #glyph:in:rect:!
StrikeFont removeSelector: #glyphsStartAndEndIn:!
StrikeFont removeSelector: #lineMarkersIn:!
StrikeFont removeSelector: #lineMarkersInTable:!
StrikeFont removeSelector: #newFromStrike:!
StrikeFont removeSelector: #raster!
StrikeFont removeSelector: #readBFHeaderFrom:!
StrikeFont removeSelector: #readFromBitFont:!
StrikeFont removeSelector: #readFromStrike2:!
StrikeFont removeSelector: #readFromStrike2Stream:!
StrikeFont removeSelector: #readMacFontHex:!
StrikeFont removeSelector: #restOfLine:from:!
StrikeFont removeSelector: #strikeFromHex:width:height:!
StrikeFont removeSelector: #writeAsStrike2On:!
StrikeFont removeSelector: #writeAsStrike2named:!
StrikeFont removeSelector: #xTableFromHex:!
!classDefinition: #StrikeFont category: #'Graphics-Text'!
AbstractFont subclass: #StrikeFont
	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth ascent descent subscript superscript emphasis derivativeFonts pointSize'
	classVariableNames: 'DefaultStringScanner'
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #LimitingLineStreamWrapper category: #'Collections-Streams'!
Object subclass: #LimitingLineStreamWrapper
	instanceVariableNames: 'stream line limitingBlock position'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Streams'!
!classDefinition: #DisplayScanner category: #'Graphics-Text'!
CharacterScanner subclass: #DisplayScanner
	instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraphColor morphicOffset ignoreColorChanges'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
DisplayObject class removeSelector: #collectionFromFileNamed:!
!classDefinition: #CompositionScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CompositionScanner
	instanceVariableNames: 'spaceX spaceIndex lineHeight baseline lineHeightAtSpace baselineAtSpace'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterBlockScanner category: #'Graphics-Text'!
CharacterScanner subclass: #CharacterBlockScanner
	instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #CharacterBlock category: #'Graphics-Text'!
Rectangle subclass: #CharacterBlock
	instanceVariableNames: 'stringIndex text textLine'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
AbstractFont removeSelector: #isRegular!
"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."
Text initTextConstants !

