Hello,
Here is a stab at the basic look of the SystemWindow closeBox and
collapseBox.
I just added some RectangleMorphs and that was quite easy.
The not so easy part was the SimpleButtonMorph. I needed a update to
submorphs
while the button was pressed and added a #actWhilePressed selector. I
know, I know,
I could have sub classed but I think this is a quite general selector
for buttons, often one
needs more than one selector and here is a attempt at that. Maybe a more
general
solution is needed ?
Please take a look and give me some feedback.

Karl






-------------- next part --------------
'From Squeak2.8alpha of 19 February 2000 [latest update: #2040] on 29 April 2000 at 11:44:05 am'!
RectangleMorph subclass: #SimpleButtonMorph
	instanceVariableNames: 'target actionSelector arguments actWhen oldColor actWhilePressed '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!

!SimpleButtonMorph methodsFor: 'initialization' stamp: 'kfr 4/29/2000 11:41'!
initialize

	super initialize.
	self borderWidth: 1.
	self cornerStyle: #rounded.
	self color: (Color r: 0.4 g: 0.8 b: 0.6).
	self borderColor: self color darker.
	target _ nil.
	actionSelector _ #flash.
	arguments _ EmptyArray.
	actWhen _ #buttonUp.
	actWhilePressed _ nil.
	self setDefaultLabel
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'kfr 4/29/2000 10:50'!
actWhilePressed

	^ actWhilePressed
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'kfr 4/29/2000 10:49'!
actWhilePressed: aSymbolOrString

	(nil = aSymbolOrString or:
	 ['nil' = aSymbolOrString or:
	 [aSymbolOrString isEmpty]])
		ifTrue: [^ actWhilePressed _ nil].

	actWhilePressed _ aSymbolOrString asSymbol.
! !

!SimpleButtonMorph methodsFor: 'events' stamp: 'kfr 4/29/2000 11:32'!
mouseMove: evt
	actWhen == #buttonDown ifTrue: [^ self].
	(self containsPoint: evt cursorPoint)
		ifTrue: [oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color white)].
				(actWhilePressed ~~ nil)
					ifTrue: [target perform: actWhilePressed ].
				(actWhen == #whilePressed and: [evt anyButtonPressed])
					 ifTrue: [self doButtonAction.
							evt hand noteSignificantEvent: evt]]
		ifFalse: [oldColor ifNotNil: [self color: oldColor].
				(actWhilePressed ~~ nil)
					ifTrue: [target perform: actWhilePressed ]]
! !


!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/27/2000 22:42'!
addCloseBox
	self addMorph: (closeBox _ SimpleButtonMorph new borderWidth: 1;borderColor: Color black;
			cornerStyle: #square;
			label: '' font: Preferences standardButtonFont; color: Color transparent;
			actionSelector: #delete; target: self; extent: 10 at 10)! !

!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/29/2000 10:58'!
addCollapseBox

	self addMorph: (collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: '' font: Preferences standardButtonFont;
			cornerStyle: #square;
			 color: Color transparent;actWhilePressed: #subMorphAction;
			actionSelector: #collapseOrExpand; target: self; extent: 10 at 10).
	
	collapseBoxSubMorph _ Array with:
	(RectangleMorph new extent: 6 @ 6; position: 0 @ 0; 
	borderWidth: 1; borderColor: Color black;  color: Color transparent)
	with:( RectangleMorph new extent: 7 @ 7;position: 3 @ 3; borderWidth: 1; borderColor: Color 	black; color: Color transparent).
	collapseBox addMorph: collapseBoxSubMorph first.
	collapseBox addMorph: collapseBoxSubMorph second.

! !

!SystemWindow methodsFor: 'initialization' stamp: 'kfr 4/28/2000 19:27'!
initialize
	| aFont |
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	paneRects _ Array new.
	collapseBoxSubMorph _ Array new.
	borderColor _ #raised.
	borderWidth _ 1.
	color _ Color black.
	aFont _ Preferences standardButtonFont.
	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: Preferences windowTitleFont emphasis: 1).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	self addCollapseBox.
	
	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 at 200.
	mustNotClose _ false.
	updatablePanes _ Array new.! !

!SystemWindow methodsFor: 'geometry' stamp: 'kfr 4/28/2000 20:23'!
extent: newExtent
	| inner labelRect |
	isCollapsed
		ifTrue: [super extent: newExtent x @ (self labelHeight + 2)]
		ifFalse: [super extent: newExtent].
	inner _ self innerBounds.
	labelRect _ self labelRect.

	stripes first bounds: (labelRect insetBy: 1).
	stripes second bounds: (labelRect insetBy: 3).
	self setStripeColorsFrom: self paneColorToUse.
	closeBox ifNotNil:
		[closeBox align: closeBox topLeft with: inner topLeft + (4 at 3)].
	
	menuBox ifNotNil:
		[menuBox align: menuBox topLeft with: (inner topLeft + (19 at 1))].
	collapseBox align: collapseBox topRight with: inner topRight - (4 at 3 negated).
	collapseBoxSubMorph second color: self paneColor.
	collapseBoxSubMorph first color: self paneColor.
	label fitContents; setWidth: (label width min: bounds width - self labelWidgetAllowance).
	label align: label bounds topCenter with: inner topCenter.
	isCollapsed ifFalse: [self setBoundsOfPaneMorphs].
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'kfr 4/29/2000 11:38'!
subMorphAction
	(collapseBox containsPoint: self cursorPoint)
	ifTrue:[
	collapseBoxSubMorph first color: Color gray.
	collapseBoxSubMorph second color: Color gray]
	ifFalse:[
	collapseBoxSubMorph first color: self paneColor.
	collapseBoxSubMorph second color: self paneColor]
	
	! !

RectangleMorph subclass: #SimpleButtonMorph
	instanceVariableNames: 'target actionSelector arguments actWhen actWhilePressed oldColor '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!