[ENH(?)] 3D Look for Morphic Windows

Bert Freudenberg bert at isgnw.CS.Uni-Magdeburg.De
Mon Jun 7 06:53:07 UTC 1999


Hi all Squeak color haters ;-)

I personally got very used to Squeaks coloring scheme, and I don't
experience hurting eyes as some of you reported ... But still, the colors
seem to be quite an obstacle for beginners. I heared that complaints for
years (okay, not *that* many years). Anyway, I wondered how hard it would
be to get a "conventional" gray 3d look - it wasn't (well, at least for
Morphic). Now here it comes:

"Change Set:		3dlook-bf
Date:			21 May 1999
Author:			Bert Freudenberg

Adds a 3D look to Morphic windows. Enable uniformWindowColors in
preferences to try."

It basically works by setting all panes borderColor to #raised. The rest
is preferences handling, some cosmetic stuff (one pixel wide borders
didn't look good with the default hilite/shadow colors), and some extra
code for handling a browser's switches (these seem to me like a rather
crude hack that doesn't really fit into the SystemWindow/ScrollPane
scheme).

Enjoy,
/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.cs"
Content-ID: <Pine.LNX.3.96.990607085307.14323C at balloon.cs.uni-magdeburg.de>
Content-Description: 

'From Squeak 2.3 of January 14, 1999 on 7 June 1999 at 7:34:13 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 5/21/1999 16:02'!
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: World 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