'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6662] on 10 May 2005 at 12:07:42 pm'!
"Change Set:		TextToolColorAlign
Date:			10 May 2005
Author:			Takashi Yamamiya

Making possible to change text color and alignment in TextTool.
(it includes postscript)"
!

CPlayer subclass: #CButtonList
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
	<field toGet="selection" toSet="selection:" changeEvent="selectionChanged">selection</field>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tweak-Tools-TextTool'!

!CButtonList commentStamp: 'tak 5/10/2005 11:39' prior: 0!
This is a holder where radio buttons are. This is almost a copy of CStyleReadoutList.
I don't think this is a good manner, and I wonder if it is integrated in CStyleReadoutList
or impremented as a subclass of CList...!

CObject subclass: #CTextParagraphEditor
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
	<field instanceVariable="true" toSet="costume:">costume</field>
	<field instanceVariable="true" toSet="paragraph:">paragraph</field>
	<field instanceVariable="true">markBlock</field>
	<field instanceVariable="true">pointBlock</field>
	<field instanceVariable="true">undoStack</field>
	<field instanceVariable="true">redoStack</field>
	<field instanceVariable="true">lastUndoType</field>
	<field instanceVariable="true">findText</field>
	<field instanceVariable="true" toSet="modified:">modified</field>
	<field instanceVariable="true">emphasisHere</field>
	<field virtual="true" serializable="false" toGet="textColor" toSet="textColor:">textColor</field>
	<field virtual="true" serializable="false" toGet="align" toSet="align:">align</field>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tweak-Costume-Text'!
CPlayer subclass: #CTextTool
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
	<field toGet="fontNames" toSet="fontNames:" changeEvent="fontNamesChanged">fontNames</field>
	<field toGet="fontSizes" toSet="fontSizes:" changeEvent="fontSizesChanged">fontSizes</field>
	<field toGet="colorButton" toSet="colorButton:" changeEvent="colorButtonChanged">colorButton</field>
	<field toGet="boldButton" toSet="boldButton:" changeEvent="boldButtonChanged">boldButton</field>
	<field toGet="italicButton" toSet="italicButton:" changeEvent="italicButtonChanged">italicButton</field>
	<field toGet="underlineButton" toSet="underlineButton:" changeEvent="underlineButtonChanged">underlineButton</field>
	<field toGet="struckoutButton" toSet="struckoutButton:" changeEvent="struckoutButtonChanged">struckoutButton</field>
	<field toGet="alignList" toSet="alignList:" changeEvent="alignListChanged">alignList</field>
	<field toGet="editor" toSet="editor:" changeEvent="editorChanged">editor</field>
</fields>'
	classVariableNames: 'BlockAlignIcon CenterAlignIcon LeftAlignIcon RightAlignIcon'
	poolDictionaries: ''
	category: 'Tweak-Tools-TextTool'!

!CButtonList methodsFor: 'events' stamp: 'tak 5/10/2005 11:13'!
onCursorChanged
	<on: cursorChanged in: elements>
	elements cursor = 0 ifTrue:[^self].
	selection ifNotNil:[selection deselect].
	selection := elements selection.
	selection ifNotNil:[selection select].
	value := selection value.
! !

!CButtonList methodsFor: 'events' stamp: 'tak 5/10/2005 11:30'!
onValueChanged
	<on: #valueChanged>
	elements
		selection: (elements
				findFirstElement: [:item | item value == value])! !

!CButtonList methodsFor: 'accessing' stamp: 'tak 5/10/2005 11:13'!
selection
	"Answer the selection of the receiver"
	<bewareOf: #selectionChanged>
	^self propertyValueAt: #selection! !

!CButtonList methodsFor: 'accessing' stamp: 'tak 5/10/2005 11:13'!
selection: aValue
	"Modify the receiver's selection"
	^self propertyValueAt: #selection put: aValue with: #selectionChanged! !

!CButtonList methodsFor: 'initialize' stamp: 'tak 5/10/2005 11:22'!
setupCostume
	super setupCostume.
	self layout: CTableLayout new.
! !


!CTextParagraphEditor methodsFor: 'accessing' stamp: 'tak 5/9/2005 18:46'!
align
	self emphasisHere
		do: [:attr | 
			attr = TextAlignment centered
				ifTrue: [^ #centered].
			attr = TextAlignment justified
				ifTrue: [^ #justified].
			attr = TextAlignment leftFlush
				ifTrue: [^ #leftFlush].
			attr = TextAlignment rightFlush
				ifTrue: [^ #rightFlush]].
	^ #leftFlush! !

!CTextParagraphEditor methodsFor: 'accessing' stamp: 'tak 5/10/2005 00:05'!
align: aSymbol
	"Change the alignment of the selected region to be #leftFlush, #centered, #rightFlush, or, #justified."
	| attr string left right start stop|
	(#(centered justified leftFlush rightFlush) includes: aSymbol)
		ifFalse: [^ aSymbol].
	attr := TextAlignment perform: aSymbol.
	start := markBlock stringIndex.
	stop := pointBlock stringIndex.
	string := paragraph text string.
	left := string lastIndexOf: Character cr startingAt: (start min: stop)-1 ifAbsent:[1].
	right := string indexOf: Character cr startingAt: (start max: stop) ifAbsent:[string size].
	self selectFrom: left to: right.
	self addAttribute: attr.
	self selectFrom: start to: stop.
	^ aSymbol! !

!CTextParagraphEditor methodsFor: 'accessing' stamp: 'tak 5/9/2005 18:25'!
textColor
	^ (self emphasisHere
		detect: [:attr | attr class == TextColor]
		ifNone: [^ Color black]) color! !

!CTextParagraphEditor methodsFor: 'accessing' stamp: 'tak 5/9/2005 18:53'!
textColor: aColor 
	| aText |
	aText _ self selection.
	aText
		removeAttributesSuchThat: [:a | a class == TextColor].
	aText
		addAttribute: (TextColor color: aColor).
	self replaceSelectionWith: aText.
	self selectFrom: self selectionStop - aText size to: self selectionStop.
	^ aColor
! !


!CTextTool methodsFor: 'accessing' stamp: 'tak 5/9/2005 23:56'!
alignList
	"Answer the alignList of the receiver"
	<bewareOf: #alignListChanged>
	^self propertyValueAt: #alignList! !

!CTextTool methodsFor: 'accessing' stamp: 'tak 5/9/2005 23:56'!
alignList: aValue
	"Modify the receiver's alignList"
	^self propertyValueAt: #alignList put: aValue with: #alignListChanged! !

!CTextTool methodsFor: 'accessing' stamp: 'tak 5/9/2005 18:18'!
colorButton
	"Answer the colorButton of the receiver"
	<bewareOf: #colorButtonChanged>
	^self propertyValueAt: #colorButton! !

!CTextTool methodsFor: 'accessing' stamp: 'tak 5/9/2005 18:18'!
colorButton: aValue
	"Modify the receiver's colorButton"
	^self propertyValueAt: #colorButton put: aValue with: #colorButtonChanged! !

!CTextTool methodsFor: 'events' stamp: 'tak 5/10/2005 11:47'!
onClosed
	<on: closed>
	self pauseScript: #onKeyboardFocusChanged
! !

!CTextTool methodsFor: 'events' stamp: 'tak 5/8/2005 20:49'!
onKeyboardFocusChanged
	| newFocus |
	<on: keyboardFocusChanged in: hand>
	newFocus := hand keyboardFocus.
	newFocus ifNil:[^self].
	newFocus := newFocus asPlayer.
	newFocus textHolder ifNil:[^self].
	editor := newFocus textHolder getEditor.
	self onTextSelectionChanged! !

!CTextTool methodsFor: 'events' stamp: 'tak 5/10/2005 11:47'!
onOpened
	<on: opened>
	self resumeScript: #onKeyboardFocusChanged.
	self onKeyboardFocusChanged
! !

!CTextTool methodsFor: 'events' stamp: 'tak 5/9/2005 23:59'!
onTextSelectionChanged
	| code |
	"Refresh widget from the font of current editor."
	<on: textSelectionChanged in: editor>
	self selectFont.
	code := editor emphasis.
	boldButton selected: (code anyMask: 1).
	italicButton selected: (code anyMask: 2).
	underlineButton selected: (code anyMask: 4).
	struckoutButton selected: (code anyMask: 16).
	colorButton player: (editor fieldNamed: #textColor).
	alignList player: (editor fieldNamed: #align).
! !

!CTextTool methodsFor: 'intialize' stamp: 'tak 5/10/2005 11:35'!
buildAlignButtons
	| symbols labels buttons button |
	symbols _ #(#leftFlush #centered #justified #rightFlush ).
	labels _ #('[' '-' '=' ']' ).
	buttons _ OrderedCollection new.
	symbols
		keysAndValuesDo: [:index :symbol | 
			button _ CRadioButton new.
			button costume: CToolBarButtonCostume new.
			button value: symbol.
			button
				label: (labels at: index).
			button font: (TextStyle named: #WindowFont) defaultFont.
			button extent: 20 @ 20.
			buttons add: button].
	^ buttons! !

!CTextTool methodsFor: 'intialize' stamp: 'tak 5/10/2005 11:42'!
buildAlignList
	alignList layout: CTableLayout new.
	alignList layout listDirection: #leftToRight.
	alignList hResizing: #shrinkWrap;
		 vResizing: #shrinkWrap.
	alignList layout cellInset: 2.
	alignList addAll: self buildAlignButtons.
	self add: alignList! !

!CTextTool methodsFor: 'intialize' stamp: 'tak 5/10/2005 11:42'!
initialize
	super initialize.
	self define: #fontNames as: CDropDownList new.
	self define: #fontSizes as: CDropDownList new.
	self define: #colorButton as: CPlayer new.
	self define: #boldButton as: CToolBarButton new.
	self define: #italicButton as: CToolBarButton new.
	self define: #underlineButton as: CToolBarButton new.
	self define: #struckoutButton as: CToolBarButton new.
	self define: #alignList as: CButtonList new.
! !

!CTextTool methodsFor: 'intialize' stamp: 'tak 5/10/2005 00:13'!
setupCostume
	super setupCostume.
	self extent: 209@76.
	self fillStyle: #solid.
	self fillColors: (Array with: (Color r: 1.0 g: 1.0 b: 1.0) with: (Color r: 1.0 g: 0.677 b: 0.032)).
	self borderWidth: 1.
	self roundCorners: true.
	self dropShadowEnabled: true.
	self borderColor: (Color r: 0.987 g: 0.725 b: 0.188).
	self borderStyle: #simple.
	self fillStyle: #solid.

	layout := CTableLayout new.
	layout listDirection: #leftToRight.
	layout wrapDirection: #topToBottom.
	layout hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	layout layoutInset: 4.
	layout cellInset: 2.

	fontNames addAll: StrikeFont actualFamilyNames.
	fontNames width: 108.
	fontNames costume hResizing: #rigid.
	self add: fontNames.

	fontSizes addAll: #(9 10 12 14 18 24 36 48).
	fontSizes width: 64.
	fontSizes costume hResizing: #rigid.
	self add: fontSizes.

	colorButton wearCostume: CColorTileCostume.
	colorButton extent: 20@20.
	colorButton hResizing: #rigid; vResizing: #rigid.
	self add: colorButton.

	boldButton label: ('B' asText allBold addAttribute: TextEmphasis bold).
	boldButton extent: 20@20.
	self add: boldButton.

	italicButton label: (' I ' asText allBold addAttribute: TextEmphasis italic).
	italicButton extent: 20@20.
	self add: italicButton.

	underlineButton label: ('U' asText allBold addAttribute: TextEmphasis underlined).
	underlineButton extent: 20@20.
	self add: underlineButton.

	struckoutButton label: ('S' asText allBold addAttribute: TextEmphasis struckOut).
	struckoutButton extent: 20@20.
	self add: struckoutButton.

	self buildAlignList.
! !


!CTextToolTest methodsFor: 'testing' stamp: 'tak 5/10/2005 11:46'!
testOpen
	"self debug: #testOpen"
	| tool |
	self waitTick.
	self assert: (world hand handlesEvent: #keyboardFocusChanged) not.

	tool _ CTextTool new.
	tool open.
	self waitTick.
	self assert: (world hand handlesEvent: #keyboardFocusChanged).
	tool close.
	self waitTick.
	self assert: (world hand handlesEvent: #keyboardFocusChanged) not.

	
	

! !


!WindowFont class methodsFor: 'class initialization' stamp: 'tak 5/9/2005 23:51'!
initFont
	"WindowFont initFont"
	| form map font style files |
	files := Dictionary new.
	self glyphs do:[:spec|
		files at: spec first put: spec last base64Decoded asByteArray.
	].
	map := Dictionary new.
	#(
		( 'X'	'cross.gif')
		( 'x'	'miniCross.gif')
		( 'v'	'downArrow.gif')
		( '^'	'upArrow.gif')
		( '<'	'leftArrow.gif')
		( '>'	'rightArrow.gif')
		( '_'	'underScore.gif')
		( '+'	'plus.gif')
		( '-'	'minus.gif')
		( 'O'	'circle.gif')
		( 'o'	'bullet.gif')
		( 'V'	'checkMark.gif')
		( 'E'   'expand.gif')
		( 'C'   'collapse.gif')
		( 's'   'subMenu.gif')
		( 'T'	'target.gif')
		"--"
		('l'	'miniLeftArrow.gif')
		('r'	'miniRightArrow.gif')
		('u'	'miniUpArrow.gif')
		('d'	'miniDownArrow.gif')
		"--"
		('L' 'arrowLeft.gif')
		('R' 'arrowRight.gif')
		('U' 'arrowUp.gif')
		('D' 'arrowDown.gif')
		"--"
		('f' 'miniPlayFwd.gif')
		('b' 'miniPlayBack.gif')
		('p' 'miniPlayPause.gif')
		"--"
		('[' 'leftFlush.gif')
		(']' 'rightFlush.gif')
		('=' 'justified.gif')
		('-' 'centered.gif')
	) do:[:spec|
		form := (Form fromBinaryStream: (ReadStream on: (files at: spec last))).
		map at: spec first first put: form.
	].

	form := Form extent: 11@11 depth: 1.
	form getCanvas frameOval: (1@1 extent: 9@9) width: 1 color: Color black.
	map at: $q put: form.

	form := Form extent: 11@11 depth: 1.
	form getCanvas frameOval: (1@1 extent: 9@9) width: 1 color: Color black.
	form getCanvas fillOval: (3@3 extent: 5@5) color: Color black.
	map at: $Q put: form.

	font := StrikeFont new initializeWithMap: map.
	font name: #WindowFont.
	style := TextStyle fontArray: {font}.
	TextConstants at: #WindowFont put: style.! !

!WindowFont class methodsFor: 'glyphs' stamp: 'tak 5/9/2005 23:47'!
glyphs
	^#(
		('cross.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACGAyCaQanfWCSSNIJnWL65W01mBZ23LIt
BQA7')
		('miniCross.gif'
 'R0lGODlhCwALALMAAAAAAP//////////////////////////////////////////////////
/////////yH5BAEAAA8ALAAAAAALAAsAAAQW8MlJq50AYL115l12feMHSiS5rVfbRgA7')
		('miniCross2.gif'  'R0lGODlhCwALALMAAAAAAP///////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAACH5BAEAAAIALAAAAAALAAsAAAQTUMhJq70YTG01v18nhFuJnSgWAQA7')
		('downArrow.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACFIyPqQbbABN8kdUw8bVZdbeE4lEAADs=')
		('upArrow.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEoyPqQprABecidIXcbvHSgcqBQA7')
		('leftArrow.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACFIwfgAu91tSLL7l5K61W6ox501EAADs=')
		('rightArrow.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACFIxhqcDqjFyCcrYaqNTv9vhhWVUAADs=')
		('underScore.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACDYyPqcvtDx+YlJqKYQEAOw==')
		('plus.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEIyPqQp77QJMoNqJMIuSe1UAOw==')
		('minus.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACDIyPqcvtBqIEr9q7CgA7')
		('circle.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACF4yPCLvJf1hsgU5jMdBuVytpjzeFyRkU
ADs=')
		('bullet.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACGIyPCLsJfl5gRj7W7MSzbqp93hg5XIIa
BQA7')
		('checkMark.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACFIyPqWvAAdyRMCIbact6WtY9IlIAADs=')
		('expand.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACGYSDaJvN0AKEalGXbt7x6sooUicdURlm
RgEAOw==')
		('collapse.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACGkQceQvo1lyKatZLa4RZ9btojXWMY2iG
3lEAADs=')
		('subMenu.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEoyPCanLBuILUbJqEX515juFBQA7')
		('target.gif' 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACF4wDeWvAm9yT6DjaUGTx8pqFnPKIE2kU
ADs=')
		('miniUpArrow.gif'
'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEIyPqQprABecadp6mtu8uwIAOw==')
		('miniDownArrow.gif'
'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEIyPqcttcCACtMpoV23X+VMAOw==')
		('miniLeftArrow.gif'
 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACD4yPqQprABdsbDp743W8FwA7')
		('miniRightArrow.gif'
 'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEYyPqQprAF2AbdGaqI0Oy58UADs=')
		('miniPlayFwd.gif' 
'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACEoyPCanLBuILUbJqEX515juFBQA7') 
		('miniPlayBack.gif' 
'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACE4yPaaAH3B5McroaZQt6v72ASgEAOw==') 
		('miniPlayPause.gif' 
'R0lGODlhCwALAIAAAAAAAP///ywAAAAACwALAAACFIyPqQfA/qIMDVVzMaSbT68t4lgAADs=')
		('arrowLeft.gif'
 'R0lGODlhCwALALMAAAAAAP//////////////////////////////////////////////////
//////i/JCH5BAEAAA8ALAAAAAALAAsAAAQZMMgJppWgXhz01VlGbeDWjZ8FhqlHuqQVAQA7')
		('arrowRight.gif'
 'R0lGODlhCwALALMAAAAAAP//////////////////////////////////////////////////
/////////yH5BAEAAA8ALAAAAAALAAsAAAQa8MkHpp2gXkxvzpIWbqJoaeYYfqrXbVR6bhEA
Ow==')
		('arrowUp.gif'
 'R0lGODlhCwALALMAAAAAAP//////////////////////////////////////////////////
/////////yH5BAEAAA8ALAAAAAALAAsAAAQZ8MlJ6wN2Ymz5rZ7khdoFnNo5liBLqWhmRQA7')
		('arrowDown.gif'
 'R0lGODlhCwALALMAAAAAAP//////////////////////////////////////////////////
/////////yH5BAEAAA8ALAAAAAALAAsAAAQZ8MlJKbi3PjB59VuHiRlodV8qmSh7arAUAQA7')

		('centered.gif' 'R0lGODlhCwALAIAAAAAAAP///yH5BAUUAAEALAAAAAALAAsAAAIVTIAJxt16TnLUqFkdXDC/
u3jMJiEFADs=')
		('leftFlush.gif' 'R0lGODlhCwALAIAAAAAAAP///yH5BAUUAAEALAAAAAALAAsAAAIURIBpwe1slHw0ykWfvTif
c3kayBUAOw==')
		('justified.gif' 'R0lGODlhCwALAIAAAAAAAP///yH5BAUUAAEALAAAAAALAAsAAAIXhB2Hwe2oQJKuznOXbVDN
/XgRyEmjUQAAOw==')
		('rightFlush.gif' 'R0lGODlhCwALAIAAAAAAAP///yH5BAUUAAEALAAAAAALAAsAAAIVTIAJZ+2mInv0xLVqu2nq
fXkahxwFADs=')

	)
! !


!CTextTool class reorganize!
('as yet unclassified' initialize registerOpenCommand)
('constants')
!

CTextTool removeSelector: #blockAlign!
CTextTool removeSelector: #blockAlign:!
CTextTool removeSelector: #centerAlign!
CTextTool removeSelector: #centerAlign:!
CTextTool removeSelector: #leftAlign!
CTextTool removeSelector: #leftAlign:!
CTextTool removeSelector: #rightAlign!
CTextTool removeSelector: #rightAlign:!

!CTextTool reorganize!
('accessing' alignList alignList: boldButton boldButton: colorButton colorButton: editor editor: fontNames fontNames: fontSizes fontSizes: italicButton italicButton: struckoutButton struckoutButton: underlineButton underlineButton:)
('color and fill' windowColor:)
('emphasis' changeEmphasis: onBoldChanged onItalicChanged onStruckoutChanged onUnderlinedChanged onUpdateEmphasis)
('events' onClosed onEditorChanged onFontNameChanged onFontSizeChanged onKeyboardFocusChanged onOpened onTextSelectionChanged)
('font' currentFont onUpdateFont selectedFont selectFont)
('intialize' buildAlignButtons buildAlignList defaultCostume initialize setupCostume)
!

"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."

WindowFont initFont.
!