--- a/View.st Tue Apr 19 01:26:34 1994 +0200
+++ b/View.st Sat Apr 23 21:13:15 1994 +0200
@@ -30,7 +30,8 @@
keyboardHandler model controller windowGroup
aspectSymbol changeSymbol menuSymbol'
classVariableNames: 'Grey ZeroPoint CentPoint
- ViewSpacing DefaultStyle'
+ ViewSpacing DefaultStyle
+ StyleSheet'
poolDictionaries: ''
category:'Views-Basic'
!
@@ -42,7 +43,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/View.st,v 1.13 1994-02-25 13:14:38 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.14 1994-04-23 19:13:15 claus Exp $
written spring/summer 89 by claus
3D effects summer 90 by claus
@@ -54,54 +55,58 @@
Smalltalk at:#View3D put:false!
!View class methodsFor:'documentation'!
+
+documentation
"
-this class implements functions common to all Views.
-Instances of View are seldom used, most views in the system inherit from this class.
-However, sometimes a view is used to create a dummy view for framing purposes.
-
-Instance variables:
-
-superView <aView> my superview i.e. the view I am in
-subViews <aCollection> the collection of subviews
-transformation <WindowingTransformation>
-window <Rectangle> my window i.e. local coordinate-system
-viewport <Rectangle> my Rectangle in superviews coordinates
-borderColor <Color> color of border
-borderWidth <Number> borderWidth in pixels (device dep.)
-borderShape <Form> shape of border (if device supports it)
-viewShape <Form> shape of view (if device supports it)
-top <Number> top coordinate in superview
-left <Number> left coordinate in superview
-extendChanged <Boolean> true if extend changed during setup
-originChanged <Boolean> true if origin changed during setup
-relativeOrigin <Number> relative origin in percent within superview
-relativeExtent <Number> relative extent in percent within superview
-originRule <Block> rule to compute origin if superview changes size
-extentRule <Block> rule to compute extent if superview changes size
-shown <Boolean> true if visible (false if iconified)
-hidden <Boolean> dont show automatically when superview is realized
-name <String> my name (future use for resources)
-level <Number> 3D level relative to superview
-margin <Number> convenient margin
-innerClipRect <Rectangle> convenient inner clip (minus margin)
-shadowColor <Color> color used to draw 3D shadowed edges
-lightColor <Color> color used to draw 3D lighted edges
-viewOrigin <Point> origin within model
-contentsChanngeAction <Block> action to perform when model contents changes
-originChangeAction <Block> action to perform when model origin changes
-bitGravity <Symbol> gravity of contents (if device supports it)
-viewGravity <Symbol> gravity of view (if device supports it)
-keyboardHandler <anObject> gets keyboard input if non-nil
-model <anObject> the model (if any)
-controller <aController> the controller
-
-Class variables:
-
-Grey <Color> the color grey - its used so often
-ViewSpacing <Number> the number of pixels in a millimeter (prefered
- spacing between views)
-ZeroPoint <Point> 0 @ 0 - its used so often
-CentPoint <Point> 100 @ 100 - its used so often
+ this class implements functions common to all Views.
+ Instances of View are seldom used, most views in the system inherit from this class.
+ However, sometimes a view is used to create a dummy view for framing purposes.
+
+ Instance variables:
+
+ superView <aView> my superview i.e. the view I am in
+ subViews <aCollection> the collection of subviews
+ transformation <WindowingTransformation>
+ window <Rectangle> my window i.e. local coordinate-system
+ viewport <Rectangle> my Rectangle in superviews coordinates
+ borderColor <Color> color of border
+ borderWidth <Number> borderWidth in pixels (device dep.)
+ borderShape <Form> shape of border (if device supports it)
+ viewShape <Form> shape of view (if device supports it)
+ top <Number> top coordinate in superview
+ left <Number> left coordinate in superview
+ extendChanged <Boolean> true if extend changed during setup
+ originChanged <Boolean> true if origin changed during setup
+ relativeOrigin <Number> relative origin in percent within superview
+ relativeExtent <Number> relative extent in percent within superview
+ originRule <Block> rule to compute origin if superview changes size
+ extentRule <Block> rule to compute extent if superview changes size
+ shown <Boolean> true if visible (false if iconified)
+ hidden <Boolean> dont show automatically when superview is realized
+ name <String> my name (future use for resources)
+ level <Number> 3D level relative to superview
+ margin <Number> convenient margin
+ innerClipRect <Rectangle> convenient inner clip (minus margin)
+ shadowColor <Color> color used to draw 3D shadowed edges
+ lightColor <Color> color used to draw 3D lighted edges
+ viewOrigin <Point> origin within model
+ contentsChanngeAction <Block> action to perform when model contents changes
+ originChangeAction <Block> action to perform when model origin changes
+ bitGravity <Symbol> gravity of contents (if device supports it)
+ viewGravity <Symbol> gravity of view (if device supports it)
+ keyboardHandler <anObject> gets keyboard input if non-nil
+ model <anObject> the model (if any)
+ controller <aController> the controller
+
+ Class variables:
+
+ Grey <Color> the color grey - its used so often
+ ViewSpacing <Number> the number of pixels in a millimeter (prefered
+ spacing between views)
+ ZeroPoint <Point> 0 @ 0 - its used so often
+ CentPoint <Point> 100 @ 100 - its used so often
+
+ StyleSheet <ResourcePack> contains all view-style specifics
"
! !
@@ -137,6 +142,7 @@
aStyle ~~ DefaultStyle ifTrue:[
DefaultStyle := aStyle.
+ StyleSheet := ResourcePack fromFile:('s_' , aStyle , '.rs').
ResourcePack flushResources.
View withAllSubclasses do:[:aClass |
aClass updateClassResources
@@ -1170,17 +1176,34 @@
view superView:self
]
]
+! !
+
+!View methodsFor:'queries'!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have.
+ The default here is the actual extent, the receiver currently has."
+
+ ^ self extent
+! !
+
+!View methodsFor:'enumerating subviews'!
+
+allSubViewsDo:aBlock
+ "evaluate aBlock for all subviews (recursively)"
+
+ (subViews isNil or:[subViews isEmpty]) ifFalse:[
+ subViews do:[:aSubview |
+ aSubview withAllSubViewsDo:aBlock
+ ]
+ ]
!
withAllSubViewsDo:aBlock
- "evaluate aBlock for all subviews (recursively)"
+ "evaluate aBlock for the receiver and all subviews (recursively)"
aBlock value:self.
- (subViews isNil or:[subViews isEmpty]) ifFalse:[
- subViews do:[:aSubview |
- aSubview withAllSubviewsDo:aBlock
- ]
- ]
+ self allSubViewsDo:aBlock
! !
!View methodsFor:'accessing-misc'!
@@ -1278,12 +1301,13 @@
!View methodsFor:'accessing-bg & border'!
viewBackground:something
- "set the viewBackground to something, a color, pixel or form.
- if its a color and we run on a color display, also set shadow and light
- colors."
-
- (something isKindOf:Color) ifTrue:[
- (device hasColors or:[device hasGreyscales]) ifTrue:[
+ "set the viewBackground to something, a color, image or form.
+ If its a color and we run on a color display, also set shadow and light
+ colors - this means, that a red view will get light-red and dark-red
+ edges."
+
+ something isColor ifTrue:[
+ device hasGreyscales ifTrue:[
shadowColor := something darkened.
lightColor := something lightened
]
@@ -1314,7 +1338,7 @@
dither notNil ifTrue:[
device setWindowBorderPixmap:(dither id) in:drawableId
] ifFalse:[
- 'bad borderColor' printNewline
+ 'bad borderColor' errorPrintNewline
]
]
]
@@ -1454,9 +1478,9 @@
aView superView:self.
(aView device ~~ device) ifTrue:[
- 'warning subview (' print. aView class name print.
- ') has different device than me (' print.
- self class name print. ').' printNewline.
+ 'warning subview (' errorPrint. aView class name errorPrint.
+ ') has different device than me (' errorPrint.
+ self class name errorPrint. ').' errorPrintNewline.
aView device:device
]
!
@@ -1878,80 +1902,6 @@
self pixelOrigin:(left @ top) extent:extent
!
-XXpixelExtent:extent
- "set the views extent in pixels"
-
- |newWidth newHeight how mustRedrawBottomEdge mustRedrawRightEdge|
-
- newWidth := extent x.
- newHeight := extent y.
- ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
- "shown "drawableId notNil"" ifTrue:[ "23-feb-93"
- ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
- how := #smaller
- ].
-
- mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
- mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
-
- (level ~~ 0) ifTrue:[
- "clear the old edges"
-
- newWidth > width ifTrue:[
- self clipRect:nil.
- self paint:viewBackground.
- self fillRectangleX:(width - margin)
- y:0
- width:margin
- height:height
- ].
- newHeight > height ifTrue:[
- self clipRect:nil.
- self paint:viewBackground.
- self fillRectangleX:0
- y:(height - margin)
- width:width
- height:margin
- ]
- ]
- ].
-
- width := newWidth.
- height := newHeight.
-
- "shown "drawableId notNil"" ifTrue:[ "23-feb-93"
- self setInnerClip.
-
- (how == #smaller) ifTrue:[
- "if view becomes smaller, send sizeChanged first"
- self sizeChanged:how
- ].
-
- "have to tell X, when extent of view is changed"
- device resizeWindow:drawableId width:width height:height.
-
- "if view becomes bigger, send sizeChanged after"
- (how ~~ #smaller) ifTrue:[
- self sizeChanged:how
- ].
-
- (mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
- self clipRect:nil.
- mustRedrawBottomEdge ifTrue:[
- self drawBottomEdge
- ].
- mustRedrawRightEdge ifTrue:[
- self drawRightEdge
- ].
- self clipRect:innerClipRect
- ]
- ] ifFalse:[
- "otherwise memorize the need for a sizeChanged message"
- extentChanged := true
- ]
- ]
-!
-
pixelOrigin:origin
"set the views origin in pixels"
@@ -2123,8 +2073,11 @@
|newX newY rel inRect|
- superView isNil ifTrue:[^ nil].
- inRect := superView viewRectangle.
+ superView isNil ifTrue:[
+ inRect := 0@0 extent:device extent
+ ] ifFalse:[
+ inRect := superView viewRectangle.
+ ].
rel := relativePoint x.
(rel isMemberOf:Float) ifTrue:[
@@ -2146,9 +2099,12 @@
|newOrigin newX newY rel inRect bw2|
- superView isNil ifTrue:[^ nil].
-
- inRect := superView viewRectangle.
+ superView isNil ifTrue:[
+ inRect := 0@0 extent:device extent
+ ] ifFalse:[
+ inRect := superView viewRectangle.
+ ].
+
bw2 := borderWidth * 2.
rel := relativeOrigin x.
(rel isMemberOf:Float) ifTrue:[
@@ -2180,9 +2136,12 @@
|newCorner newX newY rel inRect bw2|
- superView isNil ifTrue:[^ nil].
-
- inRect := superView viewRectangle.
+ superView isNil ifTrue:[
+ inRect := 0@0 extent:device extent
+ ] ifFalse:[
+ inRect := superView viewRectangle.
+ ].
+
bw2 := borderWidth * 2.
rel := relativeCorner x.
(rel isMemberOf:Float) ifTrue:[
@@ -2214,9 +2173,12 @@
|newExtent newX newY rel inRect bw2|
- superView isNil ifTrue:[^ nil].
-
- inRect := superView viewRectangle.
+ superView isNil ifTrue:[
+ inRect := 0@0 extent:device extent
+ ] ifFalse:[
+ inRect := superView viewRectangle.
+ ].
+
bw2 := borderWidth * 2.
rel := relativeExtent x.
(rel isMemberOf:Float) ifTrue:[
@@ -2337,9 +2299,11 @@
"associate cursor/colors to device"
+"
viewBackground notNil ifTrue:[
viewBackground := viewBackground on:device.
].
+"
borderColor notNil ifTrue:[
borderColor := borderColor on:device.
].
@@ -2358,6 +2322,9 @@
extentChanged := false.
originChanged := false.
+ viewBackground notNil ifTrue:[
+ self setViewBackground
+ ].
borderShape notNil ifTrue:[
device setWindowBorderShape:(borderShape id) in:drawableId
].
@@ -2470,8 +2437,10 @@
rerealize
"rerealize at old position"
- device mapView:self id:drawableId iconified:false
- atX:left y:top width:width height:height
+ drawableId notNil ifTrue:[
+ device mapView:self id:drawableId iconified:false
+ atX:left y:top width:width height:height
+ ]
!
destroy
@@ -3180,23 +3149,38 @@
|ok bitmaps cursors mask process oldCursor|
- ok := true.
- bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4') collect:[:name |
- |f|
-
- f := Form fromFile:(name , '.xbm').
- f isNil ifTrue:[ok := false].
- f
- ].
-
- mask := Form fromFile:'wheelm.xbm'.
- mask isNil ifTrue:[ok := false].
-
oldCursor := cursor.
+self cursor:Cursor wait.
+aBlock valueNowOrOnUnwindDo:[
+ self cursor:oldCursor
+].
+^ self.
+
+ok := false.
+
+ ok := ProcessorScheduler isPureEventDriven not.
+ ok ifTrue:[
+ ok := (OperatingSystem getSystemType = 'linux') not.
+ ok ifTrue:[
+ bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4')
+ collect:[:name |
+ |f|
+
+ f := Form fromFile:(name , '.xbm').
+ f isNil ifTrue:[ok := false].
+ f
+ ].
+
+ mask := Form fromFile:'wheelm.xbm'.
+ mask isNil ifTrue:[ok := false].
+ ].
+ ].
ok ifFalse:[
self cursor:Cursor wait.
- aBlock value.
+ aBlock valueNowOrOnUnwindDo:[
+ self cursor:oldCursor
+ ]
] ifTrue:[
cursors := bitmaps collect:[:form | (Cursor sourceForm:form
maskForm:mask
@@ -3214,11 +3198,12 @@
] fork.
Processor activeProcess priority:7.
- aBlock value.
- Processor activeProcess priority:8.
- process terminate.
+ aBlock valueNowOrOnUnwindDo:[
+ Processor activeProcess priority:8.
+ process terminate.
+ self cursor:oldCursor
+ ]
].
- self cursor:oldCursor
-
- "View new realize showSpinningWheelWhile:[500 factorial]"
+
+ "View new realize showBusyWhile:[700 factorial]"
! !