The Windoze Junta - StandardSystemView revisited

Andreas Raab raab at isgnw.cs.Uni-Magdeburg.DE
Thu Jan 22 22:56:36 UTC 1998


Sam,

I put a couple of hours into modifying StandardSystemView to display more
like something we all love ;-) Below is the result. The new system views
have a close box at the upper right, a separate grow and shrink box, and a
system menu button which can also be used for closing the view by double
clicking ;-) 

Note that you can turn on and off the new look by executing
"NiceSystemView install" or "NiceSystemView unInstall", but this is still
a hack - you cannot open new projects after installing. The remaining
stuff should work though.

If you want to integrate this into your PowerTools please feel free to do
so. BTW, I like the combined look of the scroll bars and the system views
- now we have to go for the 3d border look on views in general ;-))) 

Regards,
  Andreas

----------------------------------------------------------------------------

'From Squeak 1.3 of Jan 16, 1998 on 22 January 1998 at 11:37:14 pm'!
StandardSystemController subclass: #NiceSystemController
	instanceVariableNames: 'lastSystemActivity '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Interface-AR'!
StandardSystemView subclass: #NiceSystemView
	instanceVariableNames: 'growFrame '
	classVariableNames: 'CloseBoxForm GrowBoxForm ShrinkBoxForm SystemBoxForm '
	poolDictionaries: ''
	category: 'Interface-AR'!

!NiceSystemController methodsFor: 'accessing' stamp: 'ar 1/22/98 23:30'!
lastSystemActivity
	^lastSystemActivity ifNil:[lastSystemActivity _ 0]! !

!NiceSystemController methodsFor: 'accessing' stamp: 'ar 1/22/98 23:30'!
lastSystemActivity: aNumber
	lastSystemActivity _ aNumber! !

!NiceSystemController methodsFor: 'basic control sequence' stamp: 'ar 1/22/98 23:33'!
redButtonActivity
	| box p |
	p _ sensor cursorPoint.
	((box _ view systemBoxFrame) containsPoint: p)
		ifTrue: [^self systemActivity].
	((box _ view shrinkBoxFrame) containsPoint: p)
		ifTrue: [Utilities awaitMouseUpIn: box repeating: [] ifSucceed: [self collapse. ^ self].
				^ self].
	((box _ view growBoxFrame) containsPoint: p)
		ifTrue: [Utilities awaitMouseUpIn: box repeating: [] ifSucceed: 
					[view isCollapsed
						ifTrue:[self expand]
						ifFalse:[view isFullScreen ifTrue:[self restore] ifFalse:[self fullScreen]].
					 ^ self].
				^ self].

	super redButtonActivity.! !

!NiceSystemController methodsFor: 'basic control sequence' stamp: 'ar 1/22/98 23:33'!
systemActivity
	"The system menu button has been pressed"
	| time |
	time _ Time millisecondClockValue.
	(time- self lastSystemActivity) < self doubleClickTime
		ifTrue:[^self close].
	self lastSystemActivity: time.
	^self blueButtonActivity! !

!NiceSystemController methodsFor: 'menu messages' stamp: 'ar 1/22/98 22:41'!
restore
	view restore! !

!NiceSystemController methodsFor: 'private' stamp: 'ar 1/22/98 23:32'!
doubleClickTime
	"Return the maximum delay time for double clicks.
	This value is in milliseconds."
	^500! !


!NiceSystemView methodsFor: 'label accessing' stamp: 'ar 1/22/98 22:14'!
closeBoxFrame
	^ Rectangle origin: (self labelDisplayBox rightCenter + (-16 at -5)) extent: (11 at 11)! !

!NiceSystemView methodsFor: 'label accessing' stamp: 'ar 1/22/98 22:14'!
growBoxFrame
	^ Rectangle origin: (self labelDisplayBox rightCenter + (-30 at -5)) extent: (11 at 11)! !

!NiceSystemView methodsFor: 'label accessing' stamp: 'ar 1/22/98 22:57'!
labelTextRegion
	labelText == nil ifTrue: [^ self labelDisplayBox center extent: 0 at 0].
	^ (labelText boundingBox
			align: labelText boundingBox leftCenter
			with: self labelDisplayBox leftCenter + (35 at 0))
		intersect: (self labelDisplayBox origin corner: self labelDisplayBox corner - (45 at 0))! !

!NiceSystemView methodsFor: 'label accessing' stamp: 'ar 1/22/98 22:15'!
shrinkBoxFrame
	^ Rectangle origin: (self labelDisplayBox rightCenter + (-42 at -5)) extent: (11 at 11)! !

!NiceSystemView methodsFor: 'label accessing' stamp: 'ar 1/22/98 22:18'!
systemBoxFrame
	^ Rectangle origin: (self labelDisplayBox leftCenter + (10 at -5)) extent: (11 at 11)! !

!NiceSystemView methodsFor: 'framing' stamp: 'ar 1/22/98 22:47'!
fullScreen
	| portRect |
	portRect _ self viewport.
	growFrame _ portRect topLeft - self labelOffset
				corner: portRect corner.
	^super fullScreen! !

!NiceSystemView methodsFor: 'framing' stamp: 'ar 1/22/98 22:49'!
restore
	self reframeTo: ( growFrame isNil ifTrue:[self initialFrame] ifFalse:[growFrame])! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 22:59'!
displayLabelBackground: emphasized
	"Clear or emphasize the inner region of the label"
	super displayLabelBackground: emphasized.
	emphasized ifFalse:[self displayLabelBoxes]! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 23:17'!
displayLabelBoxes
	CloseBoxForm ifNil:[CloseBoxForm _ self drawCloseBoxForm].
	GrowBoxForm ifNil:[GrowBoxForm _ self drawGrowBoxForm].
	ShrinkBoxForm ifNil:[ShrinkBoxForm _ self drawShrinkBoxForm].
	SystemBoxForm ifNil:[SystemBoxForm _ self drawSystemBoxForm].
	CloseBoxForm displayOn: Display at: self closeBoxFrame origin.
	GrowBoxForm displayOn: Display at: self growBoxFrame origin.
	self isCollapsed ifFalse:[ShrinkBoxForm displayOn: Display at: self shrinkBoxFrame origin].
	SystemBoxForm displayOn: Display at: self systemBoxFrame origin.! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 23:08'!
displayLabelText
	"The label goes in the center of the window"
	| labelRect |
	labelText foregroundColor: self foregroundColor
			backgroundColor: self labelColor.
	labelRect _ self labelTextRegion.
	"Display fill: (labelRect expandBy: 3 at 0) fillColor: self labelColor."
	labelText displayOn: Display at: labelRect topLeft clippingBox: labelRect
			rule: labelText rule fillColor: labelText fillColor! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 22:01'!
drawCloseBoxForm
	| box pen form |
	form _ Form extent: self closeBoxFrame extent depth: 8.
	box _ form boundingBox.
	pen _ Pen new.
	pen destForm: form.
	pen color: Color gray.
	pen place: box bottomLeft.
	pen goto: box topLeft.
	pen goto: box topRight. 
	pen color: Color veryLightGray.
	pen place: box bottomLeft + (1 @ 0).
	pen goto: box topLeft + 1.
	pen goto: box topRight + (0 @ 1).
	pen color: Color darkGray.
	pen place: box bottomLeft + (1 @ 1 negated).
	pen goto: box bottomRight - (1 @ 1).
	pen goto: box topRight + (1 negated @ 1).
	pen color: Color black.
	pen place: box bottomLeft.
	pen goto: box bottomRight.
	pen goto: box topRight.
	form fill: (box origin + (2 @ 2) corner: box corner - (1 @ 1))
		fillColor: Color gray.
	pen color: Color black.
	pen defaultNib: 2.
	pen place: box bottomLeft + (3 at -4).
	pen goto: box topRight - (4 at -3).
	pen place: box topLeft + (3 at 3).
	pen goto: box bottomRight - (4 at 4).
	^form!
]style[(924 1 6)f1,f1b,f1! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 22:10'!
drawGrowBoxForm
	| box pen form |
	form _ Form extent: self growBoxFrame extent depth: 8.
	box _ form boundingBox.
	pen _ Pen new.
	pen destForm: form.
	pen color: Color gray.
	pen place: box bottomLeft.
	pen goto: box topLeft.
	pen goto: box topRight. 
	pen color: Color veryLightGray.
	pen place: box bottomLeft + (1 @ 0).
	pen goto: box topLeft + 1.
	pen goto: box topRight + (0 @ 1).
	pen color: Color darkGray.
	pen place: box bottomLeft + (1 @ 1 negated).
	pen goto: box bottomRight - (1 @ 1).
	pen goto: box topRight + (1 negated @ 1).
	pen color: Color black.
	pen place: box bottomLeft.
	pen goto: box bottomRight.
	pen goto: box topRight.
	form fill: (box origin + (2 @ 2) corner: box corner - (1 @ 1))
		fillColor: Color gray.
	pen color: Color black.
	pen place: box topLeft + (3 at 3).
	pen goto: box bottomLeft + (3 at -3).
	pen goto: box bottomRight + (-3 at -3).
	pen goto: box topRight + (-3 at 3).
	pen defaultNib: 2.
	pen place: box topRight + (-4 at 3).
	pen goto: box topLeft + (3 at 3).
	^form! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 22:11'!
drawShrinkBoxForm
	| box pen form |
	form _ Form extent: self growBoxFrame extent depth: 8.
	box _ form boundingBox.
	pen _ Pen new.
	pen destForm: form.
	pen color: Color gray.
	pen place: box bottomLeft.
	pen goto: box topLeft.
	pen goto: box topRight. 
	pen color: Color veryLightGray.
	pen place: box bottomLeft + (1 @ 0).
	pen goto: box topLeft + 1.
	pen goto: box topRight + (0 @ 1).
	pen color: Color darkGray.
	pen place: box bottomLeft + (1 @ 1 negated).
	pen goto: box bottomRight - (1 @ 1).
	pen goto: box topRight + (1 negated @ 1).
	pen color: Color black.
	pen place: box bottomLeft.
	pen goto: box bottomRight.
	pen goto: box topRight.
	form fill: (box origin + (2 @ 2) corner: box corner - (1 @ 1))
		fillColor: Color gray.
	pen color: Color black.
	pen defaultNib: 2.
	pen place: box bottomRight + (-4 at -3).
	pen goto: box bottomLeft + (3 at -3).
	^form! !

!NiceSystemView methodsFor: 'displaying' stamp: 'ar 1/22/98 22:18'!
drawSystemBoxForm
	| box pen form |
	form _ Form extent: self closeBoxFrame extent depth: 8.
	box _ form boundingBox.
	pen _ Pen new.
	pen destForm: form.
	pen color: Color gray.
	pen place: box bottomLeft.
	pen goto: box topLeft.
	pen goto: box topRight. 
	pen color: Color veryLightGray.
	pen place: box bottomLeft + (1 @ 0).
	pen goto: box topLeft + 1.
	pen goto: box topRight + (0 @ 1).
	pen color: Color darkGray.
	pen place: box bottomLeft + (1 @ 1 negated).
	pen goto: box bottomRight - (1 @ 1).
	pen goto: box topRight + (1 negated @ 1).
	pen color: Color black.
	pen place: box bottomLeft.
	pen goto: box bottomRight.
	pen goto: box topRight.
	form fill: (box origin + (2 @ 2) corner: box corner - (1 @ 1))
		fillColor: Color gray.
	^form! !

!NiceSystemView methodsFor: 'testing' stamp: 'ar 1/22/98 22:07'!
cacheBitsAsTwoTone
	^false! !

!NiceSystemView methodsFor: 'testing' stamp: 'ar 1/22/98 22:37'!
isFullScreen
	| frame |
	frame _ model fullScreenSize.
	^(frame topLeft + self labelOffset corner: frame corner) = self viewport
! !

!NiceSystemView methodsFor: 'controller access' stamp: 'ar 1/22/98 22:22'!
defaultControllerClass
	^NiceSystemController! !


!StandardSystemView class methodsFor: 'instance creation' stamp: 'ar 1/22/98 23:36'!
new
	"This is a rather dirty hack -- but we don't have a window builder yet. (ar 1/22/98 23:36)"
	^Preferences nicerSystemViews
		ifTrue:[NiceSystemView basicNew initialize]
		ifFalse:[self basicNew initialize]! !


!NiceSystemView class methodsFor: 'class initialization' stamp: 'ar 1/22/98 23:13'!
initialize
	"NiceSystemView initialize"! !

!NiceSystemView class methodsFor: 'class initialization' stamp: 'ar 1/22/98 23:15'!
install
	"NiceSystemView install"
	Preferences setPreference: #nicerSystemViews toValue: true.! !

!NiceSystemView class methodsFor: 'class initialization' stamp: 'ar 1/22/98 23:14'!
unInstall
	"NiceSystemView unInstall"
	Preferences setPreference: #nicerSystemViews toValue: false.! !


NiceSystemView initialize!


----------------------------------------------------------------------------

-- 
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab at isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics      Phone: +49 391 671 8065  I
I University of Magdeburg, Germany           Fax:   +49 391 671 1164  I
+=============< http://isgwww.cs.uni-magdeburg.de/~raab >=============+





More information about the Squeak-dev mailing list