--- a/View.st Thu Jun 02 23:21:42 1994 +0200
+++ b/View.st Fri Jun 03 02:54:39 1994 +0200
@@ -32,9 +32,10 @@
classVariableNames: 'Grey ZeroPoint CentPoint
ViewSpacing DefaultStyle
StyleSheet
- DefaultViewBackgroundColor DefaultBorderColor
+ DefaultViewBackgroundColor DefaultBorderColor
DefaultLightColor DefaultShadowColor
- DefaultHalfShadowColor DefaultHalfLightColor'
+ DefaultHalfShadowColor DefaultHalfLightColor
+ DefaultBorderWidth'
poolDictionaries: ''
category:'Views-Basic'
!
@@ -42,15 +43,8 @@
View class instanceVariableNames:'ClassResources'!
View comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-
-$Header: /cvs/stx/stx/libview/View.st,v 1.15 1994-04-30 15:37:57 claus Exp $
-
-written spring/summer 89 by claus
-3D effects summer 90 by claus
-MVC, viewport and window stuff summer 92 by claus (for ST-80 compatibility)
'!
"this flag controls (globally) how views look"
@@ -59,6 +53,26 @@
!View class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libview/View.st,v 1.16 1994-06-03 00:53:52 claus Exp $
+"
+!
+
documentation
"
this class implements functions common to all Views.
@@ -144,9 +158,11 @@
"set the default view style"
aStyle ~~ DefaultStyle ifTrue:[
+ Grey := nil.
DefaultStyle := aStyle.
StyleSheet := ResourcePack fromFile:('s_' , aStyle , '.rs').
ResourcePack flushResources.
+ DefaultViewBackgroundColor := nil. "to force redefinition"
View withAllSubclasses do:[:aClass |
aClass updateClassResources
]
@@ -388,6 +404,7 @@
|ext|
super initialize.
+
shown := false.
hidden := false.
realized := false.
@@ -438,12 +455,10 @@
initStyle
"this method sets up all style dependent things"
- Grey isNil ifTrue:[
- Grey := resources name:'VIEW_GREY' default:nil.
- Grey isNil ifTrue:[
- Grey := Color grey
- ].
- ].
+ "
+ when coming here the first time, we read the resources
+ and keep them in fast class variables
+ "
DefaultStyle isNil ifTrue:[
DefaultStyle := resources name:'VIEW_STYLE'
default:(View3D ifTrue:[#view3D]
@@ -452,49 +467,65 @@
style := DefaultStyle.
+ Grey isNil ifTrue:[
+ style == #openwin ifTrue:[
+ Grey := Color grey:80. "lightGrey "
+ ].
+ style == #motif ifTrue:[
+ Grey := Color grey:50
+ ].
+ style == #next ifTrue:[
+ Grey := Color grey:67
+ ].
+ style == #iris ifTrue:[
+ Grey := Color grey:67
+ ].
+ Grey isNil ifTrue:[
+ Grey := Color grey
+ ].
+"
+ Grey := resources name:'VIEW_GREY' default:Color grey.
+"
+ Grey := Grey on:Display
+ ].
+
DefaultViewBackgroundColor isNil ifTrue:[
+ DefaultBorderWidth := self is3D ifTrue:[0] ifFalse:[1].
+ DefaultBorderColor := resources name:'VIEW_BORDER_COLOR' default:Black.
+ DefaultShadowColor := resources name:'VIEW_SHADOW_COLOR' default:Black.
(self is3D and:[device hasGreyscales]) ifTrue:[
DefaultViewBackgroundColor := resources name:'VIEW_BACKGROUND' default:Grey.
- DefaultLightColor := resources name:'VIEW_LIGHT_COLOR' default:White.
- DefaultShadowColor := resources name:'VIEW_SHADOW_COLOR' default:Black.
- DefaultHalfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Color darkGrey.
+ style == #motif ifTrue:[
+ DefaultLightColor := resources name:'VIEW_LIGHT_COLOR' default:(Grey lightened) "Color lightGrey"
+ ] ifFalse:[
+ DefaultLightColor := resources name:'VIEW_LIGHT_COLOR' default:White.
+ ].
+ DefaultHalfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Grey darkened "Color darkGrey".
DefaultHalfLightColor := resources name:'VIEW_HLIGHT_COLOR' default:White.
- ] ifFalse:[
+ ] ifFalse:[
DefaultViewBackgroundColor := resources name:'VIEW_BACKGROUND' default:White.
DefaultLightColor := resources name:'VIEW_LIGHT_COLOR' default:Color grey
"or White"
"or Color lightGrey".
"cant say which is better ..."
- DefaultShadowColor := resources name:'VIEW_SHADOW_COLOR' default:Black.
- DefaultHalfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Color grey.
+ DefaultHalfShadowColor := resources name:'VIEW_HSHADOW_COLOR' default:Grey "Color grey".
DefaultHalfLightColor := resources name:'VIEW_HLIGHT_COLOR' default:White.
- ]
- ].
-
- self is3D ifTrue:[
- borderWidth := 0
- ] ifFalse:[
- borderWidth := 1
+ ].
+ DefaultViewBackgroundColor := DefaultViewBackgroundColor on:Display.
+ DefaultLightColor := DefaultLightColor on:Display.
+ DefaultShadowColor := DefaultShadowColor on:Display.
+ DefaultHalfShadowColor := DefaultHalfShadowColor on:Display.
+ DefaultHalfLightColor := DefaultHalfLightColor on:Display.
+ DefaultBorderColor := DefaultBorderColor on:Display.
].
-
- 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 := 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 := resources name:'VIEW_BORDER_COLOR' default:Black.
+ borderWidth := DefaultBorderWidth.
+ viewBackground := DefaultViewBackgroundColor.
+ lightColor := DefaultLightColor.
+ shadowColor := DefaultShadowColor.
+ halfShadowColor := DefaultHalfShadowColor.
+ halfLightColor := DefaultHalfLightColor.
+ borderColor := DefaultBorderColor.
!
initEvents
@@ -562,8 +593,10 @@
|t|
+"
Grey := nil.
"
+"
DefaultStyle := nil.
"
self initStyle.
@@ -575,59 +608,6 @@
self clear.
self redraw
].
-!
-
-recreate
- "recreate (i.e. tell X about me) after a snapin"
-
- drawableId isNil ifTrue:[
- "associate cursor/colors to device"
-
- super recreate.
-
- borderColor notNil ifTrue:[
- borderColor := borderColor on:device.
- ].
- shadowColor notNil ifTrue:[
- shadowColor := shadowColor on:device.
- ].
- lightColor notNil ifTrue:[
- lightColor := lightColor on:device.
- ].
- halfShadowColor notNil ifTrue:[
- halfShadowColor := halfShadowColor on:device.
- ].
- halfLightColor notNil ifTrue:[
- halfLightColor := halfLightColor on:device.
- ].
-
- drawableId := device createWindowFor:self
- left:left top:top
- width:width height:height.
-
- extentChanged := false.
- originChanged := false.
-
- borderShape notNil ifTrue:[
- device setWindowBorderShape:(borderShape id) in:drawableId
- ].
- viewShape notNil ifTrue:[
- device setWindowShape:(viewShape id) in:drawableId
- ].
- (backed notNil and:[backed ~~ false]) ifTrue:[
- device setBackingStore:backed in:drawableId
- ].
- saveUnder ifTrue:[
- device setSaveUnder:saveUnder in:drawableId
- ].
-
- font := font on:device.
-
- "XXX has to be changed: eventmasks are device specific -
- will not allow restart on another Workstation-type"
-
- device setEventMask:eventMask in:drawableId
- ]
! !
!View methodsFor:'accessing-mvc'!
@@ -756,6 +736,46 @@
^ height - (2 * margin)
!
+leftInset:aNumber
+ leftInset := aNumber.
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
+topInset:aNumber
+ topInset := aNumber.
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
+rightInset:aNumber
+ rightInset := aNumber.
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
+bottomInset:aNumber
+ bottomInset := aNumber.
+ "force recomputation"
+ drawableId isNil ifTrue:[
+ originChanged := true
+ ] ifFalse:[
+ self superViewChangedSize
+ ]
+!
+
extent:extent
"set the views extent; extent may be:
a point where integer fields mean pixel-values
@@ -1291,7 +1311,12 @@
is3D
"return true, if my style is some kind of 3D style - will change"
- ^ #(next iris openwin view3D motif) includes:style
+ style == #next ifTrue:[^true].
+ style == #iris ifTrue:[^true].
+ style == #openwin ifTrue:[^true].
+ style == #view3D ifTrue:[^true].
+ style == #motif ifTrue:[^true].
+ ^ false
!
shown
@@ -1545,6 +1570,19 @@
self setParentViewIn:newView.
!
+addSubView:newView before:aView
+ "add a view to the collection of subviews before 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 before:aView.
+ ].
+ self setParentViewIn:newView.
+!
+
addSubView:aView in:bounds borderWidth:bw
"for ST-80 compatibility"
@@ -1965,9 +2003,6 @@
newWidth := corner x - left.
newHeight := corner y - top.
-" old:
- self pixelExtent:(newWidth @ newHeight)
-"
self pixelOrigin:(left @ top) extent:(newWidth @ newHeight)
!
@@ -2104,32 +2139,6 @@
]
!
-XXXpointFromRelativePoint:relativePoint
- "given relative point, compute absolute point (in pixels)"
-
- |newX newY rel inRect|
-
- superView isNil ifTrue:[
- inRect := 0@0 extent:device extent
- ] ifFalse:[
- inRect := superView viewRectangle.
- ].
-
- rel := relativePoint x.
- (rel isMemberOf:Float) ifTrue:[
- newX := (rel * (inRect width + (2 * borderWidth))) asInteger + inRect left
- ] ifFalse:[
- newX := rel
- ].
- rel := relativePoint y.
- (rel isMemberOf:Float) ifTrue:[
- newY := (rel * (inRect height + (2 * borderWidth))) asInteger + inRect top
- ] ifFalse:[
- newY := rel
- ].
- ^ (newX @ newY)
-!
-
originFromRelativeOrigin
"compute pixel origin from relativeOrigin"
@@ -2207,6 +2216,12 @@
newY := rel
].
+ (rightInset notNil and:[rightInset ~~ 0]) ifTrue:[
+ newX := newX - rightInset
+ ].
+ (bottomInset notNil and:[bottomInset ~~ 0]) ifTrue:[
+ newY := newY - bottomInset
+ ].
^ newX @ newY
!
@@ -2243,6 +2258,12 @@
newY := rel
].
+ (rightInset notNil and:[rightInset ~~ 0]) ifTrue:[
+ newX := newX - rightInset
+ ].
+ (bottomInset notNil and:[bottomInset ~~ 0]) ifTrue:[
+ newY := newY - bottomInset
+ ].
^ newX @ newY
!
@@ -2277,12 +2298,12 @@
relH := (viewport height / winH) asFloat.
relX := (viewport left / winW) asFloat.
relY := (viewport top / winH) asFloat.
- "bad coding style ..."
+ "bad coding style ... misuse other method"
relativeOrigin := (relX @ relY).
org := self originFromRelativeOrigin.
relativeOrigin := nil.
- "bad coding style ..."
+ "bad coding style ...misuse other method"
relativeExtent := (relW @ relH).
ext := self extentFromRelativeExtent.
relativeExtent := nil.
@@ -2292,6 +2313,8 @@
!
computeInnerClip
+ "compute, but do not set the inside clip-area"
+
|m2|
(margin ~~ 0) ifTrue:[
@@ -2307,95 +2330,127 @@
!
setInnerClip
+ "compute, and set the inside clip-area"
+
self computeInnerClip.
-"
- |m2|
-
- (margin ~~ 0) ifTrue:[
- m2 := margin + margin.
- innerClipRect := Rectangle
- left:margin
- top:margin
- width:(width - m2)
- height:(height - m2)
- ] ifFalse:[
- innerClipRect := nil
- ].
-"
self clipRect:innerClipRect
! !
!View methodsFor:'realization'!
+physicalCreate
+ "common code for create & recreate"
+
+ "associate colors to device"
+
+ borderColor notNil ifTrue:[
+ borderColor := borderColor on:device.
+ ].
+"/
+"/ not needed - will be done with 1st draw operation
+"/
+"/ shadowColor notNil ifTrue:[
+"/ shadowColor := shadowColor on:device.
+"/ ].
+"/ lightColor notNil ifTrue:[
+"/ lightColor := lightColor on:device.
+"/ ].
+"/ halfShadowColor notNil ifTrue:[
+"/ halfShadowColor := halfShadowColor on:device.
+"/ ].
+"/ halfLightColor notNil ifTrue:[
+"/ halfLightColor := halfLightColor on:device.
+"/ ].
+
+ drawableId := device
+ createWindowFor:self
+ origin:(left @ top)
+ extent:(width @ height)
+ minExtent:nil
+ maxExtent:nil
+ borderWidth:borderWidth
+ borderColor:borderColor
+ subViewOf:superView
+ onTop:(self createOnTop)
+ inputOnly:(self inputOnly)
+ label:nil
+ cursor:cursor
+ icon:nil
+ iconView:nil.
+
+ extentChanged := false.
+ originChanged := false.
+
+ borderShape notNil ifTrue:[
+ device setWindowBorderShape:(borderShape id) in:drawableId
+ ].
+ viewShape notNil ifTrue:[
+ device setWindowShape:(viewShape id) in:drawableId
+ ].
+ (backed notNil and:[backed ~~ false]) ifTrue:[
+ device setBackingStore:backed in:drawableId
+ ].
+ saveUnder ifTrue:[
+ device setSaveUnder:true in:drawableId
+ ].
+"/ font := font on:device.
+!
+
create
"create (i.e. tell X about me)
this is kind of stupid - creation means XCreateWindow;
realizing means XMapWindow"
drawableId isNil ifTrue:[
- "make certain, superview is created also"
-
+ "
+ make certain that superview is created also
+ "
superView notNil ifTrue:[
- superView id isNil ifTrue:[
- superView create
- ].
-
- "and put my controller into the superviews controller list"
- controller notNil ifTrue:[
- superView controller notNil ifTrue:[
- controller manager:(superView controller manager)
- ]
- ]
+"/ superView id isNil ifTrue:[
+ superView create.
+"/ ].
+
+"/ "and put my controller into the superviews controller list"
+"/ controller notNil ifTrue:[
+"/ superView controller notNil ifTrue:[
+"/ controller manager:(superView controller manager)
+"/ ]
+"/ ]
].
- "associate cursor/colors to device"
-
-"
- viewBackground notNil ifTrue:[
- viewBackground := viewBackground on:device.
- ].
-"
- borderColor notNil ifTrue:[
- borderColor := borderColor on:device.
- ].
- shadowColor notNil ifTrue:[
- shadowColor := shadowColor on:device.
- ].
- lightColor notNil ifTrue:[
- lightColor := lightColor on:device.
- ].
cursor := cursor on:device.
- drawableId := device createWindowFor:self
- left:left top:top
- width:width height:height.
-
- extentChanged := false.
- originChanged := false.
+ self physicalCreate.
viewBackground notNil ifTrue:[
self setViewBackground
].
- borderShape notNil ifTrue:[
- device setWindowBorderShape:(borderShape id) in:drawableId
- ].
- viewShape notNil ifTrue:[
- device setWindowShape:(viewShape id) in:drawableId
- ].
- (backed notNil and:[backed ~~ false]) ifTrue:[
- device setBackingStore:backed in:drawableId
- ].
- saveUnder ifTrue:[
- device setSaveUnder:true in:drawableId
- ].
-
- font := font on:device.
self initializeMiddleButtonMenu.
self initEvents.
]
!
+recreate
+ "recreate (i.e. tell X about me) after a snapin"
+
+ drawableId isNil ifTrue:[
+ super recreate.
+ self physicalCreate.
+
+ viewBackground notNil ifTrue:[
+ self setViewBackground
+ ].
+
+ "
+ XXX has to be changed: eventmasks are device specific -
+ XXX will not allow restart on another Workstation-type.
+ XXX event masks must become symbolic
+ "
+ device setEventMask:eventMask in:drawableId
+ ]
+!
+
createWithAllSubViews
"create, then create all subviews"
@@ -2455,9 +2510,7 @@
"put myself into superviews windowgroup"
superView notNil ifTrue:[
windowGroup notNil ifTrue:[
-"
- 'oops - wgroup change on realize' printNewline.
-"
+"/ 'oops - wgroup change on realize' printNewline.
windowGroup removeView:self
].
windowGroup := superView windowGroup.
@@ -2513,7 +2566,7 @@
controller := nil.
subViews notNil ifTrue:[
- "stupid: destroy removes itself from the subveiws list
+ "stupid: destroy removes itself from the subview list
- therefore we have to loop over a copy here"
subViews copy do:[:aView |
@@ -2544,6 +2597,16 @@
!
open
+ "open up the view - for normal views, this is a modeless open
+ (i.e. the new view comes up as independent process).
+ This is redefined in ModalBox, which comes up modal (i.e.
+ control is under the current process, so that interaction with the
+ current group is blocked while the modalBox is active)."
+
+ ^ self openModeless
+!
+
+openModeless
"create and schedule a new windowgroup for me and open the view.
The view will be handled by its own process, effectively running in
parallel."
@@ -2570,13 +2633,15 @@
"create a new windowgroup, but start processing in the current process
actually suspending event processing for the currently active group.
Stay in modalloop while aBlock evaluates to true and the view is
- visible."
+ visible.
+ This makes any interaction with the current window
+ impossible - however, others still work."
ProcessorScheduler isPureEventDriven ifFalse:[
- windowGroup isNil ifTrue:[
+"/ windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
- ].
+"/ ].
self realize.
windowGroup eventLoopWhile:[realized and:aBlock]
] ifTrue:[
@@ -2801,7 +2866,7 @@
redrawEdges
"redraw my edges if 3D"
- self is3D ifTrue:[
+" self is3D ifTrue:[ "
(level ~~ 0) ifTrue:[
self clipRect:nil.
self drawEdgesForX:0 y:0
@@ -2809,7 +2874,7 @@
level:level.
self clipRect:innerClipRect
]
- ]
+" ] "
!
redraw
@@ -2883,7 +2948,7 @@
transformation := nil. "transformation becomes void"
subViews notNil ifTrue:[
- (how == #smaller) ifTrue:[
+ (how isNil or:[how == #smaller]) ifTrue:[
subViews do:[:view |
view superViewChangedSize
]
@@ -2922,7 +2987,6 @@
winSuper := 0@0 extent:(superView width@superView height)
].
-
superWidth := superView width.
superHeight := superView height.
superWinWidth := winSuper width.
@@ -2940,13 +3004,7 @@
newOrg := originRule value
] ifFalse:[
(relativeOrigin notNil) ifTrue:[
- "self originFromRelativeOrigin "
newOrg := self originFromRelativeOrigin.
-"
- borderWidth ~~ 0 ifTrue:[
- newOrg := newOrg - (borderWidth @ borderWidth)
- ]
-"
]
].
@@ -3025,7 +3083,7 @@
how := #smaller
].
- self is3D ifTrue:[
+ level ~~ 0 "self is3D" ifTrue:[
mustRedrawBottomEdge := newHeight < height.
mustRedrawRightEdge := newWidth < width.
anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
@@ -3174,19 +3232,21 @@
|menu menuSelector|
- (button == 2) ifTrue:[
- "try ST-80 style menus first"
- model notNil ifTrue:[
- menuSymbol notNil ifTrue:[
- menu := model perform:menuSymbol.
- menu notNil ifTrue:[
- menuSelector := menu startUp.
- menuSelector ~~ 0 ifTrue:[
- model perform:menuSelector
- ]
- ].
- ^ self
- ]
+ ((button == 2) or:[button == #menu]) ifTrue:[
+ "
+ try ST-80 style menus first:
+ if there is a model, and a menuSymbol is defined,
+ ask model for the menu and launch that if non-nil.
+ "
+ (model notNil and:[menuSymbol notNil]) ifTrue:[
+ menu := model perform:menuSymbol.
+ menu notNil ifTrue:[
+ menuSelector := menu startUp.
+ menuSelector ~~ 0 ifTrue:[
+ model perform:menuSelector
+ ]
+ ].
+ ^ self
]
].
super buttonPress:button x:x y:y