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