'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@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@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@0.
	self addMorph: scroller.

	self on: #mouseEnter send: #mouseEnter: to: self.
	self on: #mouseLeave send: #mouseLeave: to: self.
	self extent: 150@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@16).
	self addMorph: (collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: 'O' font: aFont; color: Color transparent;
			actionSelector: #collapseOrExpand; target: self; extent: 16@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@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!