View.st
changeset 36 b297468551c6
parent 33 d2408af7851d
child 41 08a32edcaaa0
--- 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]"
+! !