[fixed ENH] 3D Look for Morphic Windows
Bert Freudenberg
bert at isgnw.CS.Uni-Magdeburg.De
Mon Jun 7 09:17:11 UTC 1999
On Mon, 7 Jun 1999, Peter Smet wrote:
> Bert, this is excellent!
> I noticed that in 2.4b that your change set filed in with
> no problems when I was in a morphic world, but
> got the following walkback in the default MVC window:
>
> UndefinedObject(Object)>>doesNotUnderstand:
> SystemWindow class>>windowsIn:satisfying:
> Preferences class>>noteThatFlag:justChangedTo:
> Preferences class>>setPreference:toValue:
> Preferences class>>disable:
> UndefinedObject>>DoIt
> Compiler>>evaluate:in:to:notifying:ifFail:
> Compiler class>>evaluate:for:notifying:logged:
> Compiler class>>evaluate:for:logged:
> Compiler class>>evaluate:logged:
Oops! Sorry. I didn't check preferences toggling in MVC. In Preferences
class>>noteThatFlag:justChangedTo: World must be replaced with
"self currentWorld". I'll just repost the changeset.
Thanks for beta testing :-)
/bert
--
Bert Freudenberg Department of
Simulation and
Computer Graphics
http://isgwww.cs.uni-magdeburg.de/isg/bert.html Univ. of Magdeburg
Content-Type: TEXT/PLAIN; charset=US-ASCII; name="3dlook-bf.7June1011am.cs"
Content-ID: <Pine.LNX.3.96.990607111711.14432B at balloon.cs.uni-magdeburg.de>
Content-Description:
'From Squeak 2.3 of January 14, 1999 on 7 June 1999 at 10:11:55 am'!
"Change Set: 3dlook-bf
Date: 21 May 1999
Author: Bert Freudenberg
Adds a 3D look to Morphic windows. Enable uniformWindowColors in preferences to try."!
!Object methodsFor: 'user interface' stamp: 'bf 6/7/1999 07:30'!
effectiveBackgroundColor
"Take Preference #uniformWindowColors into account when answering my default background color"
^Color colorFrom: (Preferences uniformWindowColors
ifTrue: [Preferences uniformWindowBackground]
ifFalse: [self defaultBackgroundColor])! !
!BorderedMorph methodsFor: 'drawing' stamp: 'bf 5/21/1999 14:17'!
drawOn: aCanvas
"Draw a rectangle with a solid, inset, or raised border.
Note: the raised border color is generated from the receiver's own color,
while the inset border color is generated from the color of its owner.
This behavior is visually more consistent. Thanks to Hans-Martin Mosner."
| insetColor |
borderWidth = 0 ifTrue: [ "no border"
aCanvas fillRectangle: bounds color: color.
^ self].
borderColor == #raised ifTrue: [
^ aCanvas frameAndFillRectangle: bounds
fillColor: color
borderWidth: borderWidth
topLeftColor: (color muchLighterIf: borderWidth = 1)
bottomRightColor: (color muchDarkerIf: borderWidth = 1)].
borderColor == #inset ifTrue: [
insetColor _ owner colorForInsets.
^ aCanvas frameAndFillRectangle: bounds
fillColor: color
borderWidth: borderWidth
topLeftColor: (insetColor muchDarkerIf: borderWidth = 1)
bottomRightColor: (insetColor muchLighterIf: borderWidth = 1)].
"solid color border"
aCanvas frameAndFillRectangle: bounds
fillColor: color
borderWidth: borderWidth
borderColor: borderColor.! !
!Browser methodsFor: 'initialize-release' stamp: 'bf 5/21/1999 14:23'!
buildMorphicSwitches
| instanceSwitch commentSwitch classSwitch row aColor |
instanceSwitch _ PluggableButtonMorph
on: self
getState: #instanceMessagesIndicated
action: #indicateInstanceMessages.
instanceSwitch
label: 'instance';
askBeforeChanging: true.
commentSwitch _ PluggableButtonMorph
on: self
getState: #classCommentIndicated
action: #plusButtonHit.
commentSwitch
label: '?' asText allBold;
askBeforeChanging: true;
setBalloonText: 'class comment'.
classSwitch _ PluggableButtonMorph
on: self
getState: #classMessagesIndicated
action: #indicateClassMessages.
classSwitch
label: 'class';
askBeforeChanging: true.
row _ AlignmentMorph newRow
hResizing: #spaceFill;
vResizing: #spaceFill;
inset: 0;
borderColor: Color transparent;
addMorphBack: instanceSwitch;
addMorphBack: commentSwitch;
addMorphBack: classSwitch.
aColor _ self effectiveBackgroundColor.
row submorphs do:
[:m | m color: aColor;
onColor: aColor darker offColor: aColor;
borderColor: Preferences borderColorForPanes].
^ row
! !
!Color methodsFor: 'transformations' stamp: 'bf 5/21/1999 14:05'!
muchDarker
^ self * 0.233
! !
!Color methodsFor: 'transformations' stamp: 'bf 5/21/1999 14:16'!
muchDarkerIf: aBoolean
^ aBoolean
ifTrue: [self muchDarker]
ifFalse: [self darker]
! !
!Color methodsFor: 'transformations' stamp: 'bf 5/21/1999 14:16'!
muchLighterIf: aBoolean
^ aBoolean
ifTrue: [self muchLighter]
ifFalse: [self lighter]
! !
!Preferences class methodsFor: 'parameters' stamp: 'bf 5/21/1999 14:22'!
borderColorForPanes
^ Preferences uniformWindowColors
ifTrue: [#raised]
ifFalse: [Color black]! !
!Preferences class methodsFor: 'parameters' stamp: 'bf 5/21/1999 16:14'!
uniformWindowBackground
^ Color veryVeryLightGray! !
!Preferences class methodsFor: 'preferences dictionary' stamp: 'bf 6/7/1999 10:07'!
noteThatFlag: prefSymbol justChangedTo: aBoolean
"Provides a hook so that a user's toggling of a preference might precipitate some immediate action"
| keep |
(prefSymbol == #useGlobalFlaps) ifTrue:
[aBoolean
ifFalse: "Turning off use of flaps"
[keep _ self confirm:
'Do you want to preserve the existing
global flaps for future use?'.
Utilities globalFlapTabsIfAny do:
[:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: keep.
aFlapTab isInWorld ifTrue: [self halt]].
keep ifFalse: [Utilities clobberFlapTabList]]
ifTrue: "Turning on use of flaps"
[Smalltalk isMorphic ifTrue:
[self currentWorld addGlobalFlaps]]].
(prefSymbol endsWith: 'WindowColors') ifTrue:
[(SystemWindow windowsIn: self currentWorld satisfying: [:w | true]) do:
[:w | w updatePaneColors]]! !
!ScriptEditorMorph methodsFor: 'textually-coded scripts' stamp: 'bf 5/21/1999 11:43'!
addTextualScript: aBrowser
"Put a message browser right into the header alignment morph"
| window aMorph codePane |
submorphs last class == PluggableTextMorph ifTrue: [^ self].
window _ self.
aMorph _ PluggableListMorph on: aBrowser list: #messageListSingleton
selected: #indexIsOne changeSelected: #indexIsOne:
menu: #messageListMenu:shifted:.
aMorph bounds: (window topLeft extent: 200 at 12). "will get moved"
window addMorphBack: aMorph.
aMorph borderWidth: 1;
color: aBrowser effectiveBackgroundColor.
codePane _ PluggableTextMorph on: aBrowser text: #contents accept: #contents:notifying:
readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
"editString ifNotNil: [codePane editString: editString.
codePane hasUnacceptedEdits: true]."
codePane bounds: (window topLeft extent: 200 at 120). "will get moved"
window addMorphBack: codePane.
codePane borderWidth: 1; retractableOrNot; "make it stay"
color: (Color perform: aBrowser defaultBackgroundColor).
" self addMorph: aMorph.
aMorph borderWidth: 1;
color: (Color perform: aBrowser defaultBackgroundColor);
bounds:
"! !
!ScrollPane methodsFor: 'initialization' stamp: 'bf 5/21/1999 14:49'!
initialize
super initialize.
borderWidth _ 2. borderColor _ Preferences borderColorForPanes.
retractableScrollBar _ scrollBarOnLeft _
(Preferences valueOfFlag: #inboardScrollbars) not.
scrollBar := ScrollBar new model: self slotName: 'scrollBar'.
scrollBar borderWidth: 2; borderColor: #inset.
retractableScrollBar ifFalse: [self addMorph: scrollBar].
scroller := TransformMorph new color: Color transparent.
scroller offset: -3 at 0.
self addMorph: scroller.
self on: #mouseEnter send: #mouseEnter: to: self.
self on: #mouseLeave send: #mouseLeave: to: self.
self extent: 150 at 120! !
!SystemWindow methodsFor: 'initialization' stamp: 'bf 5/21/1999 14:53'!
initialize
| aFont |
super initialize.
isCollapsed _ false.
activeOnlyOnTop _ true.
paneMorphs _ Array new.
paneRects _ Array new.
borderColor _ Color black.
borderWidth _ 1.
color _ Color black.
aFont _ Preferences fontForScriptorButtons.
stripes _ Array with: (RectangleMorph newBounds: bounds) "see extent:"
with: (RectangleMorph newBounds: bounds).
self addMorph: (stripes first borderWidth: 1).
self addMorph: (stripes second borderWidth: 2).
self addMorph: (label _ StringMorph new contents: labelString;
font: (TextStyle default fontAt: 2) emphasis: 1).
self addMorph: (closeBox _ SimpleButtonMorph new borderWidth: 0;
label: 'X' font: aFont; color: Color transparent;
actionSelector: #delete; target: self; extent: 16 at 16).
self addMorph: (collapseBox _ SimpleButtonMorph new borderWidth: 0;
label: 'O' font: aFont; color: Color transparent;
actionSelector: #collapseOrExpand; target: self; extent: 16 at 16).
Preferences noviceMode ifTrue:
[closeBox setBalloonText: 'close window'.
collapseBox setBalloonText: 'collapse/expand window'].
self on: #mouseEnter send: #spawnReframeHandle: to: self.
self on: #mouseLeave send: #spawnReframeHandle: to: self.
label on: #mouseDown send: #relabelEvent: to: self.
self extent: 300 at 200! !
!SystemWindow methodsFor: 'panes' stamp: 'bf 5/21/1999 11:44'!
paneColor
Display depth > 2 ifTrue: [^model effectiveBackgroundColor].
^ Color white! !
!SystemWindow methodsFor: 'panes' stamp: 'bf 5/27/1999 08:11'!
updatePaneColors
"Useful when changing from monochrome to color display"
| col borderCol m |
col _ self paneColor.
borderCol _ Preferences borderColorForPanes.
self setStripeColorsFrom: col.
paneMorphs do: [:p | p color: col; borderColor: borderCol].
"This is for the browsers switches - copied from Browser>>buildMorphicSwitches"
self flag: #XXX. "Is there a better way to do this?"
(model isKindOf: Browser) ifTrue: [
m _ self findA: AlignmentMorph.
m ifNotNil: [
m submorphs do:
[:b | b color: col;
onColor: col darker offColor: col;
borderColor: borderCol]]]
! !
"Postscript:
Make preference #uniformWindowColors explicit."
Preferences
disable: #uniformWindowColors!
More information about the Squeak-dev
mailing list
|