"
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.
"
PseudoView subclass:#View
instanceVariableNames:'superView subViews
components style resources
transformation viewport
borderColor borderWidth borderShape viewShape
top left
extentChanged originChanged cornerChanged
relativeOrigin relativeExtent relativeCorner
originRule extentRule cornerRule
topInset leftInset bottomInset rightInset
shown hidden name
level softEdge margin innerClipRect
shadowColor lightColor
halfShadowColor halfLightColor
viewOrigin
contentsChangeAction originChangeAction
bitGravity viewGravity
keyboardHandler model controller windowGroup
aspectSymbol changeSymbol menuSymbol'
classVariableNames: 'Grey ZeroPoint CentPoint
ViewSpacing DefaultStyle'
poolDictionaries: ''
category:'Views-Basic'
!
View class instanceVariableNames:'ClassResources'!
View comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/View.st,v 1.8 1993-12-20 17:29:02 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"
Smalltalk at:#View3D put:false!
!View class methodsFor:'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
"
! !
!View class methodsFor:'initialization'!
initialize
"Workstation initialize."
super initialize.
Form initialize.
Color initialize.
! !
!View class methodsFor:'defaults'!
defaultExtent
"define the default extent"
CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
^ CentPoint
!
defaultStyle
"return the default view style"
^ DefaultStyle
"View defaultStyle"
!
defaultStyle:aStyle
"set the default view style"
DefaultStyle := aStyle
"View defaultStyle:#next"
!
classResources
"if not already loaded, get the classes resourcePack
and return it"
ClassResources isNil ifTrue:[
ClassResources := ResourcePack for:self.
].
^ ClassResources
! !
!View class methodsFor:'instance creation'!
in:aView
"return a new view as a subview of aView"
|newView|
newView := self basicNew.
newView device:(aView device).
newView superView:(aView).
newView initialize.
aView addSubView:newView.
^ newView
!
extent:extent in:aView
"create a new view as a subview of aView with given extent"
^ self origin:nil extent:extent borderWidth:nil
font:nil label:nil in:aView
!
origin:origin in:aView
"create a new view as a subview of aView with given origin"
^ self origin:origin extent:nil borderWidth:nil
font:nil label:nil in:aView
!
extent:extent
"create a new view with given extent"
^ self origin:nil extent:extent borderWidth:nil
font:nil label:nil in:nil
!
origin:origin extent:extent
"create a new view with given origin and extent"
^ self origin:origin extent:extent borderWidth:nil
font:nil label:nil in:nil
!
origin:origin extent:extent in:aView
"create a new view as a subview of aView with given origin and extent"
^ self origin:origin extent:extent borderWidth:nil
font:nil label:nil in:aView
!
origin:origin extent:extent borderWidth:bw in:aView
"create a new view as a subview of aView with given origin, extent
and borderWidth"
^ self origin:origin extent:extent borderWidth:bw
font:nil label:nil in:aView
!
origin:origin extent:extent borderWidth:bw
"create a new view with given origin, extent and borderWidth"
^ self origin:origin extent:extent borderWidth:bw
font:nil label:nil in:nil
!
label:label
"create a new view with given label"
^ self origin:nil extent:nil borderWidth:nil
font:nil label:label in:nil
!
label:label in:aView
"create a new view as subview of aView with given label"
^ self origin:nil extent:nil borderWidth:nil
font:nil label:label in:aView
!
extent:extent label:label
"create a new view with given extent and label"
^ self origin:nil extent:extent borderWidth:nil
font:nil label:label in:nil
!
origin:origin extent:extent label:label
"create a new view with given origin, extent and label"
^ self origin:origin extent:extent borderWidth:nil
font:nil label:label in:nil
!
origin:origin extent:extent font:aFont label:label
^ self origin:origin extent:extent borderWidth:nil
font:nil label:label in:nil
!
origin:origin extent:extent font:aFont label:label in:aView
^ self origin:origin extent:extent borderWidth:nil
font:aFont label:label in:aView
!
origin:anOrigin extent:anExtent
label:aLabel icon:aForm
minExtent:minExtent maxExtent:maxExtent
|newView|
newView := self on:Display.
anOrigin notNil ifTrue:[newView origin:anOrigin].
anExtent notNil ifTrue:[newView extent:anExtent].
aLabel notNil ifTrue:[newView label:aLabel].
aForm notNil ifTrue:[newView icon:aForm].
minExtent notNil ifTrue:[newView minExtent:minExtent].
maxExtent notNil ifTrue:[newView maxExtent:maxExtent].
^ newView
!
origin:anOrigin extent:anExtent borderWidth:bw
font:aFont label:aLabel in:aView
|newView|
aView notNil ifTrue:[
newView := self basicNew.
newView device:(aView device).
aView addSubView:newView.
newView initialize
] ifFalse:[
newView := self on:Display
].
bw notNil ifTrue:[newView borderWidth:bw].
anExtent notNil ifTrue:[newView extent:anExtent].
anOrigin notNil ifTrue:[newView origin:anOrigin].
aFont notNil ifTrue:[newView font:aFont].
aLabel notNil ifTrue:[newView label:aLabel].
^ newView
!
origin:origin corner:corner
"create a new view with given origin and extent"
^ self origin:origin corner:corner borderWidth:nil
font:nil label:nil in:nil
!
origin:origin corner:corner in:aView
"create a new view as a subview of aView with given origin and extent"
^ self origin:origin corner:corner borderWidth:nil
font:nil label:nil in:aView
!
origin:origin corner:corner borderWidth:bw in:aView
"create a new view as a subview of aView with given origin and extent"
^ self origin:origin corner:corner borderWidth:bw
font:nil label:nil in:aView
!
origin:anOrigin corner:aCorner borderWidth:bw
font:aFont label:aLabel in:aView
|newView|
aView notNil ifTrue:[
newView := self basicNew.
newView device:(aView device).
aView addSubView:newView.
newView initialize
] ifFalse:[
newView := self on:Display
].
bw notNil ifTrue:[newView borderWidth:bw].
anOrigin notNil ifTrue:[newView origin:anOrigin].
aCorner notNil ifTrue:[newView corner:aCorner].
aFont notNil ifTrue:[newView font:aFont].
aLabel notNil ifTrue:[newView label:aLabel].
^ newView
!
on:anObject aspect:aspectMsg change:changeMsg menu:menuMsg
^ self new on:anObject
aspect:aspectMsg
change:changeMsg
menu:menuMsg
!
model:aModel
^ self new model:aModel
! !
!View methodsFor:'initialization'!
initialize
"initialize all state of the view - usually redefined in subclasses,
but always doing a 'super initialize'. Each class should setup its
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"
|ext|
super initialize.
shown := false.
hidden := false.
realized := false.
"fill in some defaults - some of them are usually redefined in subclasses
initialize methods"
name := self class name.
ext := self class defaultExtent.
level := 0.
margin := 0.
softEdge := false.
resources := self class classResources.
self initStyle.
left := 0.
top := 0.
width := ext x.
height := ext y.
ZeroPoint isNil ifTrue:[ZeroPoint := 0 @ 0].
viewOrigin := ZeroPoint.
ViewSpacing isNil ifTrue:[
ViewSpacing := Display verticalPixelPerMillimeter rounded
].
originChanged := false.
extentChanged := false.
bitGravity := nil.
viewGravity := nil.
"
controller := self defaultController new.
controller view:self.
"
!
defaultController
^ Controller
!
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
].
].
DefaultStyle isNil ifTrue:[
DefaultStyle := resources name:'VIEW_STYLE'
default:(View3D ifTrue:[#view3D]
ifFalse:[#normal])
].
style := DefaultStyle.
self is3D ifTrue:[
borderWidth := 0
] ifFalse:[
borderWidth := 1
].
(self is3D and:[device hasGreyscales]) ifTrue:[
viewBackground := Grey.
lightColor := White.
shadowColor := Black.
halfShadowColor := Color darkGrey.
halfLightColor := White.
] ifFalse:[
viewBackground := White.
lightColor := Color grey
"or White"
"or Color lightGrey". "cant say which is better ..."
shadowColor := Black.
halfShadowColor := Color grey.
halfLightColor := White.
].
borderColor := Black.
!
initEvents
"will be sent by create - can be redefined by subclasses to enable
view events"
^ self
!
prepareForReinit
super prepareForReinit.
windowGroup notNil ifTrue:[
windowGroup reinitialize
]
!
reinitialize
"this is called right after snapIn"
|myController|
"if I have already been reinited - return"
drawableId notNil ifTrue:[
^ self
].
myController := controller.
controller := nil.
self recreate.
"if I was mapped, do it again"
realized ifTrue:[
"if it was iconified, try to remap iconified"
shown ifFalse:[
device mapWindow:drawableId iconified:true
atX:left y:top
width:width height:height
] ifTrue:[
device mapWindow:drawableId iconified:false
atX:left y:top
width:width height:height
].
"and restart the window-group process"
windowGroup notNil ifTrue:[
windowGroup startup
]
].
"restore controller"
controller := myController
!
reinitStyle
"this method is called for a style change"
|t|
Grey := nil.
DefaultStyle := nil.
self initStyle.
drawableId notNil ifTrue:[
"force a change"
t := borderWidth. borderWidth := nil. self borderWidth:t.
t := viewBackground. viewBackground := nil. self viewBackground:t.
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'!
windowGroup
"return the window group. For old style views, return nil"
^ windowGroup
!
controller
"return the controller. For non MVC views, return nil"
^ controller
!
controller:aController
"set the controller"
controller := aController.
controller view:self.
controller model:model
!
model
"return the model, for non-MVC views,
this is usually the receiver"
^ model
!
model:aModel
"set the model"
model notNil ifTrue:[
model removeDependent:self
].
model := aModel.
model notNil ifTrue:[
aModel addDependent:self
].
controller notNil ifTrue:[
controller model:aModel
]
!
on: anObject aspect: aspectMsg change: changeMsg menu: menuMsg
"ST-80 compatibility: set model, aspect, change and menu
messages - needs a view which uses these"
self model:anObject.
self aspect:aspectMsg.
self change:changeMsg.
self menu:menuMsg
!
aspect:aspectMsg
aspectSymbol := aspectMsg
!
change:changeMsg
changeSymbol := changeMsg
!
menu:menuMsg
menuSymbol := menuMsg
!
heightOfContents
"return the height of the contents in pixels
- defaults to views visible area here"
^ self innerHeight
!
widthOfContents
"return the width of the contents in pixels
- defaults to views visible area here"
^ self innerWidth
! !
!View methodsFor:'accessing-dimensions'!
left:aNumber
"set the x position"
self origin:(aNumber @ top)
!
top:aNumber
"set the y position"
self origin:(left @ aNumber)
!
width:aNumber
"set the views width in pixels"
self extent:(aNumber @ height)
!
height:aNumber
"set the views height in pixels"
self extent:(width @ aNumber)
!
innerWidth
"return the width of the view minus any shadow-borders"
(level == 0) ifTrue:[^ width].
^ width - (2 * margin)
!
innerHeight
"return the height of the view minus any shadow-borders"
(margin == 0) ifTrue:[^ height].
^ height - (2 * margin)
!
extent:extent
"set the views extent; extent may be:
a point where integer fields mean pixel-values
and float values mean relative-to-superview;
or a block returning a point"
|w h e|
extent isBlock ifTrue:[
extentRule := extent.
"shown " drawableId notNil " " ifTrue:[ "23-feb-93"
self pixelExtent:(extent value)
] ifFalse:[
extentChanged := true
]
] ifFalse:[
w := extent x.
h := extent y.
((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[
relativeExtent := extent.
e := self extentFromRelativeExtent.
e isNil ifTrue:[
extentChanged := true
] ifFalse:[
self pixelExtent:e
]
] ifFalse:[
self pixelExtent:extent
]
]
!
origin:origin
"set the views origin; origin may be:
a point where integer fields mean pixel-values
and float values mean relative-to-superview;
or a block returning a point"
|newLeft newTop o|
origin isBlock ifTrue:[
originRule := origin.
drawableId notNil ifTrue:[
self pixelOrigin:(origin value)
] ifFalse:[
originChanged := true
]
] ifFalse:[
newLeft := origin x.
newTop := origin y.
((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[
relativeOrigin := origin.
o := self originFromRelativeOrigin.
o isNil ifTrue:[
originChanged := true
] ifFalse:[
self pixelOrigin:o
]
] ifFalse:[
self pixelOrigin:origin
]
]
!
origin:origin corner:corner
"set both origin and extent"
|newLeft newTop newRight newBot|
"do it as one operation if possible"
origin isBlock ifFalse:[
corner isBlock ifFalse:[
newLeft := origin x.
(newLeft isMemberOf:Float) ifFalse:[
newTop := origin y.
(newTop isMemberOf:Float) ifFalse:[
newRight := corner x.
(newRight isMemberOf:Float) ifFalse:[
newBot := corner y.
(newBot isMemberOf:Float) ifFalse:[
self pixelOrigin:origin corner:corner
]
]
]
]
]
].
self origin:origin.
self corner:corner
!
origin:origin extent:extent
"set both origin and extent"
|newLeft newTop newWidth newHeight|
"do it as one operation if possible"
origin isBlock ifFalse:[
extent isBlock ifFalse:[
newLeft := origin x.
(newLeft isMemberOf:Float) ifFalse:[
newTop := origin y.
(newTop isMemberOf:Float) ifFalse:[
newWidth := extent x.
(newWidth isMemberOf:Float) ifFalse:[
newHeight := extent y.
(newHeight isMemberOf:Float) ifFalse:[
self pixelOrigin:origin extent:extent
]
]
]
]
]
].
self extent:extent.
self origin:origin
!
left:newLeft top:newTop width:newWidth height:newHeight
"another way of specifying origin and extent"
self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
!
relativeOrigin
"return the relative origin or nil"
^ relativeOrigin
!
relativeCorner
"return the relative corner or nil"
^ relativeCorner
!
relativeExtent
"return the relative extent or nil"
^ relativeExtent
!
relativeOrigin:aPoint
"set the relative origin"
relativeOrigin := aPoint
!
relativeCorner:aPoint
"set the relative corner"
relativeCorner := aPoint
!
relativeExtent:aPoint
"set the relative extent"
relativeExtent := aPoint
!
center:newCenter
"move the receiver so that newCenter, aPoint becomes the center point"
self origin:(newCenter - ((width // 2) @ (height // 2)))
!
center
"return the point at the center of the receiver"
^ (left + (width // 2)) @ (top + (height // 2))
!
origin
"return the origin (in pixels)"
^ left@top
!
originRelativeTo:aView
"return the origin (in pixels) relative to a superView"
|currentView
org "{ Class: Point }"
sumX "{ Class: SmallInteger }"
sumY "{ Class: SmallInteger }" |
currentView := self.
sumX := 0.
sumY := 0.
[currentView notNil] whileTrue:[
(currentView == aView) ifTrue:[
^ (sumX @ sumY)
].
org := currentView origin.
sumX := sumX + org x.
sumY := sumY + org y.
currentView := currentView superView
].
^ nil
!
left
"return the x position of the left border"
^ left
!
right
"return the x position of the right border"
^ left + width - 1
!
top
"return the y position of the top border"
^ top
!
bottom
"return the y position of the bottom border"
^ top + height - 1
!
corner
"return the lower right corner-point"
^ (left + width - 1) @ (top + height - 1)
!
corner:corner
"set the views corner; corner may be:
a point where integer fields mean pixel-values
and float values mean relative-to-superview;
or a block returning a point"
|x y c|
corner isBlock ifTrue:[
cornerRule := corner.
drawableId notNil ifTrue:[
self pixelCorner:(corner value)
] ifFalse:[
extentChanged := true
]
] ifFalse:[
x := corner x.
y := corner y.
((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[
relativeCorner := corner.
c := self cornerFromRelativeCorner.
c isNil ifTrue:[
extentChanged := true
] ifFalse:[
self pixelCorner:c
]
] ifFalse:[
self pixelCorner:corner
]
]
! !
!View methodsFor:'accessing-transformation'!
window
^ window
!
window:aRectangle
window := aRectangle.
subViews notNil ifTrue:[
subViews do:[:s |
s superViewChangedSize
]
]
"
viewport isNil ifTrue:[
viewport := aRectangle.
].
"
"
superView notNil ifTrue:[
self superViewChangedSize
] ifFalse:[
originChanged := true.
extentChanged := true
]
"
!
window:aRectangle viewport:vRect
window := aRectangle.
self viewport:vRect.
subViews notNil ifTrue:[
subViews do:[:s |
s superViewChangedSize
]
]
!
transformation
transformation isNil ifTrue:[
superView isNil ifTrue:[
transformation := WindowingTransformation window:window
viewport:(0@0 extent:self extent)
] ifFalse:[
window isNil ifTrue:[
window := (0 @ 0) corner:(1 @ 1)
].
transformation := WindowingTransformation window:window
viewport:(self origin extent:self extent)
]
].
^ transformation
!
displayTransformation
"ST-80 compatibility - ST/X does not draw onto the display"
^ self transformation
!
displayTransform:aPoint
"given a point in window coordinate, make pixel coordinate"
|nx ny|
nx := aPoint x - window left * width / window width.
ny := aPoint y - window top * height / window height.
^ nx @ ny
!
inverseDisplayTransform:aPoint
"given a pixel coordinate, make window coordinate"
|nx ny|
window isNil ifTrue:[^ aPoint].
nx := aPoint x * window width / width + window left.
ny := aPoint y * window height / height + window top.
^ nx @ ny
!
viewport:aRectangle
"define my extend in my superviews coordinate-system."
|relW relH relX relY winW winH|
viewport := aRectangle.
self dimensionFromViewport
"
superView notNil ifTrue:[
superView window isNil ifTrue:[
winW := 1.
winH := 1
] ifFalse:[
winW := superView window width.
winH := superView window height
].
relW := (aRectangle width / winW) asFloat.
relH := (aRectangle height / winH) asFloat.
relX := (aRectangle left / winW) asFloat.
relY := (aRectangle top / winH) asFloat.
self origin:(relX @ relY) extent:(relW @ relH)
]
"
!
viewRectangle
"return the inside area"
|m2|
innerClipRect notNil ifTrue:[
^ innerClipRect
].
m2 := margin + margin.
^ (margin @ margin) extent:((width - m2) @ (height - m2))
!
viewOrigin
"return the viewOrigin; thats the coordinate of the contents
which is shown topLeft in the view
(i.e. the origin of the visible part of the contents)."
^ viewOrigin
!
viewOrigin:aPoint
"set the viewOrigin - i.e. virtually scroll without redrawing"
viewOrigin := aPoint
!
xOriginOfContents
"return the x coordinate of the viewOrigin; used by scrollBars to compute
thumb position"
^ viewOrigin x
!
yOriginOfContents
"return the y coordinate of the viewOrigin; used by scrollBars to compute
thumb position"
^ viewOrigin y
! !
!View methodsFor:'accessing-hierarchy'!
superView
"return my superView"
^ superView
!
superView:aView
"set my superView to be aView"
superView := aView
!
topView
"return the topView - thats the one with no superview"
|v|
v := self.
[v notNil] whileTrue:[
v superView isNil ifTrue:[^ v].
v := v superView
].
^ nil
!
subViews
"return the collection of subviews"
^ subViews
!
subViews:aListOfViews
"set the collection of subviews"
subViews := aListOfViews.
subViews notNil ifTrue:[
subViews do:[:view |
view superView:self
]
]
! !
!View methodsFor:'accessing-misc'!
viewGravity
"return the viewGravity - thats the direction where the view will move
when the superView is resized."
^ viewGravity
!
viewGravity:gravity
"set the viewGravity - thats the direction where the view will move
when the superView is resized."
viewGravity := gravity
!
bitGravity
"return the bitGravity - thats the direction where the contents will move
when the the view is resized."
^ bitGravity
!
inputOnly
"return true, if this view is an input-only view;
input only views are transparent and can be layed on top of a view to
catch its input"
^ false
!
createOnTop
"return true, if this view should be put on top (raised) automatically.
usually this is true for alertBoxes etc."
^ false
!
canDrop:anObjectOrCollection
"return true, if anObjectOrCollection can be
dropped in the receiver. This method should be
redefined in views which can take objects"
^ false
!
is3D
"return true, if my style is some kind of 3D style - will change"
^ #(next iris openwin view3D motif) includes:style
!
shown
"return true if the view is shown; false if hidden"
^ shown
!
isCollapsed
"ST80 compatibility: return true if the view is not shown (i.e. iconified)"
^ shown not
!
hidden:aBoolean
"if the argument is true, the receiver view will not
be realized automatically when superview is realized"
hidden := aBoolean
!
hidden
"return true, if the view does not want to be realized
automatically when superview is realized"
^ hidden
!
lower
"bring to back"
drawableId isNil ifTrue:[self create].
device lowerWindow:drawableId
!
raise
"bring to front"
drawableId isNil ifTrue:[self create].
device raiseWindow:drawableId
! !
!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:[
shadowColor := something darkened.
lightColor := something lightened
]
].
super viewBackground:something
!
borderColor
"return my borderColor"
^ borderColor
!
borderColor:aColor
"set my borderColor"
|id dither|
(aColor ~~ borderColor) ifTrue:[
borderColor := aColor.
drawableId notNil ifTrue:[
borderColor := borderColor on:device.
id := borderColor colorId.
id notNil ifTrue:[
device setWindowBorderColor:id in:drawableId
] ifFalse:[
dither := borderColor ditherForm.
dither notNil ifTrue:[
device setWindowBorderPixmap:(dither id) in:drawableId
] ifFalse:[
'bad borderColor' printNewline
]
]
]
]
!
borderWidth
"return my borderWidth"
^ borderWidth
!
borderWidth:aNumber
"set my borderWidth"
(aNumber ~~ borderWidth) ifTrue:[
borderWidth := aNumber.
drawableId notNil ifTrue:[
device setWindowBorderWidth:aNumber in:drawableId
]
]
!
borderShape:aForm
"set the borderShape to aForm"
borderShape := aForm.
drawableId notNil ifTrue:[
device setWindowBorderShape:(aForm id) in:drawableId
]
!
viewShape:aForm
"set the viewShape to aForm"
viewShape := aForm.
drawableId notNil ifTrue:[
device setWindowShape:(aForm id) in:drawableId
]
!
name
"return my name component to be used for resource-access"
^ name
!
fullName
"return my full name to be used for resource-access"
superView notNil ifTrue:[
^ superView fullName , '.' , name
].
^ name
!
name:aString
"set my name component to be used for resource-access"
name := aString
!
keyboardHandler:someOne
"set my keyboardHandler"
keyboardHandler := someOne
!
level
"return my level relative to superView (3D)"
^ level
!
level:aNumber
"set my level relative to superView (3D)"
|oldMargin how|
self is3D ifTrue:[
(aNumber ~~ level) ifTrue:[
level := aNumber.
oldMargin := margin.
margin := level abs.
realized ifTrue:[
(margin > oldMargin) ifTrue:[
how := #smaller
] ifFalse:[
how := #larger
].
self sizeChanged:how.
self computeInnerClip.
shown ifTrue:[
self redrawEdges
]
]
]
]
!
margin
"return my margin - this is usually the level,
but can be more for some views"
^ margin
!
widthIncludingBorder
"return my width including border"
^ width + (2*borderWidth)
!
heightIncludingBorder
"return my height including border"
^ height + (2*borderWidth)
! !
!View methodsFor:'adding & removing components'!
addComponent:aComponent
components isNil ifTrue:[
components := IdentitySet new
].
components add:aComponent
!
removeComponent:aComponent
components isNil ifTrue:[^self].
components remove:aComponent ifAbsent:[]
!
addSubView:aView
"add a view to the collection of subviews"
subViews isNil ifTrue:[
subViews := OrderedCollection new
].
subViews add:aView.
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.
aView device:device
]
!
addSubView:aView in:bounds borderWidth:bw
aView borderWidth:bw.
aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
self addSubView:aView
!
add:aView in:bounds
aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
self addSubView:aView
!
addSubView:aView viewport:aRectangle
"Adds aView to the views list of subviews and uses the
existing subviews window and the new viewport to position it"
self addSubView:aView.
aView viewport:aRectangle
!
addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
"Adds aView to the views list of subviews and uses
aWindowRectangle and aViewportRectangle to position it"
self addSubView:aView.
aView window:aWindowRectangle.
aView viewport:aViewportRectangle
!
removeSubView:aView
"remove a view from the collection of subviews"
subViews remove:aView ifAbsent:[nil].
(subViews size == 0) ifTrue:[
subViews := nil
]
! !
!View methodsFor:'ST-80 compatibility'!
on:aModel aspect:aspect change:change list:list menu:menu
"ST-80 compatibility"
aspectSymbol := aspect.
changeSymbol := change.
menuSymbol := menu.
self model:aModel
!
sensor
"return the views sensor"
windowGroup notNil ifTrue:[
^ windowGroup sensor.
].
^ nil
!
update
^ self redraw
!
update:aspect
"an update request - should be redefined in subclasses"
^ self update
!
update:aspect with:anObject
"an update request - should be redefined in subclasses"
aspect == #rectangle ifTrue:[
^ self update:#all
].
^ self update:aspect
! !
!View methodsFor:'informing others of changes'!
originWillChange
"this one is sent, just before viewOrigin changes -
gives subclasses a chance to catch scrolls easily
(for example to hide cursor before scroll)"
^ self
!
originChangeAction:aBlock
"set the action, aBlock to be evaluated whenever my orgin changes
- to allow for scrollBars to track contents"
originChangeAction := aBlock
!
originChanged:delta
"this one is sent, after my origin changed -
(for example to redraw cursor)"
originChangeAction notNil ifTrue:[originChangeAction value:self]
!
contentsChangeAction:aBlock
"set the action, aBlock to be evaluated whenever my contents changes
- to allow for scrollBars to track contents"
contentsChangeAction := aBlock
!
contentsChanged
"this one is sent, whenever contents changes size -
gives subclasses a chance to catch it (i.e. scrollbars etc)"
contentsChangeAction notNil ifTrue:[contentsChangeAction value:self]
! !
!View methodsFor:'scrolling'!
widthForScrollBetween:firstLine and:lastLine
"return the width in pixels for a scroll between firstLine and lastLine
- return full width here since we do not know how wide contents is"
^ (width - margin - margin)
!
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
self scrollVerticalTo:
((((self heightOfContents * percent) / 100.0) + 0.5) asInteger)
!
scrollVerticalTo:aPixelOffset
"change origin to make aPixelOffset be the top line"
|orgY|
orgY := viewOrigin y.
(aPixelOffset < orgY) ifTrue:[
self scrollUp:(orgY - aPixelOffset)
] ifFalse:[
(aPixelOffset > orgY) ifTrue:[
self scrollDown:(aPixelOffset - orgY)
]
]
!
scrollHorizontalToPercent:percent
"scroll to a position given in percent of total"
self scrollHorizontalTo:
((((self widthOfContents * percent) / 100.0) + 0.5) asInteger)
!
scrollHorizontalTo:aPixelOffset
"change origin to make aPixelOffset be the left col"
|orgX|
orgX := viewOrigin x.
(aPixelOffset < orgX) ifTrue:[
self scrollLeft:(orgX - aPixelOffset)
] ifFalse:[
(aPixelOffset > orgX) ifTrue:[
self scrollRight:(aPixelOffset - orgX)
]
]
!
scrollTo:aPixelOffset
"only here for historic reasons - will vanish soon"
^ self scrollVerticalTo:aPixelOffset
!
scrollToTop
"move viewOrigin to top"
self scrollVerticalTo:0
!
scrollToTopLeft
"move viewOrigin to top/left"
self scrollVerticalTo:0.
self scrollHorizontalTo:0
!
scrollUp:nPixels
"change origin to scroll up some pixels"
|count "{ Class:SmallInteger }"
m2 "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"|
count := nPixels.
(count > viewOrigin y) ifTrue:[
count := viewOrigin y
].
(count <= 0) ifTrue:[^ self].
self originWillChange.
viewOrigin := viewOrigin x @ (viewOrigin y - count).
(count >= self innerHeight) ifTrue:[
self redraw.
self originChanged:(0 @ count negated)
] ifFalse:[
w := self widthForScrollBetween:(viewOrigin y)
and:(viewOrigin y + count).
m2 := margin * 2.
w := w min:(width - m2).
"
super function:#copy.
super foreground:White.
"
self copyFrom:self x:margin y:margin
toX:margin y:(count + margin)
width:w
height:(height - m2 - count).
self redrawX:margin y:margin
width:(width - m2)
height:count.
self originChanged:(0 @ count negated).
self waitForExpose
]
!
scrollUp
"scroll up by some amount
- question is how much is a good default here"
self scrollUp:(device verticalPixelPerMillimeter * 20) asInteger
!
scrollDown:nPixels
"change origin to scroll down some pixels"
|count "{ Class:SmallInteger }"
m2 "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
hCont "{ Class:SmallInteger }"
ih "{ Class:SmallInteger }"|
count := nPixels.
hCont := self heightOfContents.
ih := self innerHeight.
((viewOrigin y + nPixels + ih) > hCont) ifTrue:[
count := hCont - viewOrigin y - ih
].
(count <= 0) ifTrue:[^ self].
self originWillChange.
viewOrigin := viewOrigin x @ (viewOrigin y + count).
(count >= ih) ifTrue:[
self redraw.
self originChanged:(0 @ count)
] ifFalse:[
m2 := margin * 2.
w := self widthForScrollBetween:(viewOrigin y)
and:(viewOrigin y + count).
w := w min:(width - m2).
"
super function:#copy.
super foreground:White.
"
self copyFrom:self x:margin y:(count + margin)
toX:margin y:margin
width:w
height:(height - m2 - count).
self redrawX:margin y:(height - margin - count)
width:(width - m2) height:count.
self originChanged:(0 @ count).
self waitForExpose
]
!
scrollDown
"scroll down by some amount
- question is how much is a good default here"
self scrollDown:(device verticalPixelPerMillimeter * 20) asInteger
!
scrollLeft:nPixels
"change origin to scroll left some pixels"
|count "{ Class:SmallInteger }"
m2 "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"|
count := nPixels.
(count > viewOrigin x) ifTrue:[
count := viewOrigin x
].
(count <= 0) ifTrue:[^ self].
self originWillChange.
viewOrigin := (viewOrigin x - count) @ viewOrigin y.
(count >= self innerWidth) ifTrue:[
self redraw.
self originChanged:(count negated @ 0)
] ifFalse:[
m2 := margin * 2.
h := (height - m2).
"
super function:#copy.
super foreground:White.
"
self copyFrom:self x:margin y:margin
toX:(count + margin) y:margin
width:(width - m2 - count)
height:h.
self redrawX:margin y:margin
width:count
height:(height - m2).
self originChanged:(count negated @ 0).
self waitForExpose
]
!
scrollLeft
"scroll left by some amount
- question is how much is a good default here"
self scrollLeft:(device horizontalPixelPerMillimeter * 20) asInteger
!
scrollRight:nPixels
"change origin to scroll right some pixels"
|count "{ Class:SmallInteger }"
m2 "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
wCont "{ Class:SmallInteger }"
iw "{ Class:SmallInteger }"|
count := nPixels.
wCont := self widthOfContents.
iw := self innerWidth.
((viewOrigin x + nPixels + iw) > wCont) ifTrue:[
count := wCont - viewOrigin x - iw
].
(count <= 0) ifTrue:[^ self].
self originWillChange.
viewOrigin := (viewOrigin x + count) @ viewOrigin y.
(count >= iw) ifTrue:[
self redraw.
self originChanged:(count @ 0)
] ifFalse:[
m2 := margin * 2.
h := (height - m2).
"
super function:#copy.
super foreground:White.
"
self copyFrom:self x:(count + margin) y:margin
toX:margin y:margin
width:(width - m2 - count)
height:h.
self redrawX:(width - margin - count) y:margin
width:count height:(height - m2).
self originChanged:(count @ 0).
self waitForExpose
]
!
scrollRight
"scroll right by some amount
- question is how much is a good default here"
self scrollRight:(device horizontalPixelPerMillimeter * 20) asInteger
! !
!View methodsFor:'private'!
pixelExtent:extent
"set the views extent in pixels"
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"
|newLeft newTop|
newLeft := origin x.
newTop := origin y.
((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
top := newTop.
left := newLeft.
drawableId notNil ifTrue:[
"have to tell X, when origin of view is changed"
device moveWindow:drawableId x:left y:top
].
realized ifFalse:[
originChanged := true
]
]
!
pixelCorner:corner
"set the views corner in pixels"
|newWidth newHeight|
newWidth := corner x - left.
newHeight := corner y - top.
" old:
self pixelExtent:(newWidth @ newHeight)
"
self pixelOrigin:(left @ top) extent:(newWidth @ newHeight)
!
pixelOrigin:origin corner:corner
"set the views origin and extent in pixels"
|newWidth newHeight|
newWidth := corner x - origin x.
newHeight := corner y - origin y.
self pixelOrigin:origin extent:(newWidth @ newHeight)
!
pixelOrigin:origin extent:extent
"set the views origin and extent in pixels"
|newLeft newTop newWidth newHeight how
mustRedrawBottomEdge mustRedrawRightEdge mustRepaintBottom
mustRepaintRight sameOrigin oldWidth oldHeight|
newLeft := origin x.
newTop := origin y.
sameOrigin := ((newTop == top) and:[newLeft == left]).
newWidth := extent x.
newHeight := extent y.
((newWidth == width) and:[newHeight == height]) ifTrue:[
sameOrigin ifTrue:[^ self].
^ self pixelOrigin:origin
].
top := newTop.
left := newLeft.
mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
((newHeight <= height) and:[newWidth <= width]) ifTrue:[
how := #smaller
].
"shown "drawableId notNil"" ifTrue:[ "23-feb-93"
mustRepaintRight := false.
mustRepaintBottom := false.
(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.
mustRepaintRight := true.
oldWidth := width
].
newHeight > height ifTrue:[
self clipRect:nil.
self paint:viewBackground.
self fillRectangleX:0
y:(height - margin)
width:width
height:margin.
mustRepaintBottom := true.
oldHeight := height
]
].
width := newWidth.
height := newHeight.
self setInnerClip.
"if view becomes smaller, send sizeChanged first"
(how == #smaller) ifTrue:[
self sizeChanged:how
].
"have to tell X, when extent of view is changed"
sameOrigin ifTrue:[
device resizeWindow:drawableId width:width height:height.
] ifFalse:[
"claus: some xservers seem to do better when resizing
first ...."
"
(how == #smaller) ifTrue:[
device resizeWindow:drawableId width:width height:height.
device moveWindow:drawableId x:left y:top
] ifFalse:[
device moveResizeWindow:drawableId x:left y:top width:width height:height
].
"
device moveResizeWindow:drawableId x:left y:top
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
].
mustRepaintRight ifTrue:[
self redrawX:(oldWidth - margin)
y:0
width:margin
height:height.
].
mustRepaintBottom ifTrue:[
self redrawX:0
y:(oldHeight - margin)
width:width
height:margin.
].
] ifFalse:[
"otherwise memorize the need for a sizeChanged message"
width := newWidth.
height := newHeight.
sameOrigin ifFalse:[
originChanged := true.
].
extentChanged := true
]
!
pointFromRelativePoint:relativePoint
"given relative point, compute absolute point (in pixels)"
|newX newY rel inRect|
superView isNil ifTrue:[^ nil].
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"
|newOrigin newX newY rel inRect bw2|
superView isNil ifTrue:[^ nil].
inRect := superView viewRectangle.
bw2 := borderWidth * 2.
rel := relativeOrigin x.
(rel isMemberOf:Float) ifTrue:[
newX := (rel * (inRect width + borderWidth "bw2")) asInteger + inRect left
] ifFalse:[
newX := rel
].
rel := relativeOrigin y.
(rel isMemberOf:Float) ifTrue:[
newY := (rel * (inRect height + borderWidth "bw2")) asInteger + inRect top
] ifFalse:[
newY := rel
].
newOrigin := (newX @ newY).
(borderWidth ~~ 0) ifTrue:[
(relativeOrigin x isMemberOf:Float) ifTrue:[
newOrigin x:(newOrigin x - borderWidth)
].
(relativeOrigin y isMemberOf:Float) ifTrue:[
newOrigin y:(newOrigin y - borderWidth)
]
].
^ newOrigin
!
cornerFromRelativeCorner
"compute pixel corner from relativeCorner"
|newCorner newX newY rel inRect bw2|
superView isNil ifTrue:[^ nil].
inRect := superView viewRectangle.
bw2 := borderWidth * 2.
rel := relativeCorner x.
(rel isMemberOf:Float) ifTrue:[
newX := (rel * (inRect width" + bw2")) asInteger "+ inRect left"
] ifFalse:[
newX := rel
].
rel := relativeCorner y.
(rel isMemberOf:Float) ifTrue:[
newY := (rel * (inRect height" + bw2")) asInteger "+ inRect top"
] ifFalse:[
newY := rel
].
newCorner := (newX @ newY).
(borderWidth ~~ 0) ifTrue:[
(relativeCorner x isMemberOf:Float) ifTrue:[
newCorner x:(newCorner x - borderWidth)
].
(relativeCorner y isMemberOf:Float) ifTrue:[
newCorner y:(newCorner y - borderWidth)
]
].
^ newCorner
!
extentFromRelativeExtent
"compute pixel extent from relativeExtent"
|newExtent newX newY rel inRect bw2|
superView isNil ifTrue:[^ nil].
inRect := superView viewRectangle.
bw2 := borderWidth * 2.
rel := relativeExtent x.
(rel isMemberOf:Float) ifTrue:[
newX := (rel * (inRect width + bw2)) asInteger + inRect left
] ifFalse:[
newX := rel
].
rel := relativeExtent y.
(rel isMemberOf:Float) ifTrue:[
newY := (rel * (inRect height + bw2)) asInteger + inRect top
] ifFalse:[
newY := rel
].
newExtent := (newX @ newY).
(borderWidth ~~ 0) ifTrue:[
(relativeExtent x isMemberOf:Float) ifTrue:[
newExtent x:(newExtent x - (1 * borderWidth))
].
(relativeExtent y isMemberOf:Float) ifTrue:[
newExtent y:(newExtent y - (1 * borderWidth))
]
].
^ newExtent
!
dimensionFromViewport
"define my origin/extend from viewport"
|relW relH relX relY winW winH org ext|
superView notNil ifTrue:[
superView window isNil ifTrue:[
"
v := superView.
(v notNil and:[v window isNil]) whileTrue:[
v := v superview
].
v notNil ifTrue:[
w := v window
].
"
"
winW := 1.
winH := 1
"
winW := superView width.
winH := superView height.
] ifFalse:[
winW := superView window width.
winH := superView window height
].
relW := (viewport width / winW) asFloat.
relH := (viewport height / winH) asFloat.
relX := (viewport left / winW) asFloat.
relY := (viewport top / winH) asFloat.
relativeOrigin := (relX @ relY).
org := self originFromRelativeOrigin.
relativeOrigin := nil.
relativeExtent := (relW @ relH).
ext := self extentFromRelativeExtent.
relativeExtent := nil.
self pixelOrigin:org extent:ext.
]
!
computeInnerClip
|m2|
(margin ~~ 0) ifTrue:[
m2 := margin + margin.
innerClipRect := Rectangle left:margin top:margin
width:(width - m2) height:(height - m2)
] ifFalse:[
innerClipRect := nil
]
!
setInnerClip
|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'!
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"
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)
]
]
].
"associate cursor/colors to device"
viewBackground := viewBackground on:device.
borderColor := borderColor on:device.
shadowColor := shadowColor on:device.
lightColor := lightColor on:device.
cursor := cursor 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:true in:drawableId
].
font := font on:device.
self initializeMiddleButtonMenu.
self initEvents.
]
!
createWithAllSubViews
"create, then create all subviews"
drawableId isNil ifTrue:[self create].
subViews notNil ifTrue:[
subViews do:[:subView | subView createWithAllSubViews]
]
!
initializeMiddleButtonMenu
"a place to initialize menu - this one is sent once when the view is
first created; usually redefined in subclasses; default here is no menu"
^ self
!
fixSize
"adjust size of window according to either relative/abs or
block extent; also set origin"
window notNil ifTrue:[
^ self superViewChangedSize
].
"if the extent is not the one we created the window with ..."
extentChanged ifTrue:[
self sizeChanged:nil.
extentChanged := false
].
originChanged ifTrue:[
originRule notNil ifTrue:[
self pixelOrigin:(originRule value)
] ifFalse:[
relativeOrigin notNil ifTrue:[
self originFromRelativeOrigin
]
].
originChanged := false
]
!
realize
"realize - make visible;
realizing is done very late (after layout is fixed) to avoid
visible rearranging of windows on the screen"
drawableId isNil ifTrue:[
self create.
"if it is the first realize (which means a create),
force sizechange messages"
extentChanged := true.
originChanged := true
].
"put myself into superviews windowgroup"
superView notNil ifTrue:[
windowGroup notNil ifTrue:[
'oops - wgroup change on realize' printNewline.
windowGroup removeView:self
].
windowGroup := superView windowGroup.
windowGroup notNil ifTrue:[
windowGroup addView:self.
]
].
hidden ifTrue:[
^ self
].
realized ifFalse:[
(originChanged or:[extentChanged]) ifTrue:[self fixSize].
subViews notNil ifTrue:[
subViews do:[:subView |
subView realize
]
].
self setInnerClip.
"and make it visible"
device mapWindow:drawableId.
realized := true
]
!
rerealize
"rerealize at old position"
device mapWindow:drawableId iconified:false
atX:left y:top
width:width height:height
!
destroy
"unrealize & destroy - make me invisible, destroy subviews then
make me unknown to the device"
realized ifTrue:[
self unrealize.
"make it go away immediately
- also, this hides the subview killing"
"
device synchronizeOutput.
"
].
model notNil ifTrue:[
model removeDependent:self
].
controller := nil.
subViews notNil ifTrue:[
"stupid: destroy removes itself from the subveiws list
- therefore we have to loop over a copy here"
subViews copy do:[:aView |
aView notNil ifTrue:[aView destroy]
]
].
superView notNil ifTrue:[
superView removeSubView:self.
superView := nil
].
super destroy.
windowGroup notNil ifTrue:[
windowGroup removeView:self
].
!
unrealize
"hide me"
realized ifTrue:[
drawableId notNil ifTrue:[
device unmapWindow:drawableId
].
realized := false.
shown := false
]
!
open
"create and schedule a new windowgroup for me and open the view"
ProcessorScheduler isPureEventDriven ifFalse:[
windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
].
windowGroup startup.
].
^ self realize
!
openModal
"create a new windowgroup, but start processing in the current process
actually suspending event processing for the currently active group"
ProcessorScheduler isPureEventDriven ifFalse:[
windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
].
self realize.
self windowGroup eventLoop
] ifTrue:[
self realize
]
! !
!View methodsFor:'drawing'!
drawEdgesForX:x y:y width:w height:h level:l
shadow:shadowColor light:lightColor
halfShadow:halfShadowColor halfLight:halfLightColor
"draw 3D edges into a rectangle"
|topLeftFg botRightFg topLeftHalfFg botRightHalfFg
count "{ Class: SmallInteger }"
r "{ Class: SmallInteger }"
b "{ Class: SmallInteger }"
xi "{ Class: SmallInteger }"
yi "{ Class: SmallInteger }"
run |
(l < 0) ifTrue:[
topLeftFg := shadowColor.
botRightFg := lightColor.
topLeftHalfFg := halfShadowColor.
botRightHalfFg := halfLightColor.
count := l negated
] ifFalse:[
topLeftFg := lightColor.
botRightFg := shadowColor.
topLeftHalfFg := halfLightColor.
botRightHalfFg := halfShadowColor.
count := l
].
r := x + w - 1. "right"
b := y + h - 1. "bottom"
super lineWidth:0.
"top and left edges"
(softEdge and:[l > 0]) ifTrue:[
super paint:topLeftHalfFg
] ifFalse:[
super paint:topLeftFg
].
0 to:(count - 1) do:[:i |
run := y + i.
super displayLineFromX:x y:run toX:r y:run. "top"
run := x + i.
super displayLineFromX:run y:y toX:run y:b "left"
].
softEdge ifTrue:[
"
super paint:topLeftFg.
super displayLineFromX:x y:y toX:r y:y.
super displayLineFromX:x y:y toX:x y:b
"
(l > 2) ifTrue:[
super paint:Black.
super displayLineFromX:x y:y toX:r y:y.
super displayLineFromX:x y:y toX:x y:b.
]
].
xi := x + 1.
yi := y + 1.
"bottom and right edges"
(softEdge) ifTrue:[
super paint:botRightHalfFg
] ifFalse:[
super paint:botRightFg
].
0 to:(count - 1) do:[:i |
run := b - i.
super displayLineFromX:xi-1 y:run toX:r y:run. "bottom"
run := r - i.
super displayLineFromX:run y:yi-1 toX:run y:b. "right"
xi := xi + 1.
yi := yi + 1
].
(softEdge and:[l > 1]) ifTrue:[
super paint:shadowColor.
super displayLineFromX:(x + 1-1) y:b toX:r y:b.
super displayLineFromX:r y:(y + 1 - 1) toX:r y:b
]
!
drawEdgesForX:x y:y width:w height:h level:l
"draw 3D edges into a rectangle"
self drawEdgesForX:x y:y width:w height:h level:l
shadow:shadowColor light:lightColor
halfShadow:halfShadowColor halfLight:halfLightColor
!
drawLeftEdge
"draw left 3D edge into window frame"
|leftFg leftHalfFg
count "{ Class: SmallInteger }" |
(level < 0) ifTrue:[
leftFg := shadowColor.
leftHalfFg := halfShadowColor.
count := level negated
] ifFalse:[
leftFg := lightColor.
leftHalfFg := halfLightColor.
count := level
].
super lineWidth:0.
(softEdge and:[level > 0]) ifTrue:[
super paint:leftHalfFg
] ifFalse:[
super paint:leftFg
].
0 to:(count - 1) do:[:i |
super displayLineFromX:i y:i toX:i y:(height - 1 - i)
].
(softEdge and:[level > 2]) ifTrue:[
super paint:Black.
super displayLineFromX:0 y:0 toX:0 y:height-1.
]
!
drawRightEdge
"draw right 3D edge into window frame"
|rightFg
count "{ Class: SmallInteger }"
r|
(level < 0) ifTrue:[
rightFg := lightColor.
count := level negated
] ifFalse:[
(softEdge and:[level > 1]) ifTrue:[
rightFg := halfShadowColor
] ifFalse:[
rightFg := shadowColor
].
count := level
].
super lineWidth:0.
super paint:rightFg.
0 to:(count - 1) do:[:i |
r := width - 1 - i.
super displayLineFromX:r y:i toX:r y:(height - 1 - i)
].
(softEdge and:[level > 1]) ifTrue:[
super paint:shadowColor.
super displayLineFromX:width-1 y:1 toX:width-1 y:height-1.
]
!
drawTopEdge
"draw top 3D edge into window frame"
|topFg topHalfFg
count "{ Class: SmallInteger }" |
(level < 0) ifTrue:[
topFg := shadowColor.
topHalfFg := halfShadowColor.
count := level negated
] ifFalse:[
topFg := lightColor.
topHalfFg := halfLightColor.
count := level
].
super lineWidth:0.
(softEdge and:[level > 0]) ifTrue:[
super paint:topHalfFg
] ifFalse:[
super paint:topFg
].
0 to:(count - 1) do:[:i |
super displayLineFromX:i y:i toX:(width - 1 - i) y:i
].
(softEdge and:[level > 2]) ifTrue:[
super paint:Black.
super displayLineFromX:0 y:0 toX:width-1 y:0.
]
!
drawBottomEdge
"draw bottom 3D edge into window frame"
|botFg
count "{ Class: SmallInteger }"
b|
(level < 0) ifTrue:[
botFg := lightColor.
count := level negated
] ifFalse:[
(softEdge and:[level > 1]) ifTrue:[
botFg := halfShadowColor
] ifFalse:[
botFg := shadowColor
].
count := level
].
super lineWidth:0.
super paint:botFg.
0 to:(count - 1) do:[:i |
b := height - 1 - i.
super displayLineFromX:i y:b toX:(width "- 1" - i) y:b
].
(softEdge and:[level > 1]) ifTrue:[
super paint:shadowColor.
super displayLineFromX:1 y:height-1 toX:width-1 y:height-1.
]
!
redrawEdges
"redraw my edges if 3D"
self is3D ifTrue:[
(level ~~ 0) ifTrue:[
self clipRect:nil.
self drawEdgesForX:0 y:0
width:width height:height
level:level.
self clipRect:innerClipRect
]
]
!
redraw
"redraw myself
if there is a model, this one shall redraw itself,
otherwise we cannot do much here - has to be redefined in subclasses"
model notNil ifTrue:[
model update:self
]
!
redrawX:x y:y width:w height:h
"have to redraw part -
default is to redraw everything - subclasses should add intelligence"
|area|
area := Rectangle left:x top:y width:w height:h.
self clippedTo:area do:[
controller notNil ifTrue:[
"ST-80 updating"
self update:#rectangle with:area
] ifFalse:[
components notNil ifTrue:[
components do:[:aComponent |
(aComponent frame intersects:area) ifTrue:[
aComponent drawIn:self offset:0@0
]
]
] ifFalse:[
self redraw
]
]
]
! !
!View methodsFor:'events'!
destroyed
"view has been destroyed by someone else"
shown := false.
super destroyed
!
sizeChanged:how
"tell subviews if I change size"
transformation := nil. "transformation becomes void"
subViews notNil ifTrue:[
(how == #smaller) ifTrue:[
subViews do:[:view |
view superViewChangedSize
]
] ifFalse:[
"doing it reverse speeds up resizing - usually subviews
are created from top-left to bottom-right; therefore
bottom-right views will be moved/resized first, then top-left ones;
this avoids multiple redraws of subviews"
subViews reverseDo:[:view |
view superViewChangedSize
]
]
]
!
superViewChangedSize
"my superView has changed size; if I have relative
origin/extent or blocks to evaluate, do it now .."
|oldWidth oldHeight oldTop oldLeft newExt newOrg
winSuper newWidth newHeight newLeft newTop newCorner
superWidth superHeight superWinWidth superWinHeight|
oldWidth := width.
oldHeight := height.
oldTop := top.
oldLeft := left.
viewport notNil ifTrue:[
"if this view has a viewPort, resize a la st-80"
superView isNil ifTrue:[^ self].
winSuper := superView window.
winSuper isNil ifTrue:[
"take pixel size as window"
winSuper := 0@0 extent:(superView width@superView height)
].
superWidth := superView width.
superHeight := superView height.
superWinWidth := winSuper width.
superWinHeight := winSuper height.
newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
newWidth := superWidth * viewport width // superWinWidth.
newHeight := superHeight * viewport height // superWinHeight.
self pixelOrigin:(newLeft @ newTop).
self pixelExtent:(newWidth @ newHeight).
^ self
].
(originRule notNil) ifTrue:[
newOrg := originRule value
] ifFalse:[
(relativeOrigin notNil) ifTrue:[
"self originFromRelativeOrigin "
newOrg := self originFromRelativeOrigin.
"
borderWidth ~~ 0 ifTrue:[
newOrg := newOrg - (borderWidth @ borderWidth)
]
"
]
].
(cornerRule notNil) ifTrue:[
newCorner := cornerRule value
] ifFalse:[
(relativeCorner notNil) ifTrue:[
newCorner := self cornerFromRelativeCorner
] ifFalse:[
(extentRule notNil) ifTrue:[
newExt := extentRule value
] ifFalse:[
(relativeExtent notNil) ifTrue:[
newExt := self extentFromRelativeExtent
]
].
]
].
newOrg notNil ifTrue:[
((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
newOrg := nil
]
].
newCorner notNil ifTrue:[
(newCorner = self corner) ifTrue:[
newCorner := nil
] ifFalse:[
self corner isNil ifTrue:[
newExt notNil ifTrue:[
((newExt x == oldWidth) and:[newExt y == oldHeight]) ifTrue:[
newExt := nil
]
].
]
]
].
newCorner isNil ifTrue:[
newExt isNil ifTrue:[
newOrg notNil ifTrue:[
self pixelOrigin:newOrg
]
] ifFalse:[
newOrg isNil ifTrue:[
self pixelExtent:newExt
] ifFalse:[
self pixelOrigin:newOrg extent:newExt
]
]
] ifFalse:[
newOrg isNil ifTrue:[
self pixelCorner:newCorner
] ifFalse:[
self pixelOrigin:newOrg corner:newCorner
]
]
!
configureX:x y:y width:newWidth height:newHeight
"my size has changed by window manager action"
|how anyEdge mustRedrawBottomEdge mustRedrawRightEdge|
left := x.
top := y.
((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[
realized ifFalse:[
width := newWidth.
height := newHeight.
extentChanged := true.
^ self
].
((newWidth <= width) and:[newHeight <= height]) ifTrue:[
how := #smaller
].
self is3D ifTrue:[
mustRedrawBottomEdge := newHeight < height.
mustRedrawRightEdge := newWidth < width.
anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
] ifFalse:[
anyEdge := false
].
width := newWidth.
height := newHeight.
"recompute inner-clip if needed"
self setInnerClip.
self sizeChanged:how.
(anyEdge and:[shown]) ifTrue:[
self clipRect:nil.
mustRedrawBottomEdge ifTrue:[
self drawBottomEdge
].
mustRedrawRightEdge ifTrue:[
self drawRightEdge
].
self clipRect:innerClipRect
]
]
!
mapped
"the view has been mapped (by some outside
action - i.e. window manager de-iconified me)"
realized := true.
shown := true.
"backed views will not get expose events - have
to force a redraw here to get things drawn into
backing store"
backed ifTrue:[
self redraw
]
!
unmapped
"the view has been unmapped (by some outside
action - i.e. window manager iconified me)"
shown := false
!
reparented
"the view has changed its parent by some outside
action - i.e. window manager has added a frame.
nothing done here"
^ self
!
exposeX:x y:y width:w height:h
"a low level redraw event from device
- let subclass handle the redraw and take care of edges here"
|leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh|
nw := w.
nh := h.
nx := x.
ny := y.
anyEdge := false.
"check if there is a need to draw an edge"
(margin ~~ 0) ifTrue:[
leftEdge := false.
topEdge := false.
rightEdge := false.
botEdge := false.
(x < margin) ifTrue:[
nx := margin.
nw := nw - (nx - x).
leftEdge := true.
anyEdge := true
].
((x + w - 1) >= (width - margin)) ifTrue:[
nw := (width - margin - nx).
rightEdge := true.
anyEdge := true
].
(y < margin) ifTrue:[
ny := margin.
nh := nh - (ny - y).
topEdge := true.
anyEdge := true
].
((y + h - 1) >= (height - margin)) ifTrue:[
nh := (height - margin - ny).
botEdge := true.
anyEdge := true
]
].
"redraw inside area"
self redrawX:nx y:ny width:nw height:nh.
"redraw edge(s)"
anyEdge ifTrue:[
self clipRect:nil.
(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
self drawEdgesForX:0 y:0
width:width height:height
level:level
] ifFalse:[
topEdge ifTrue:[
self drawTopEdge
].
leftEdge ifTrue:[
self drawLeftEdge
].
botEdge ifTrue:[
self drawBottomEdge
].
rightEdge ifTrue:[
self drawRightEdge
]
].
self clipRect:innerClipRect
]
!
keyPress:key x:x y:y
"a key has been pressed.
if there is a keyboardHandler, pass input to him"
"allow forwarding events to the keyboardhandler"
keyboardHandler notNil ifTrue:[
keyboardHandler keyPress:key x:x y:y
] ifFalse:[
super keyPress:key x:x y:y
]
!
buttonPress:button x:x y:y
"button was pressed - if its middle button and there is a menu, show it."
|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
]
]
].
super buttonPress:button x:x y:y
!
XXXwaitForExpose
"after a scroll, we have to wait for expose/noexpose"
device dispatchExposeEventsFor:drawableId
!
terminate
"window manager wants me to go away"
^ self destroy
!
saveAndTerminate
"window manager wants me to save and go away"
^ self destroy
! !