--- a/View.st Fri Feb 25 14:13:21 1994 +0100
+++ b/View.st Fri Feb 25 14:14:52 1994 +0100
@@ -42,7 +42,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/View.st,v 1.12 1994-01-17 13:45:54 claus Exp $
+$Header: /cvs/stx/stx/libview/View.st,v 1.13 1994-02-25 13:14:38 claus Exp $
written spring/summer 89 by claus
3D effects summer 90 by claus
@@ -365,7 +365,7 @@
locals - and not forget the others.
View setup is separated into two parts, the general setup done here
and the style specific setup in initStyle. Each view should be prepared
- for a style change by beeing sent another initStyle with a new style value"
+ for a style change by being sent another initStyle with a new style value"
|ext|
@@ -436,22 +436,23 @@
].
(self is3D and:[device hasGreyscales]) ifTrue:[
- viewBackground := Grey.
- lightColor := White.
- shadowColor := Black.
- halfShadowColor := Color darkGrey.
- halfLightColor := White.
+ viewBackground := resources name:'VIEW_BACKGROUND' default:Grey.
+ lightColor := resources name:'VIEW_LIGHT_COLOR' default:White.
+ shadowColor := resources name:'VIEW_SHADOW_COLOR' default:Black.
+ halfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Color darkGrey.
+ halfLightColor := resources name:'VIEW_HLIGHT_COLOR' default:White.
] ifFalse:[
- viewBackground := White.
- lightColor := Color grey
- "or White"
- "or Color lightGrey". "cant say which is better ..."
- shadowColor := Black.
- halfShadowColor := Color grey.
- halfLightColor := White.
+ viewBackground := resources name:'VIEW_BACKGROUND' default:White.
+ lightColor := resources name:'VIEW_LIGHT_COLOR' default:Color grey
+ "or White"
+ "or Color lightGrey".
+ "cant say which is better ..."
+ shadowColor := resources name:'VIEW_SHADOW_COLOR' default:Black.
+ halfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Color grey.
+ halfLightColor := resources name:'VIEW_HLIGHT_COLOR' default:White.
].
- borderColor := Black.
+ borderColor := resources name:'VIEW_BORDER_COLOR' default:Black.
!
initEvents
@@ -1169,6 +1170,17 @@
view superView:self
]
]
+!
+
+withAllSubViewsDo:aBlock
+ "evaluate aBlock for all subviews (recursively)"
+
+ aBlock value:self.
+ (subViews isNil or:[subViews isEmpty]) ifFalse:[
+ subViews do:[:aSubview |
+ aSubview withAllSubviewsDo:aBlock
+ ]
+ ]
! !
!View methodsFor:'accessing-misc'!
@@ -1437,13 +1449,9 @@
components remove:aComponent ifAbsent:[]
!
-addSubView:aView
- "add a view to the collection of subviews"
-
- subViews isNil ifTrue:[
- subViews := OrderedCollection new
- ].
- subViews add:aView.
+setParentViewIn:aView
+ "common code for addSubView* methods"
+
aView superView:self.
(aView device ~~ device) ifTrue:[
'warning subview (' print. aView class name print.
@@ -1453,7 +1461,33 @@
]
!
+addSubView:newView
+ "add a view to the collection of subviews"
+
+ subViews isNil ifTrue:[
+ subViews := OrderedCollection with:newView
+ ] ifFalse:[
+ subViews add:newView.
+ ].
+ self setParentViewIn:newView.
+!
+
+addSubView:newView after:aView
+ "add a view to the collection of subviews after another view.
+ This makes sense, in Panels and other layout views, to enter a new
+ element at some defined place."
+
+ subViews isNil ifTrue:[
+ subViews := OrderedCollection with:newView
+ ] ifFalse:[
+ subViews add:newView after:aView.
+ ].
+ self setParentViewIn:newView.
+!
+
addSubView:aView in:bounds borderWidth:bw
+ "for ST-80 compatibility"
+
aView borderWidth:bw.
aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
@@ -1461,6 +1495,8 @@
!
add:aView in:bounds
+ "for ST-80 compatibility"
+
aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
self addSubView:aView
@@ -3135,3 +3171,54 @@
].
super buttonPress:button x:x y:y
! !
+
+!View methodsFor:'cursor animation'!
+
+showBusyWhile:aBlock
+ "evaluate some time consuming block, while doing this,
+ show a spinning wheel cursor"
+
+ |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.
+
+ ok ifFalse:[
+ self cursor:Cursor wait.
+ aBlock value.
+ ] ifTrue:[
+ cursors := bitmaps collect:[:form | (Cursor sourceForm:form
+ maskForm:mask
+ hotX:8
+ hotY:8) on:device].
+
+ process := [
+ (Delay forSeconds:0.25) wait.
+ [true] whileTrue:[
+ cursors do:[:curs |
+ self cursor:curs.
+ (Delay forSeconds:0.05) wait
+ ]
+ ]
+ ] fork.
+
+ Processor activeProcess priority:7.
+ aBlock value.
+ Processor activeProcess priority:8.
+ process terminate.
+ ].
+ self cursor:oldCursor
+
+ "View new realize showSpinningWheelWhile:[500 factorial]"
+! !