'From Squeak3.0 of 4 February 2001 [latest update: #3545] on 22 June 2001 at 11:19:53 pm'!

!BorderedMorph methodsFor: 'drawing' stamp: 'dew 12/21/2000 01:39'!
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"
		"Note: This is the hook for border styles.
			When converting to the new borders we'll just put 0 into the borderWidth"
		super drawOn: aCanvas.
		^ self].

	borderColor == #raised ifTrue: [
		"Use a hack for now"
		aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
		^ aCanvas frameAndFillRectangle: bounds
			fillColor: Color transparent
			borderWidth: borderWidth
			topLeftColor: (borderWidth = 1 ifTrue: [color paler]
										ifFalse: [color lighter])
			bottomRightColor: (borderWidth = 1 ifTrue: [color deeper]
										ifFalse: [color darker])].

	borderColor == #inset ifTrue: [
		insetColor _ owner ifNil: [Color black] ifNotNil: [owner colorForInsets].
		aCanvas fillRectangle: self bounds fillStyle: self fillStyle.
		^ aCanvas frameAndFillRectangle: bounds
			fillColor: Color transparent
			borderWidth: borderWidth
			topLeftColor: (borderWidth = 1 ifTrue: [insetColor deeper]
										ifFalse: [insetColor darker])
			bottomRightColor: (borderWidth = 1 ifTrue: [insetColor paler]
										ifFalse: [insetColor lighter])].

	"solid color border"
	aCanvas fillRectangle: (self bounds insetBy: borderWidth) fillStyle: self fillStyle.
	aCanvas frameAndFillRectangle: bounds
		fillColor: Color transparent
		borderWidth: borderWidth
		borderColor: borderColor.! !


!CodeHolder methodsFor: 'construction' stamp: 'dew 3/24/2001 23:00'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row innerFractions |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: #raised;
		layoutPolicy: ProportionalLayout new.

	verticalOffset _ 0.
	innerFractions _ 0@0 corner: 1@0.
	verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset _ self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.

	row 
		addMorph: ((self buildMorphicCodePaneWith: editString) borderWidth: 0)
		fullFrame: (
			LayoutFrame 
				fractions: (innerFractions withBottom: 1) 
				offsets: (0@verticalOffset corner: 0@0)
		).
	window 
		addMorph: row
		frame: nominalFractions.

	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.
! !


!Browser methodsFor: 'initialize-release' stamp: 'dew 6/22/2001 22:56'!
addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset

	| row switchHeight |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: #raised;
		layoutPolicy: ProportionalLayout new.
	switchHeight _ 25.
	row 
		addMorph: aListPane
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@0 corner: 0@switchHeight negated)
		).	

	row 
		addMorph: SubpaneDividerMorph forTopEdge
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@switchHeight negated corner: 0@(1-switchHeight))
		).	

	self 
		addMorphicSwitchesTo: row 
		at: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@(1-switchHeight)  corner: 0@0)
		).

	window 
		addMorph: row
		fullFrame: (
			LayoutFrame 
				fractions: nominalFractions 
				offsets: (0@verticalOffset corner: 0@0)
		).	
	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.

! !


!Color methodsFor: 'transformations' stamp: 'dew 1/2/2001 16:43'!
deeper
	"Answer a deeper shade of this color."
	| saturation |
	saturation _ self saturation.
	^ Color
		h: self hue
		s: (saturation < 0.01 ifTrue: [0.0] ifFalse: [saturation + 0.15 min: 1.0])
		v: (self brightness - 0.15 max: 0.0)

! !

!Color methodsFor: 'transformations' stamp: 'dew 1/2/2001 16:44'!
paler
	"Answer a paler shade of this color."
	^ Color
		h: self hue
		s: (self saturation - 0.15 max: 0.0)
		v: (self brightness + 0.15 min: 1.0)

! !


!PolygonMorph methodsFor: 'drawing' stamp: 'dew 1/9/2001 01:12'!
drawBorderOn: aCanvas usingEnds: anArray 
	"Display my border on the canvas."
	"NOTE: Much of this code is also copied in drawDashedBorderOn:  
	(should be factored)"
	| lineColor bevel topLeftColor bottomRightColor bigClipRect brush p1i p2i beveledSegments octant |
	borderDashSpec
		ifNotNil: [^ self drawDashedBorderOn: aCanvas usingEnds: anArray].
	(borderColor == nil
			or: [borderColor isColor
					and: [borderColor isTransparent]])
		ifTrue: [^ self].
	lineColor _ borderColor.
	bevel _ false.
	"Border colors for bevelled effects depend on CW ordering of  
	vertices"
	borderColor == #raised
		ifTrue: [topLeftColor _ color paler.
			bottomRightColor _ color deeper.
			bevel _ true].
	borderColor == #inset
		ifTrue: [topLeftColor _ owner colorForInsets deeper.
			bottomRightColor _ owner colorForInsets paler.
			bevel _ true].
	beveledSegments _ OrderedCollection new.
	bigClipRect _ aCanvas clipRect expandBy: self borderWidth + 1 // 2.
	brush _ nil.
	self lineSegments reversed
		do: [:segment | 
			| p1 p2 | 
			p1 _ segment first.
			p2 _ segment second.
			p1i _ p1 asIntegerPoint.
			p2i _ p2 asIntegerPoint.
			(arrows ~= #none
					and: [closed not])
				ifTrue: ["Shorten line ends so as not to interfere with tip  
					of arrow."
					((arrows == #back
								or: [arrows == #both])
							and: [p1 = vertices first])
						ifTrue: [p1i _ anArray first asIntegerPoint].
					((arrows == #forward
								or: [arrows == #both])
							and: [p2 = vertices last])
						ifTrue: [p2i _ anArray last asIntegerPoint]].
			(closed
					or: ["bigClipRect intersects: (p1i rect: p2i) optimized:"
						((p1i min: p2i)
							max: bigClipRect origin)
							<= ((p1i max: p2i)
									min: bigClipRect corner)])
				ifTrue: [bevel
						ifTrue: [octant _ p1i octantOf: p2i.
								(octant < 2 or: [octant > 5])
								ifTrue: [beveledSegments addLast: {p1i. p2i. topLeftColor}]
								ifFalse: [beveledSegments addFirst: {p1i. p2i. bottomRightColor}]].
					(borderWidth > 3
							and: [borderColor isColor])
						ifTrue: [brush == nil
								ifTrue: [brush _ (ColorForm dotOfSize: borderWidth)
												colors: (Array with: Color transparent with: borderColor)].
							aCanvas
								line: p1i
								to: p2i
								brushForm: brush]
						ifFalse: [bevel
								ifFalse: [aCanvas
										line: p1i
										to: p2i
										width: borderWidth
										color: lineColor]]]].

	"If bevelled, the highlighted segments are displayed last so their endpoints aren't obscured."
	bevel ifTrue:
		[beveledSegments do:
			[:segment | aCanvas
							line: segment first
							to: segment second
							width: borderWidth
							color: segment third]].
! !


!ScrollPane methodsFor: 'initialization' stamp: 'dew 12/20/2000 21:46'!
initialize
	retractableScrollBar _ (Preferences valueOfFlag: #inboardScrollbars) not.
	scrollBarOnLeft _ (Preferences valueOfFlag: #scrollBarsOnRight) not.
	super initialize.
	hasFocus _ false.
	borderWidth _ 2.
	borderColor _ #raised.

	scrollBar := ScrollBar new model: self slotName: 'scrollBar'.
	scrollBar borderWidth: 1; borderColor: #raised.

	scroller := TransformMorph new color: Color transparent.
	scroller offset: -3@0.
	self addMorph: scroller.

	retractableScrollBar ifFalse: [self addMorph: scrollBar].

	self on: #mouseEnter send: #mouseEnter: to: self.
	self on: #mouseLeave send: #mouseLeave: to: self.
	self extent: 150@120! !


!SubpaneDividerMorph methodsFor: 'initialization' stamp: 'dew 6/22/2001 21:43'!
initialize

	super initialize.
	self extent: 1@1;
		color: (Color black alpha: 0.3).! !


!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 16:49'!
addCloseBox
	| frame polygon |
	closeBox _ SimpleButtonMorph new borderWidth: 0;
			label: '' font: nil; color: Color transparent;
			actionSelector: #closeBoxHit; target: self; extent: 14@14;
			setBalloonText: 'close this window'.
	polygon _ PolygonMorph
				vertices: {1@3. 3@1. 6@4. 9@1. 11@3. 8@6. 11@9.
							9@11. 6@8. 3@11. 1@9. 4@6}
				color: Color paleGreen deeper
				borderWidth: 1
				borderColor: #raised.
	closeBox addMorph: polygon.

	frame _ LayoutFrame new.
	frame leftFraction: 0; leftOffset: 4; topFraction: 0; topOffset: 1.
	closeBox layoutFrame: frame.
	labelArea addMorph: closeBox.! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:23'!
addMenuControl
	"NB: for the moment, we always supply balloon help for this control, until people get used to it; eventually, we mays switch to showing this balloon help only in novice mode, as we do for the other standard window controls."
	| frame polygon |
	menuBox _ SimpleButtonMorph new borderWidth: 0;
			label: ' ' font: Preferences standardButtonFont;
			color: Color transparent; actionSelector: #offerWindowMenu;
			target: self; extent: 14@14; setBalloonText: 'window menu'.
	"Would prefer a RectangleMorph, but the colors are different in 8-bit mode"
	polygon _ PolygonMorph vertices: {3@10. 3@2. 10@2. 10@10} color: Color paleGreen deeper borderWidth: 1 borderColor: #raised.
	menuBox addMorph: polygon.

	frame _ LayoutFrame new.
	frame leftFraction: 0; leftOffset: 19; topFraction: 0; topOffset: 1.
	menuBox layoutFrame: frame.
	labelArea addMorph: menuBox.
! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:09'!
initialize
	| titleBar polygon |
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	borderColor _ #raised.
	borderWidth _ 1.
	color _ Color gray.
	self layoutPolicy: ProportionalLayout new.

	label _ StringMorph new contents: labelString;
			font: Preferences windowTitleFont emphasis: 1.

	"Add collapse box so #labelHeight will work"
	collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: ' ' font: aFont; color: Color transparent;
			actionSelector: #collapseOrExpand; target: self; extent: 14@14;
			setBalloonText: 'collapse this window'.
	polygon _ PolygonMorph
				vertices: {3@5. 5@3. 8@3. 10@5. 10@8. 8@10. 5@10. 3@8}
				color: Color paleGreen deeper
				borderWidth: 1
				borderColor: #raised.
	collapseBox addMorph: polygon.

	titleBar _ (RectangleMorph newBounds: bounds) borderColor: #raised.
	stripes _ Array with: titleBar with: titleBar. "temporary, until stripes refs are cleaned up"

	self addLabelArea.

	labelArea addMorph: (stripes first borderWidth: 1).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	labelArea addMorph: label.
	labelArea addMorph: collapseBox.

	self setFramesForLabelArea.

	Preferences noviceMode ifTrue:
		[closeBox ifNotNil: [closeBox setBalloonText: 'close window'].
		menuBox ifNotNil: [menuBox setBalloonText: 'window menu'].
		collapseBox ifNotNil: [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.
	mustNotClose _ false.
	updatablePanes _ Array new.! !

!SystemWindow methodsFor: 'initialization' stamp: 'dew 1/13/2001 23:11'!
setFramesForLabelArea

	"an aid to converting old instances, but then I found convertAlignment"

	| frame |

	frame _ LayoutFrame new.
	frame leftFraction: 0.5; topFraction: 0; leftOffset: label width negated // 2.
	label layoutFrame: frame.

	frame _ LayoutFrame new.
	frame rightFraction: 1; topFraction: 0; rightOffset: -1; topOffset: 1.
	collapseBox layoutFrame: frame.

	frame _ LayoutFrame new.
	frame leftFraction: 0; topFraction: 0; rightFraction: 1;
			leftOffset: 0; topOffset: 0; rightOffset: 0.
	stripes first layoutFrame: frame.
	stripes first height: self labelHeight.
	stripes first hResizing: #spaceFill.

	frame _ LayoutFrame new.
	frame leftFraction: 0; topFraction: 0; rightFraction: 1;
			topOffset: self labelHeight negated.
	labelArea layoutFrame: frame.
! !

!SystemWindow methodsFor: 'label' stamp: 'dew 1/15/2001 12:53'!
setStripeColorsFrom: paneColor
	| buttonColor |
	self isActive
		ifTrue:
			[stripes first color: paneColor deeper slightlyDarker.
			buttonColor _ paneColor darker deeper.]
		ifFalse:
			[stripes first color: paneColor.
			buttonColor _ paneColor deeper lighter.].

	closeBox submorphs first color: buttonColor.
	collapseBox submorphs first color: buttonColor.
	menuBox submorphs first color: buttonColor.

! !