Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Eye Candy SN
Last updated at 12:59 pm UTC on 16 January 2006
SimpleButtonMorph subclass: #GradientButtonMorph
	instanceVariableNames: 'topColor bottomColor reverseFillStyle saveFill '
	classVariableNames: 'DelayTime '
	poolDictionaries: ''
	category: 'Morphic Documentation example'

Morph subclass: #WorkspacePane
	instanceVariableNames: 'contents bindings '
	classVariableNames: 'BackgroundForm '
	poolDictionaries: ''
	category: 'Morphic Documentation example'



Gradient Morph instance methods:

cacheFillStyle
	| fill |
	"Make receiver use a solid fill style (e.g., a simple color)"
	fill _ GradientFillStyle ramp: {0.0 -> topColor. 1.0 -> bottomColor}.
	fill	origin: self topLeft ;
		direction: 0 @ self bounds extent y ;
		normal: self bounds extent x @ 0 ;
		radial: false.
	self fillStyle: fill.

	" reverse ramps the colors in the opposite direction "
	reverseFillStyle _ fill copy.
	reverseFillStyle colorRamp: {0.0 -> bottomColor. 1.0 -> topColor}.

gradientColor: theColor

	topColor _ theColor.
	bottomColor _  (theColor mixed: 0.5 with: Color black).
	self cacheFillStyle.
	self changed.

gradientColor: color1 bottomColor: color2
	topColor _ color1.
	bottomColor _ color2.
	self cacheFillStyle.
	self changed.

labelColor: theColor
	| sm |
	(sm _ self findA: StringMorph)
		ifNotNil: [sm color: theColor.].

mouseDown: evt
	self cacheFillStyle.
	saveFill _ self fillStyle.
	self fillStyle: reverseFillStyle.
	self changed.
	self refreshWorld.

mouseMove: evt
	actWhen == #buttonDown ifTrue: [^ self].
	(self containsPoint: evt cursorPoint)
		ifTrue: 
			[self fillStyle = reverseFillStyle
				ifFalse: 
					[self fillStyle: reverseFillStyle.
					self changed.
					self world displayWorld].
			(actWhen == #whilePressed and: [evt anyButtonPressed])
				ifTrue: 
					[self doButtonAction.
					evt hand noteSignificantEvent: evt]]
		ifFalse: [self fillStyle = saveFill
				ifFalse: 
					[self fillStyle: saveFill.
					self changed.
					self world displayWorld]].

mouseUp: evt
	" flash the button three times when the button is released"
	| delay time elapsed |
	(self containsPoint: evt cursorPoint)
		ifTrue: [1 to: 3 do: 
				[:i | 
				time _ Time millisecondClockValue.
				self fillStyle: saveFill.
				self changed.
				self refreshWorld.
				elapsed _ Time millisecondClockValue - time.
				elapsed > 0
					ifTrue: 
						[delay _ Delay forMilliseconds: (elapsed min: DelayTime).
						delay wait].
				self fillStyle: reverseFillStyle.
				self changed.
				self refreshWorld.
				elapsed > 0 ifTrue: [delay wait]]].
	self fillStyle: saveFill.
	self changed.
	self refreshWorld.
	(actWhen == #buttonUp and: [self containsPoint: evt cursorPoint])
		ifTrue: [self doButtonAction].

layoutChanged
	| sm |

	super layoutChanged.
	( sm _ self findA: StringMorph )
		ifNotNil: [ 	sm position: self center - (sm extent // 2). ].
	self cacheFillStyle.

position: thePoint
	bounds topLeft = thePoint ifFalse: [ 
	super position: thePoint.
	self cacheFillStyle. ].

initialize

	super initialize.
	self useSquareCorners.
	bounds _ 0 @ 0 extent: 96 @ ( self class buttonHeight) .
	self setDefaultLabel.
	self borderColor: #raised.
	self borderWidth: 1.
	self useGradientFill.
	topColor _ Color lightGray.
	bottomColor _ Color black.
	self cacheFillStyle.

label: aString

	| oldLabel m |
	(oldLabel _ self findA: StringMorph)
		ifNotNil: [oldLabel delete].
	m _ StringMorph contents: aString font: TextStyle defaultFont.
	m position: self center - (m extent // 2).
	self addMorph: m.
	m lock.

setDefaultLabel
	self label: 'Untitled'.

GradientButtonMorph class methods:

initialize
	DelayTime _ 60.

buttonHeight
	^ 22.


PluggableTextMorph methods

editColor: theColor
	textMorph color: theColor.


textMorph
	^ textMorph.


WorkspacePane instance methods

contents
	"Answer the contents that the receiver is holding–presumably a string."

	^contents.

contents: textOrString
	"Set textOrString to be the contents of the receiver."

	contents _ textOrString "asString".

setBackground: theForm
	" Assign the background to the PluggableTextMorph"
	| fill tm |
	(tm _ self findA: PluggableTextMorph)
		ifNotNil: 
			[theForm
				ifNil: 
					[tm removeProperty: #fillStyle.
					tm color: Color transparent.
					^ self].
			fill _ BitmapFillStyle fromForm: theForm.
			fill origin: 1@1.
			tm fillStyle: fill].

setDefaultBackground
	BackgroundForm ifNotNil: [
self setBackground: BackgroundForm ].

bindingOf: aString
	bindings isNil
		ifTrue: [bindings _ Dictionary new].
	(bindings includesKey: aString)
		ifFalse: [bindings at: aString put: nil].
	^bindings associationAt: aString.

setBindings: aDictionary
	"Sets the Workspace to use the specified dictionary as its namespace"

	bindings _ aDictionary.

color: theColor
	| am |
	super color: theColor.
	(am _ self findA: AlignmentMorph)
		ifNotNil: [am color: (theColor darker)].


editTextColor
	" set the text in the edit pane to be theColor"
	| tm |
	(tm _ self findA: PluggableTextMorph)
		ifNil: [ ^ Color black ]
	    ifNotNil: [tm textMorph color].

setEditTextColor
	ColorPickerMorph new
		sourceHand: self activeHand ;
		target: self ;
		selector: #setEditTextColor: ;
		originalColor: self editTextColor ;
		addToWorld: self world
			near: self fullBounds.

setEditTextColor: theColor
	self textColor: theColor.

textColor: theColor
	" set the text in the edit pane to be theColor"
	| tm |
	(tm _ self findA: PluggableTextMorph) ifNotNil: [tm editColor: theColor]

extent: thePoint
	| ib am tm buttonHeight tExtent |
	super extent: thePoint.
	ib _ self innerBounds.
	buttonHeight _ GradientButtonMorph buttonHeight.
	(am _ self findA: AlignmentMorph) ifNotNil: [am bounds: (ib topLeft extent: ib width @ buttonHeight)].
	(tm _ self findA: PluggableTextMorph)
		ifNotNil: 
			[tExtent _ ib extent - (0 @ buttonHeight).
			tm bounds extent = tExtent ifFalse: [tm extent: tExtent]].

addButtons
	| am button |
	am _ AlignmentMorph new.
	am borderWidth: 1.
	am color: #raised.
	am inset: 0.
	button _ GradientButtonMorph new label: 'Browser';
			 target: World activeHand;
			 actionSelector: #openBrowser;
			 actWhen: #buttonUp;
			 gradientColor: (Preferences windowColorFor: #Browser);
			 setBalloonText: 'Open up a System Browser window'.
	am addMorph: button.
	button _ GradientButtonMorph new label: 'Workspace';
			 target: World activeHand;
			 actionSelector: #openWorkspace;
			 actWhen: #buttonUp;
			 gradientColor: (Preferences windowColorFor: #StringHolder);
			 setBalloonText: 'Open a Workspace window'.
	am addMorphBack: button.
	button _ GradientButtonMorph new label: 'Transcript';
			 target: World activeHand;
			 actionSelector: #openTranscript;
			 actWhen: #buttonUp;
			 gradientColor: (Preferences windowColorFor: #TranscriptStream);
			 setBalloonText: 'Open a Transcript window'.
	am addMorphBack: button.
	button _ GradientButtonMorph new label: 'Change Sorter';
			 target: World activeHand;
			 actionSelector: #openChangeSorter:;
			 arguments: #(1 );
			 actWhen: #buttonUp;
			 gradientColor: (Preferences windowColorFor: #ChangeSorter);
			 setBalloonText: 'Open a Simple Change Sorter window'.
	am addMorphBack: button.
	button _ GradientButtonMorph new label: 'File List';
			 target: World activeHand;
			 actionSelector: #openFileList;
			 actWhen: #buttonUp;
			 gradientColor: (Preferences windowColorFor: #FileList);
			 setBalloonText: 'Open a File List window'.
	am addMorphBack: button.
	self addMorph: am.
	am color: color.

initialExtent
	^ 482 @ 400.

initialize
	| tm |
	super initialize.
	self color: (Preferences windowColorFor: #StringHolder).
	"Initialize the state of the receiver with its default contents."
	contents _ self defaultContents.
	self addButtons. 

	tm _ PluggableTextMorph
				on: self
				text: #contents
				accept: #acceptContents:
				readSelection: nil
				menu: #codePaneMenu:shifted:.
	tm position: 0 @ GradientButtonMorph buttonHeight. 
	self addMorph: tm. 
	self extent: self initialExtent.

addModelItemsToWindowMenu: aMenu
	aMenu addLine.
	aMenu add: 'save contents to file...' target: self action: #saveContentsInFile. 
	aMenu add: 'use default background' target: self action: #setDefaultBackground.
	aMenu add: 'set edit text color' target: self action: #setEditTextColor.

codePaneMenu: aMenu shifted: shifted
	"Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items in a text pane"
	| donorMenu |
	donorMenu _ shifted
		ifTrue:
			[ParagraphEditor shiftedYellowButtonMenu]
		ifFalse:
			[ParagraphEditor yellowButtonMenu].
	^ aMenu labels: donorMenu labelString lines: donorMenu lineArray selections: donorMenu selections.

saveContentsInFile
	| fileName stringToSave labelToUse |
	stringToSave _ (self dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [^ self beep]) text string.
	stringToSave size == 0 ifTrue: [^ self inform: 'nothing to save.'].
	labelToUse _  (self dependents detect: [:dep | dep isKindOf: TwoWayScrollPane] ifNone: [^ self beep]) label.

	fileName _ FillInTheBlank request: 'File name? (".text" will be added to end)' 
			initialAnswer: labelToUse.
	fileName size == 0 ifTrue: [^ self beep].
	(fileName asLowercase endsWith: '.text') ifFalse: [fileName _ fileName,'.text'].

	(FileStream newFileNamed: fileName)
		nextPutAll: stringToSave; close.

privateMoveBy: delta
	"Private!! Use 'position:' instead."
	| trailMorph start fill tm |
	(extension == nil or: [extension player == nil]) ifFalse:
		["Most cases eliminated fast by above test"
		self getPenDown ifTrue:
			["If this is a costume for a player with its pen down, draw a line."
			(trailMorph _ self trailMorph) ifNotNil:
				[start _ self referencePosition.
				trailMorph drawPenTrailFor: self from: start to: start + delta]]].
	fullBounds == bounds
		ifTrue: ["optimization: avoids recomputing fullBounds"
				fullBounds _ bounds _ bounds translateBy: delta]
		ifFalse: [bounds _ bounds translateBy: delta.
				fullBounds _ nil].
	(tm _ self findA: PluggableTextMorph)
		ifNil: [ ^ self ].
	fill _ tm fillStyle.
	fill isOrientedFill ifTrue:[fill origin: 1@1].

acceptContents: aString
	"Set aString to be the contents of the receiver.  Return true cuz happy"

	self contents: aString.
	^ true.

defaultContents

	^''.

selectedMessageName

	^ nil.


WorkspacePane class methods

defaultBackground
	^ BackgroundForm

defaultBackground: theForm
	BackgroundForm _ theForm.

openInWindow
	"WorkspacePane openInWindow"
     "Answer an Morphic view "
	| window wp |
	wp _ WorkspacePane new.
	window _ (TwoWayScrollPane labelled: 'Fancy Workspace') model: wp.
	window addMorph: wp frame: (0@0 corner: 1@1).
	wp color: (Preferences windowColorFor: #StringHolder).
	window updatePaneColors.
	window minimumExtent: 484 @ 200.
	^ window openInWorldExtent: 484@400

openInWindow: backgroundForm textColor: theColor
	"WorkspacePane openInWindow: WorkspacePane defaultBackground textColor: Color white"
     "Answer an Morphic view "
	| window wp |
	wp _ WorkspacePane new.
	window _ (TwoWayScrollPane labelled: 'Fancy Workspace') model: wp.
	wp setBackground: backgroundForm.
	wp textColor: theColor.
	window addMorph: wp frame: (0@0 corner: 1@1).
	wp color: (Preferences windowColorFor: #StringHolder).
	window updatePaneColors.
	window minimumExtent: 484 @ 200.
	^ window openInWorldExtent: 484@400.

TwoWayScrollPane instance methods:
minimumExtent
	| ext |
	"This returns the minimum extent that the window may be resized to"
	(ext _ self valueOfProperty: #minimumExtent)
		ifNotNil:
			[^ ext].
	^ 100 @ 80.


minimumExtent: aPoint
	"This sets the minimum extent to which the window may be resized to"
	self setProperty: #minimumExtent toValue: aPoint.


GradientButtonMorph initialize.



Jim Benson
jb@speed.net