cursor #on: is obsoleted by #onDevice:.
"
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.
"
DisplaySurface subclass:#SimpleView
instanceVariableNames:'superView subViews components styleSheet resources borderColor
borderWidth borderShape viewShape top left extentChanged
originChanged cornerChanged relativeOrigin relativeExtent
relativeCorner originRule extentRule cornerRule insets layout
shown hiddenOnRealize name level margin innerClipRect shadowColor
lightColor bitGravity viewGravity controller windowGroup
preferredExtent explicitExtent'
classVariableNames:'Grey CentPoint ViewSpacing DefaultStyle StyleSheet
DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
DefaultShadowColor DefaultBorderWidth DefaultFocusColor
DefaultFocusBorderWidth ReturnFocusWhenClosingModalBoxes'
poolDictionaries:''
category:'Views-Basic'
!
SimpleView class instanceVariableNames:'ClassResources DefaultFont'
"
The following class instance variables are inherited by this class:
DisplaySurface -
GraphicsMedium -
DeviceGraphicsContext -
GraphicsContext -
Object -
"
!
!SimpleView 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.
"
!
documentation
"
this class implements functions common to all Views which do not work on / show a model.
Previously, all of this functionality used to be in the old View class, but has been
separated into this new SimpleView (which does not know about models) and the new View, which
does so.
I'd prefer to call this class View and the current View class a ModelView,
but for backward compatibility its better to leave things the way they are
(there are simply too many subclasses of View around ...).
Instances of SimpleView 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
or layout purposes.
[Instance variables:]
superView <View> my superview i.e. the view I am in
subViews <Collection> the collection of subviews
components <Collection> collection of gadgets (will be merged with subViews, soon)
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> actual top coordinate (pixels) in superview
left <Number> actual left coordinate (pixels) 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
relativeCorner <Number> relative corner in percent within superview
originRule <Block> rule to compute origin if superview changes size
extentRule <Block> rule to compute extent if superview changes size
cornerRule <Block> rule to compute corner if superview changes size
insets <Array> array with top, left, bottom & right insets (or nil)
layout <LayoutObject> not yet implemented - will replace the above layout
variables.
shown <Boolean> true if visible (false if iconified, unmapped or covered)
hiddenOnRealize <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
bitGravity <nil | Symbol> gravity of contents (if device supports it)
viewGravity <nil | Symbol> gravity of view (if device supports it)
controller <nil | Controller> the controller (if any)
windowGroup <WindowGroup> the windowGroup
[Class variables:]
Grey <Color> the color grey - its used so often
ViewSpacing <Number> preferred spacing between views; 1mm
CentPoint <Point> 100 @ 100 - its used so often
StyleSheet <ResourcePack> contains all view-style specifics
ReturnFocusWhenClosingModalBoxes if true, a closing modalBox returns
<Boolean> the keyboard focus to the view which was
active when the box was opened.
If false (the default), it is left to
window manager to assign a new focus.
If running on olwm/olvwm (which requires an
explicit click to reassign a focus), it is
better to turn this on in a private.rc file.
[styleSheet parameters:]
popupShadow <Boolean> if true, popupViews show a shadow below
popupLevel <nil | Integer> 3D level
borderWidth <nil | Integer> borderWidth (ignored in 3D styles)
borderColor <nil | Color> borderColor (ignored in 3D styles)
viewBackground <nil | Color> views background
shadowColor <nil | Color> color for shadow edges (ignored in 2D styles)
lightColor <nil | Color> color for light edges (ignored in 2D styles)
font <nil | Font> font to use
TODO:
get rid of relativeOrigin, relativeCorner, originRule, extentRule,
and insets; replace by a single object which defines the size
(mhmh - ST-80 seems to call this LayoutFrame ?)
-> be prepared for a change here in the near future and ONLY use
access methods to get those instance variables' values
get rid of 3D level & margin, move it to extra wrappers
(although this will make view setup more complicated, it will remove
complexity from the internals of view. Also, it will allow for more
varieties of borders.)
add components (could also call them gadgets or lightweight views)
- views are expensive in terms of X resources. This would make all
framing/edge and panel helper views become cheap ST objects, instead
of views.
[see also:]
StandardSystemView DialogBox
WindowGroup WindowEvent
Layout
( introduction to view programming :html: programming/viewintro.html )
[author:]
Claus Gittinger
"
!
examples
"
(all examples below use different viewBackgrounds,
to make the individual subviews visible)
a subView in a topView:
[exBegin]
|top v|
topView := StandardSystemView new.
v := View new.
v origin:0.25 @ 0.25 corner:0.75 @ 0.75.
top addSubView:v.
top open
[exEnd]
the same, a bit more compact:
[exBegin]
|top v|
topView := StandardSystemView new.
v := View origin:0.25 @ 0.25 corner:0.75 @ 0.75 in:topView.
top open
[exEnd]
fixed position/size:
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:10@10
corner:50@50
in:top.
v2 := View origin:60@10
corner:150@100
in:top.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top open
[exEnd]
same, using ST-80 way of bulding up view hierarchies
(recommended, if you plan to port applications later)
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v1 origin:10@10 corner:50@50.
v2 := View new.
v2 origin:60@10 corner:150@100.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1.
top add:v2.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top open
[exEnd]
fixed origin, variable size:
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v1 origin:10@10 corner:50@0.5.
v2 := View new.
v2 origin:60@10 corner:150@0.5.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1.
top add:v2.
top open
[exEnd]
fixed origin, variable size,
bottomInset for constant distance from bottom:
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v1 origin:10@10 corner:50@1.0.
v1 bottomInset:10.
v2 := View new.
v2 origin:60@10 corner:150@1.0.
v2 bottomInset:10.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1.
top add:v2.
top open
[exEnd]
variable origin, variable size,
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v1 origin:0.0@0.0 corner:0.5@0.5.
v2 := View new.
v2 origin:0.5@0.0 corner:1.0@0.5.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1.
top add:v2.
top open
[exEnd]
variable origin, variable size,
insets for some constant distance
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v1 origin:0.0@0.0 corner:0.5@0.5.
v1 rightInset:5.
v2 := View new.
v2 origin:0.5@0.0 corner:1.0@0.5.
v2 leftInset:5.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1.
top add:v2.
top open
[exEnd]
using layout objects (ST-80 style):
fully specifying the frame
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v2 := View new.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1 in:(LayoutFrame new
leftFraction:0.25;
rightFraction:0.75;
topFraction:0.0;
bottomFraction:0.5).
top add:v2 in:(LayoutFrame new
leftFraction:0.5;
rightFraction:1.0;
topFraction:0.5;
bottomFraction:0.75).
top open
[exEnd]
another one, with offsets:
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v2 := View new.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1 in:(LayoutFrame new
leftFraction:0.0 offset:10;
rightFraction:1.0 offset:-10;
topFraction:0.0 offset:10;
bottomFraction:0.5).
top add:v2 in:(LayoutFrame new
leftFraction:0.0 offset:30;
rightFraction:1.0 offset:-30;
topFraction:0.5 offset:10;
bottomFraction:0.75).
top open
[exEnd]
specifying origin only. Extent is views preferred
(notice, that plain views have some defaultExtent of 100@100)
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View new.
v2 := View new.
v1 viewBackground:(Color red).
v2 viewBackground:(Color yellow).
top add:v1 in:(LayoutOrigin new
leftFraction:0.25;
topFraction:0.0).
top add:v2 in:(LayoutOrigin new
leftFraction:0.5;
topFraction:0.5).
top open
[exEnd]
same example, using buttons which compute their preferredBounds:
[exBegin]
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := Button label:'foo'.
v2 := Button label:'a very long buttonLabel'.
v1 backgroundColor:(Color red).
v2 backgroundColor:(Color yellow).
top add:v1 in:(LayoutOrigin new
leftFraction:0.25;
topFraction:0.0).
top add:v2 in:(LayoutOrigin new
leftFraction:0.5;
topFraction:0.5).
top open
[exEnd]
"
!
layoutComputation
"
Due to historic reasons, there are 2 mechanisms to resize a view:
- (old, to be eliminated mechanism)
based upon info found in
relativeOrigin / relativeCorner / relativeExtent
originRule / cornerRule / extentRule
- (new, will migrate to that one)
letting a layoutObject compute things
Actually, the old mechanism is just as powerful, as the new (layoutObject
based) mechanism; with the help of block=rules, you can compute whatever
geometry is desired.
However, having 6 instance variables in every view creates some overhead,
which can be avoided in most cases (most views are either fixed-size or
relative-sized).
Therefore (and also to make porting of ST-80 apps easier), ST/X will migrate
to use layoutObjects.
You will not see a difference at the views protocol level, since
existing interfaces will (silently) create layoutObjects as appropriate.
However, you should remove all direct accesses to the above mentioned
instance variables, to be prepared for that change.
Notice, that a view recomputes its size whenever its superview
changes size. This is done via:
sizeChanged
-> allSubviews: superViewChangedSize
If the geometry computation as performed in superViewChangedSize
is not powerful enough for your application, you can either:
- redefine superViewChangedSize
- create a special layoutObject which computes a new layout.
"
!
popupMenus
"
Due to historic reasons, there are multiple mechanisms for popupMenu
definition:
- static menus
- dynamic menus from the view
- dynamic menus from the model / menuHolder
static menus
------------
The easiest to use is a static menu; this is useful, if some view
has a constant menu which never changes.
It can be defined at initialization time or redefined any time later.
The menu is defined with:
someView middleButtonMenu:<aPopUpMenu>
Compatibility note:
static menus should no longer be used - their operation
is incompatible with ST-80 and ST/X's dynamic menus.
Do not use them if you care for compatibility.
Also, they do not care for any menuPerformers or menuHolders.
(instead, they use a receiver instance variable, which gets the messages).
example:
|top v1 v2|
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:0.0@0.0 corner:0.5@1.0 in:top.
v1 viewBackground:Color red.
v2 := View origin:0.5@0.0 corner:1.0@1.0 in:top.
v2 viewBackground:Color yellow.
v1 middleButtonMenu:(
PopUpMenu
labels:#('foo' 'bar')
selectors:#(foo bar)
receiver:v1
).
top open.
dynamic menus
-------------
A dynamic menu can be provided by the view itself, or by the model.
In addition, TextViews allow a separate menuHolder to provide the menu
(i.e. it may be different from the model).
If the model shall provide the menu, set the views menuMessage to a selector
which is sent to the model. This message should return a popUpMenu.
For textViews, the above is also valid, except if the menuHolder is explicitely
set - in this case, that one provides the menu; not the model.
Dont get confused by the fact that menuHolders are only supported
by textViews.
example: (in your application, the plug would be your application, topView or model)
Notice, that all menu messages are sent to the view (because no model was set)
- so the textView still performs the copy-function correctly
(but of course, does not respond to the fooBar messages).
If a model was set, the menu would try the model first, but send its messages
to the view IFF the model would not respond to the menu message.
(this allows mixing of menu messages for the view AND the model).
|top v1 v2 holder|
holder := Plug new.
holder respondTo:#menu1
with:[
v1 menuMessage:#otherMenu1.
PopUpMenu
labels:#('foo' 'bar')
selectors:#(foo bar).
].
holder respondTo:#otherMenu1
with:[
v1 menuMessage:#menu1.
PopUpMenu
labels:#('other foo' 'other bar')
selectors:#(foo bar).
].
holder respondTo:#menu2
with:[ PopUpMenu
labels:#('copy' 'bar2')
selectors:#(copySelection bar2)
].
top := StandardSystemView new.
top extent:300@300.
v1 := View origin:0.0@0.0 corner:0.5@1.0 in:top.
v1 viewBackground:Color red.
v2 := TextView origin:0.5@0.0 corner:1.0@1.0 in:top.
v2 contents:'pop me up'.
v1 model:holder; menuMessage:#menu1.
v2 menuHolder:holder; menuMessage:#menu2.
top open.
an additional goody is the possibility, to change the menuPerformer (textViews only).
If defined, that one will get the menus message (instead of the model/view).
However, like above, if it does not respond to the message, its still sent to
the view. Notice, that with non-textViews, the menuPerformer is always the model.
example:
(Notice: the executor understands the #copySelection message - therefore, the
views built-in copy is NOT performed
- it could be forwarded to the view, though.
This could be useful to intercept/filter things).
|top v menuProvider menuExecutor |
menuProvider := Plug new.
menuProvider respondTo:#menu
with:[ PopUpMenu
labels:#('copy' 'foo')
selectors:#(copySelection foo)
].
menuExecutor := Plug new.
menuExecutor respondTo:#copySelection
with:[Transcript showCR:'copy function'].
menuExecutor respondTo:#foo
with:[Transcript showCR:'foo function'].
top := StandardSystemView new.
top extent:300@300.
v := TextView origin:0.0@0.0 corner:1.0@1.0 in:top.
v contents:'pop me up'.
v menuHolder:menuProvider; menuMessage:#menu.
v menuPerformer:menuExecutor.
top open.
"
! !
!SimpleView class methodsFor:'initialization'!
initialize
DefaultStyle isNil ifTrue:[
Font initialize.
Form initialize.
Color initialize.
"/ Display notNil ifTrue:[
"/ self defaultStyle:#normal.
"/ ].
"/ self updateStyleCache.
self == SimpleView ifTrue:[
Smalltalk addDependent:self "/ to get language changes
]
].
ReturnFocusWhenClosingModalBoxes := false.
"Modified: 18.5.1996 / 16:56:28 / cg"
!
postAutoload
self updateStyleCache.
! !
!SimpleView class methodsFor:'instance creation'!
extent:extent
"create a new view with given extent"
^ self origin:nil extent:extent borderWidth:nil
font:nil label:nil in:nil
!
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
!
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
!
in:aView
"return a new view as a subview of aView.
If aView is nil, it is left unspecified, in which superview
the new view will be placed. The view can later be assigned
by adding it to the superview via #addSubView:.
If realized and no superview has ever been set, it will come
up as a topview."
|newView|
newView := self basicNew.
aView notNil ifTrue:[
newView device:(aView graphicsDevice).
newView container:aView.
] ifFalse:[
newView device:Screen current "Display"
].
newView initialize.
aView notNil ifTrue:[aView addSubView:newView].
^ newView
"Modified: 28.5.1996 / 20:24:58 / cg"
!
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
!
model:aModel
"st-80 style view creation: create a new view and set its model.
Notice, that simpleViews do not understand #model:; however,
subclasses may."
^ self new model:aModel
"Created: 28.2.1997 / 19:27:40 / cg"
"Modified: 28.2.1997 / 19:28:12 / cg"
!
on:aModel
"create a new drawable on aModel"
"although this one does not know about models,
it can still send the model-assign message. This was done
to catch obsolete calls to on:aDevice.
"
^ self new model:aModel.
!
onSameDeviceAs:anotherView
"create a view on the same device as anotherView.
Used with popUpMenus, which should be created on the device of
its masterView."
|device|
anotherView notNil ifTrue:[
device := anotherView graphicsDevice.
] ifFalse:[
device := Screen current.
].
^ self onDevice:device
"Modified: 28.5.1996 / 20:25:05 / cg"
!
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:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
|newView|
aView notNil ifTrue:[
newView := self basicNew.
newView device:(aView graphicsDevice).
newView initialize.
aView addSubView:newView.
] ifFalse:[
newView := self onDevice:Screen current "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
"Modified: 28.5.1996 / 20:25:15 / cg"
!
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: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 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 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
!
origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
|newView|
aView notNil ifTrue:[
newView := self basicNew.
newView device:(aView graphicsDevice).
newView initialize.
aView addSubView:newView.
] ifFalse:[
newView := self onDevice:Screen current "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
"Modified: 28.5.1996 / 20:25:19 / cg"
!
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 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: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 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:anOrigin extent:anExtent
label:aLabel icon:aForm
minExtent:minExtent maxExtent:maxExtent
|newView|
newView := self onDevice:Screen current "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: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
! !
!SimpleView class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
something == #Language ifTrue:[
"flush resources on language changes"
self flushAllClassResources
]
"Created: 15.6.1996 / 15:23:04 / cg"
! !
!SimpleView class methodsFor:'defaults'!
defaultExtent
"return the default extent of my instances.
The value returned here is usually ignored, and
the value from preferredExtent taken instead."
CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
^ CentPoint
"Modified: 22.4.1996 / 23:38:39 / cg"
!
defaultFont
|f|
DefaultFont notNil ifTrue:[^ DefaultFont].
DefaultFont isNil ifTrue:[
self == SimpleView ifFalse:[
f := self superclass defaultFont.
] ifTrue:[
f := super defaultFont
].
].
f notNil ifTrue:[
DefaultFont := f.
f := f on:Display.
f notNil ifTrue:[
DefaultFont := f.
]
].
^ DefaultFont
"Modified: 27.2.1996 / 02:20:54 / cg"
!
defaultFont:aFont
"set the default font used for drawing"
|f|
DefaultFont := aFont.
aFont notNil ifTrue:[
f := aFont on:Display.
f notNil ifTrue:[
DefaultFont := f.
]
]
"Modified: 18.3.1996 / 12:56:20 / cg"
!
defaultStyle
"return the default view style"
^ DefaultStyle
"
View defaultStyle
"
!
defaultStyle:aStyle
"set the view style for new views"
"/ aStyle ~~ DefaultStyle ifTrue:[
DefaultStyle := aStyle.
self updateAllStyleCaches.
"/ ]
"
View defaultStyle:#next. SystemBrowser start
View defaultStyle:#motif. SystemBrowser start
View defaultStyle:#iris. SystemBrowser start
View defaultStyle:#st80. SystemBrowser start
View defaultStyle:#normal. SystemBrowser start
"
!
returnFocusWhenClosingModalBoxes
"return the current focus-return behavior.
See #returnFocusWhenClosingModalBoxes: for a description."
^ ReturnFocusWhenClosingModalBoxes
!
returnFocusWhenClosingModalBoxes:aBoolean
"control the keyboard-focus behavior when a modal dialog
is closed. The default (true) is to return the focus to the view
which was active when the dialog was opened.
If false, it is left up to the display to set the focus.
For owm / ovwm (which requires an explicit click for the focus),
it is better to return the focus automatically.
For managers which assign the focus according the pointer position,
it may be better to turn the focus-return off.
You should add a corresponding expression into your private.rc or
display.rc file."
ReturnFocusWhenClosingModalBoxes := aBoolean
"
Dialog returnFocusWhenClosingModalBoxes:false
Dialog returnFocusWhenClosingModalBoxes:true
"
!
styleSheet
"return the view style sheet information (a dictionary)"
^ StyleSheet
"
View styleSheet
"
"Modified: 9.1.1997 / 13:47:42 / cg"
!
styleSheet:aViewStyle
"set the view style from a style-sheet"
StyleSheet := aViewStyle.
DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
self updateAllStyleCaches.
!
updateAllStyleCaches
"reload all style caches in all view classes.
Needed after a style change or when a style file has been changed"
StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
StyleSheet fileReadFailed ifTrue:[
('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintCR.
DefaultStyle ~~ #normal ifTrue:[
DefaultStyle := #normal.
StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
StyleSheet fileReadFailed ifTrue:[
'***** WARNING: not even a styleSheet for normal-style (using defaults).' errorPrintCR.
]
]
].
"
tell all view classes to flush any
cached style-data
"
self changed:#style.
SimpleView updateStyleCache.
SimpleView allSubclassesDo:[:aClass |
aClass defaultFont:nil.
(aClass class implements:#updateStyleCache) ifTrue:[
aClass updateStyleCache
].
]
"
View updateAllStyleCaches
"
"Modified: 10.1.1997 / 18:06:25 / cg"
!
updateStyleCache
"this method gets some heavily used style stuff and keeps
it in class-variables for faster access.
Subclasses should redefine this to load any cached style-values
into faster class variables as well. These should NOT do a
super updateStyleCache, since this method is called for all view-classes
anyway."
<resource: #style (#viewSpacing #font #borderWidth
#viewBackground #shadowColor #lightColor
#focusColor #focusBorderWidth)>
|bgGrey|
"
when coming here the first time, we read the styleSheet
and keep the values in fast class variables
"
StyleSheet isNil ifTrue:[
DefaultStyle := #normal.
StyleSheet := ViewStyle fromFile:'normal.style'.
].
Grey := StyleSheet viewGrey.
Grey isNil ifTrue:[
Grey := Color grey
].
Grey := Grey on:Display.
StyleSheet fileReadFailed ifTrue:[
bgGrey := White
] ifFalse:[
Display hasGrayscales ifTrue:[
bgGrey := Grey
] ifFalse:[
bgGrey := White
]
].
bgGrey := bgGrey on:Display.
ViewSpacing := StyleSheet at:'viewSpacing'.
ViewSpacing isNil ifTrue:[
ViewSpacing := Display verticalPixelPerMillimeter rounded.
].
DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
StyleSheet fileReadFailed ifTrue:[
DefaultBorderWidth := 1.
DefaultShadowColor := Black.
DefaultLightColor := White.
DefaultFocusColor := Black.
DefaultFocusBorderWidth := 2.
DefaultViewBackgroundColor := bgGrey.
] ifFalse:[
DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
DefaultLightColor := StyleSheet colorAt:'lightColor'.
DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
].
self == SimpleView ifTrue:[
DefaultFont := StyleSheet at:'font'.
DefaultFont isNil ifTrue:[
DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
].
DefaultFont := DefaultFont on:Display.
] ifFalse:[
DefaultFont := nil
].
DefaultViewBackgroundColor isNil ifTrue:[
'SimpleView [warning]: bad viewBackground in style - using white' errorPrintCR.
DefaultViewBackgroundColor := White
].
"Modified: 10.1.1997 / 18:06:18 / cg"
!
viewSpacing
"return a convenient number of pixels used to separate views (usually 1mm).
Having this value here at a common place makes certain that all views
get a common look"
^ ViewSpacing
! !
!SimpleView class methodsFor:'resources'!
classResources
"if not already loaded, get the classes resourcePack
and return it"
ClassResources isNil ifTrue:[
ClassResources := ResourcePack for:self.
].
^ ClassResources
!
classResources:aResourcePack
"allow setting of the classResources"
ClassResources := aResourcePack
!
flushAllClassResources
"flush all classes resource translations.
Needed after a resource file has changed."
ResourcePack flushCachedResourcePacks.
SimpleView flushClassResources.
SimpleView allSubclasses do:[:aClass |
aClass flushClassResources.
]
"
View flushAllClassResources
"
"to change the language:
Language := #english.
Smalltalk changed:#Language.
View flushAllClassResources
or:
Language := #german.
Smalltalk changed:#Language.
View flushAllClassResources
"
!
flushClassResources
"flush classes resource string translations.
Needed whenever a resource file or language has changed"
ClassResources := nil.
!
updateClassResources
"flush classes resource string translations and reload them.
Needed whenever a resource file or language has changed"
ClassResources := nil.
self classResources
! !
!SimpleView methodsFor:'ST-80 compatibility'!
bounds
"ST-80 compatibility: return my bounds"
^ (self origin) corner:(self corner)
"Created: 4.6.1996 / 21:23:27 / cg"
"Modified: 10.1.1997 / 19:46:21 / cg"
!
bounds:aRectangle
"ST-80 compatibility: change my bounds"
explicitExtent := true.
self pixelOrigin:aRectangle origin
corner:aRectangle corner
"Created: 4.6.1996 / 21:44:27 / cg"
"Modified: 10.1.1997 / 19:46:36 / cg"
!
checkForEvents
"ST-80 compatibility:
check for any pending events and process them"
(shown and:[windowGroup notNil]) ifTrue:[windowGroup processEvents].
"Modified: 10.1.1997 / 19:46:06 / cg"
!
displayOn:aGC
"ST-80 compatibility: (re-)display myself"
self redraw
"Created: 4.6.1996 / 21:25:59 / cg"
"Modified: 10.1.1997 / 19:46:58 / cg"
!
displayPendingInvalidation
"dummy - for ST-80 compatibility"
"Created: 6.3.1997 / 15:17:14 / cg"
"Modified: 6.3.1997 / 15:17:31 / cg"
!
isEnabled
"return true, if this view is enabled (i.e. accepts user interaction).
Most views are enabled - only a few (buttons, SelectionInList etc.) can
be disabled.
#isEnabled is ST-80's equivalent of #enabled"
^ self enabled
!
newLayout:aLayoutObject
"set the layout object which controls my geometry.
ST80-compatibility."
here layout:aLayoutObject.
"Created: 3.3.1997 / 18:54:53 / cg"
!
refresh
self invalidate
! !
!SimpleView methodsFor:'accessing-bg & border'!
allViewBackground:something
"set the viewBackground to something, a color, image or form,
in myself and recursively in all of my subviews"
self viewBackground:something.
subViews notNil ifTrue:[
subViews do:[:v|
v allViewBackground:something
]
]
"Created: 17.7.1996 / 14:59:08 / cg"
"Modified: 18.7.1996 / 13:34:26 / cg"
!
borderColor
"return my borderColor"
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView borderColor
].
^ borderColor
"Modified: 5.6.1996 / 14:11:44 / cg"
!
borderColor:aColor
"set my borderColor"
"/ backward compatibility
"/ superView will be renamed to container soon.
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView borderColor:aColor
].
(aColor ~~ borderColor) ifTrue:[
borderColor := aColor.
drawableId notNil ifTrue:[
self setBorderColor
]
]
"Modified: 5.6.1996 / 14:11:50 / cg"
!
borderShape:aForm
"set the borderShape to aForm"
borderShape := aForm.
drawableId notNil ifTrue:[
device setWindowBorderShape:(aForm id) in:drawableId
]
!
borderWidth
"return my borderWidth"
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView borderWidth
].
^ borderWidth
"Modified: 5.6.1996 / 14:11:57 / cg"
!
borderWidth:aNumber
"set my borderWidth"
"/ backward compatibility
"/ superView will be renamed to container soon.
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView borderWidth:aNumber
].
(aNumber ~~ borderWidth) ifTrue:[
borderWidth := aNumber.
drawableId notNil ifTrue:[
device setWindowBorderWidth:aNumber in:drawableId
]
]
"Modified: 5.6.1996 / 14:12:05 / cg"
!
level
"return my level relative to superView (3D)"
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView level
].
^ level
"Modified: 5.6.1996 / 14:12:10 / cg"
!
level:aNumber
"set my level relative to superView (3D)"
|oldMargin how|
"/ backward compatibility
"/ superView will be renamed to container soon.
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
^ superView level:aNumber
].
(aNumber ~~ level and:[aNumber notNil]) ifTrue:[
self is3D ifTrue:[
level := aNumber.
oldMargin := margin.
margin := level abs.
realized ifTrue:[
margin ~~ oldMargin ifTrue:[
(margin > oldMargin) ifTrue:[
how := #smaller
] ifFalse:[
how := #larger
].
self sizeChanged:how.
self setInnerClip.
].
shown ifTrue:[
margin ~~ oldMargin ifTrue:[
self clear.
self redrawX:margin y:margin
width:width-(margin*2)
height:height-(margin*2)
].
self redrawEdges.
]
]
]
]
"Modified: 5.6.1996 / 14:12:17 / cg"
!
lightColor:aColorOrImage
"set the color to be used for lighted edges (3D only)"
lightColor := aColorOrImage
!
margin
"return my inner margin - this is usually the level,
but can be more for some views
(textViews which add more margin between the border and the text)"
^ margin
"Modified: 5.6.1996 / 14:37:54 / cg"
!
shadowColor:aColorOrImage
"set the color to be used for shadowed edges (3D only)"
shadowColor := aColorOrImage
!
viewBackground:something
"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 hasGrayscales ifTrue:[
shadowColor := something darkened "on:device".
lightColor := something lightened "on:device".
]
].
super viewBackground:something
"Modified: 28.5.1996 / 22:33:03 / cg"
!
viewShape:aForm
"set the viewShape to aForm"
viewShape := aForm.
drawableId notNil ifTrue:[
device setWindowShape:(aForm id) in:drawableId
]
! !
!SimpleView methodsFor:'accessing-contents'!
heightOfContents
"return the height of the contents in logical units
- defaults to views visible area here.
This method MUST be redefined in all view classess which are
going to be scrolled AND show data which has different size than
the view. For example, a view showing A4-size documents should return
the number of vertical pixels such a document has on this device.
A view showing a bitmap of height 1000 should return 1000.
If not redefined, scrollbars have no way of knowing the actual size
of the contents being shown. This is called by scrollBars to compute
the relative height of the document vs. the views actual size.
The value returned here must be based on a scale of 1, since users
of this will scale as appropriate."
^ (self innerHeight max:(self maxSubViewBottom)) max:self maxComponentBottom
"Modified: 26.5.1996 / 12:44:21 / cg"
!
widthOfContents
"return the width of the contents in logical units
- defaults to views visible area here.
This method MUST be redefined in all view classess which are
going to be scrolled AND show data which has different size than
the view. For example, a view showing A4-size documents should return
the number of horizontal pixels such a document has on this device.
A view showing a bitmap of width 500 should return 500.
If not redefined, scrollbars have no way of knowing the actual size
of the contents being shown. This is called by scrollBars to compute
the relative width of the document vs. the views actual width.
The value returned here must be based on a scale of 1, since users
of this will scale as appropriate."
^ (self innerWidth max:(self maxSubViewRight)) max:self maxComponentRight
"Modified: 26.5.1996 / 13:02:50 / cg"
! !
!SimpleView methodsFor:'accessing-dimensions'!
allInset:aNumber
"set all insets; positive makes the view smaller,
negative makes it larger."
insets isNil ifTrue:[
insets := Array new:4.
].
insets atAllPut:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:18 / cg"
!
bottom
"return the y position of the actual bottom edge (in pixels)"
^ top + height - 1
!
bottom:aNumber
"set the corners y position"
self corner:(self corner x @ aNumber)
!
bottomInset
"return the inset of the bottom edge; positive is to the top,
negative to the bottom"
insets isNil ifTrue:[^ 0].
^ insets at:4
!
bottomInset:aNumber
"set the inset of the bottom edge;
positive is to the top (view becomes smaller),
negative to the bottom (becomes larger)"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:4 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize
"/ ]
"Modified: 19.7.1996 / 17:30:22 / cg"
!
center
"return the point at the center of the receiver (in pixels)"
^ (left + (width // 2)) @ (top + (height // 2))
!
center:newCenter
"move the receiver so that newCenter, aPoint becomes the center point"
self origin:(newCenter - ((width // 2) @ (height // 2)))
!
computeCorner
"compute my corner; if I have a layoutObject,
relative origins or blocks to evaluate, compute it now ..
Blocks may return relative values or nil; nil means: take current value.
Returns the corner point in device coordinates (pixels)."
|org newCorner newExt x y|
"
slowly migrating to use layoutObjects ...
"
layout notNil ifTrue:[
^ (layout rectangleRelativeTo:(superView viewRectangle)
preferred:(self preferredBounds)) corner rounded
].
(cornerRule notNil) ifTrue:[
newCorner := cornerRule value.
"
allow return of relative values ...
"
x := newCorner x.
y := newCorner y.
x isNil ifTrue:[x := self corner x].
y isNil ifTrue:[y := self corner y].
((x isInteger not) or:[y isInteger not]) ifTrue:[
newCorner := self cornerFromRelativeCorner:x@y
]
] ifFalse:[
(relativeCorner notNil) ifTrue:[
newCorner := self cornerFromRelativeCorner:relativeCorner
] ifFalse:[
org := self computeOrigin.
(extentRule notNil) ifTrue:[
newExt := extentRule value
] ifFalse:[
(relativeExtent notNil) ifTrue:[
newExt := self extentFromRelativeExtent:relativeExtent
] ifFalse:[
newExt := self extent.
]
].
newCorner := org + newExt
]
].
^ newCorner
"Modified: 28.2.1997 / 10:33:39 / cg"
!
computeExtent
"compute my extent; if I have a layoutObject, a relative extent
or blocks to evaluate, compute it now ..
There is one catch here, if the dimension was defined
by origin/corner, compute them here and take that value.
I.e. origin/corner definition has precedence over extent definition.
Returns the extent in device coordinates (pixels)."
|newOrg newExt newCorner x y|
"
slowly migrating to use layoutObjects ...
"
layout notNil ifTrue:[
^ (layout rectangleRelativeTo:(superView viewRectangle)
preferred:(self preferredBounds)) extent rounded
].
(cornerRule notNil) ifTrue:[
newCorner := cornerRule value.
"
allow return of relative values ...
"
x := newCorner x.
y := newCorner y.
x isNil ifTrue:[x := self corner x].
y isNil ifTrue:[y := self corner y].
((x isInteger not) or:[y isInteger not]) ifTrue:[
newCorner := self cornerFromRelativeCorner:x@y
]
] ifFalse:[
(relativeCorner notNil) ifTrue:[
newCorner := self cornerFromRelativeCorner:relativeCorner
] ifFalse:[
(extentRule notNil) ifTrue:[
newExt := extentRule value.
"
allow return of relative values ...
"
x := newExt x.
y := newExt y.
x isNil ifTrue:[x := width].
y isNil ifTrue:[y := height].
((x isInteger not) or:[y isInteger not]) ifTrue:[
newExt := self extentFromRelativeExtent:x@y
]
] ifFalse:[
(relativeExtent notNil) ifTrue:[
newExt := self extentFromRelativeExtent:relativeExtent
] ifFalse:[
newExt := (width @ height).
].
].
].
].
newCorner notNil ifTrue:[
newOrg := self computeOrigin.
^ newCorner - newOrg.
].
^ newExt.
!
computeOrigin
"compute my origin; if I have a layoutObject, a relative origin
or blocks to evaluate, compute it now ..
Blocks may return relative values or nil; nil means: take current value.
Returns the origin point in device coordinates (pixels)."
|newOrg x y|
"
slowly migrating to use layoutObjects ...
"
layout notNil ifTrue:[
^ (layout rectangleRelativeTo:(superView viewRectangle)
preferred:(self preferredBounds)) origin rounded
].
(originRule notNil) ifTrue:[
newOrg := originRule value.
"
allow return of relative values ...
"
x := newOrg x.
y := newOrg y.
x isNil ifTrue:[x := self origin x].
y isNil ifTrue:[y := self origin y].
((x isInteger not) or:[y isInteger not]) ifTrue:[
newOrg := self originFromRelativeOrigin:x@y.
]
] ifFalse:[
(relativeOrigin notNil) ifTrue:[
newOrg := self originFromRelativeOrigin:relativeOrigin.
] ifFalse:[
^ (left @ top).
].
].
^ newOrg
!
corner
"return the lower right corner-point (in pixels)"
"/ ^ (left + width "- 1") @ (top + height "- 1")
^ (left + width - 1) @ (top + height - 1)
"Modified: 31.8.1995 / 16:51:40 / claus"
!
corner:corner
"set the views corner;
the corner argument may be:
a point
where integer fields mean 'pixel-values'
and float values mean 'relative-to-superview'
and nil means 'take current value';
or a block returning a point which is interpreted as above.
Please migrate to use layoutObjects, if possible."
|x y pixelCorner c|
explicitExtent := true.
corner isBlock ifTrue:[
cornerRule := corner.
drawableId notNil ifTrue:[
pixelCorner := corner value
] ifFalse:[
extentChanged := true
]
] ifFalse:[
x := corner x.
y := corner y.
x isNil ifTrue:[x := self corner x].
y isNil ifTrue:[y := self corner y].
c := x @ y.
((x isInteger not) or:[y isInteger not]) ifTrue:[
relativeCorner := c.
pixelCorner := self cornerFromRelativeCorner.
pixelCorner isNil ifTrue:[
extentChanged := true
]
] ifFalse:[
pixelCorner := c
]
].
pixelCorner notNil ifTrue:[
self pixelCorner:pixelCorner
]
"Modified: 15.7.1996 / 09:51:06 / cg"
!
cornerRule
"return the corner block - non public; this will vanish without notice"
^ cornerRule
!
extent:extent
"set the views extent;
extent may be:
a point
where integer fields mean 'pixel-values'
and float values mean 'relative-to-superview'
and nil means 'leave current value';
or a block returning a point which is interpreted as above.
Be careful when using relative extents: rounding errors may
accumulate. Better use origin/corner.
Best: migrate to use layour objects.
Notice: this sets the views explicitExtent flag, which prevents it normally
from resizing itself to its preferredExtent.
See initialExtent: for a variation."
|w h pixelExtent e|
explicitExtent := true.
extent isBlock ifTrue:[
extentRule := extent.
drawableId notNil ifTrue:[
pixelExtent := extent value
] ifFalse:[
extentChanged := true
]
] ifFalse:[
w := extent x.
h := extent y.
w isNil ifTrue:[w := width].
h isNil ifTrue:[h := height].
e := w@h.
((w isInteger not) or:[h isInteger not]) ifTrue:[
relativeExtent := e.
pixelExtent := self extentFromRelativeExtent.
pixelExtent isNil ifTrue:[
extentChanged := true
]
] ifFalse:[
relativeExtent := nil.
pixelExtent := e
]
].
pixelExtent notNil ifTrue:[
self pixelExtent:pixelExtent
]
"Modified: 15.7.1996 / 09:51:21 / cg"
!
extentRule
"return the extent block - non public; this will vanish without notice"
^ extentRule
!
geometryLayout
"this method will vanish, as soon as all implementations of
#layout: are removed ...
(conflict for example in label>>layout:).
DO NOT USE #geometryLayout: in your code; it will be removed without
notice."
^ here layout
!
geometryLayout:aLayoutObject
"this method will vanish, as soon as all implementations of
#layout: are removed ...
(conflict for example in label>>layout:).
DO NOT USE #geometryLayout: in your code; it will be removed without
notice."
here layout:aLayoutObject
!
height:aNumber
"set the views height in pixels"
self extent:(width @ aNumber)
!
heightIncludingBorder
"return my height including border
(this is my height as seen from the outside view;
while #height returns the height as seen by myself)"
^ height + (2*borderWidth)
!
horizontalInset:aNumber
"set the insets of the left/right edge;
positive makes it smaller, negative makes it larger"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:1 put:aNumber.
insets at:3 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:25 / cg"
!
initialExtent:extent
"set the views extent, but dont change its explicitExtent setting.
a variant of #extent."
|expl|
expl := explicitExtent.
self extent:extent.
explicitExtent := expl
!
initialHeight:aNumber
"set the views height in pixels, but dont change its explicitExtent setting"
self initialExtent:(width @ aNumber)
!
initialWidth:aNumber
"set the views width in pixels, but dont change its explicitExtent setting"
self initialExtent:(aNumber @ height)
!
innerHeight
"return the height of the view minus any 3D-shadow-borders"
(margin == 0) ifTrue:[^ height].
^ height - (2 * margin)
!
innerHeight:pixels
"set the height of the view plus any 3D-shadow-borders.
This does not work with a relative size."
^ self height:( pixels + (margin + self innerVerticalMargin * 2) ).
!
innerHorizontalMargin
"return any additional inner margin (i.e. contents margin).
This should be redefined by views which do add margins
(for example: textViews do this)"
^ 0
!
innerVerticalMargin
"return any additional inner margin (i.e. contents margin).
This should be redefined by views which do add margins
(for example: textViews do this)"
^ 0
!
innerWidth
"return the width of the view minus any 3D-shadow-borders"
(level == 0) ifTrue:[^ width].
^ width - (2 * margin)
!
innerWidth:pixels
"set the width of the view plus any 3D-shadow-borders.
This does not work with a relative size."
^ self width:( pixels + (margin + self innerHorizontalMargin * 2) ).
!
inset:aNumber
"set all insets; positive makes the view smaller,
negative makes it larger."
self allInset:aNumber
!
layout
"return the layout object which controls my geometry.
Currently, this is nil in most cases, and my geometry is
defined by relativeOrigin/relativeCorner/relativeExtent,
originRule/extentRule/cornerRule and inset.
Applications should be changed to use layoutObjects,
since the above listed instance variables will vanish."
^ layout
!
layout:aLayoutObject
"set the layout object which controls my geometry.
Currently, this is almost nowhere used but views will be
incrementally changed to use this new geometry management."
layout := aLayoutObject.
superView isNil ifTrue:[
originChanged := cornerChanged := extentChanged := true
] ifFalse:[
self containerChangedSize.
]
"Modified: 19.9.1995 / 16:17:25 / claus"
"Modified: 19.7.1996 / 17:30:27 / cg"
!
left
"return the x position of the left border (in pixels)"
^ left
!
left:aNumber
"set the x position"
self origin:(aNumber @ top)
!
left:newLeft top:newTop width:newWidth height:newHeight
"another way of specifying origin and extent"
self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
!
leftInset
"return the inset of the left edge; positive is to the right,
negative to the left"
insets isNil ifTrue:[^ 0].
^ insets at:1
!
leftInset:aNumber
"set the inset of the left edge;
positive is to the right (view becomes smaller),
negative to the left (becomes larger)"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:1 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:30 / cg"
!
makeFullyVisible
"make sure, that the view is fully visible by shifting it
into the visible screen area if nescessary.
This method will be moved to StandardSystemView ..."
|devBot devRight newTop newLeft|
newTop := top.
newLeft := left.
((top + height) > (devBot := device height)) ifTrue:[
newTop := devBot - height
].
((left + width) > (devRight := device width)) ifTrue:[
newLeft := devRight - width
].
(newTop < 0) ifTrue:[
newTop := 0.
].
(newLeft < 0) ifTrue:[
newLeft := 0
].
((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
self origin:newLeft @ newTop
]
!
origin
"return the origin (in pixels)"
^ left@top
!
origin:origin
"set the views origin;
origin may be:
a point
where integer fields mean 'pixel-values'
and float values mean 'relative-to-superview'
and nil means 'take current value';
or a block returning a point which is interpreted as above.
Please migrate to use layout objects."
|newLeft newTop pixelOrigin o|
origin isBlock ifTrue:[
originRule := origin.
drawableId notNil ifTrue:[
pixelOrigin := origin value
] ifFalse:[
originChanged := true
]
] ifFalse:[
o := origin.
newLeft := origin x.
newTop := origin y.
newLeft isNil ifTrue:[newLeft := left].
newTop isNil ifTrue:[newTop := top].
o := newLeft @ newTop.
((newLeft isInteger not) or:[newTop isInteger not]) ifTrue:[
relativeOrigin := o.
pixelOrigin := self originFromRelativeOrigin.
pixelOrigin isNil ifTrue:[
originChanged := true
]
] ifFalse:[
relativeOrigin := nil.
pixelOrigin := o
]
].
pixelOrigin notNil ifTrue:[
self pixelOrigin:pixelOrigin
].
"Modified: 19.4.1996 / 15:12:36 / cg"
!
origin:origin corner:corner
"set both origin and extent"
|newLeft newTop newRight newBot|
explicitExtent := true.
"do it as one operation if possible"
origin isBlock ifFalse:[
corner isBlock ifFalse:[
newLeft := origin x.
newLeft isInteger ifTrue:[
newTop := origin y.
newTop isInteger ifTrue:[
newRight := corner x.
newRight isInteger ifTrue:[
newBot := corner y.
newBot isInteger ifTrue:[
self pixelOrigin:origin corner:corner
]
]
]
]
]
].
self origin:origin.
self corner:corner
"Modified: 15.7.1996 / 09:52:43 / cg"
!
origin:origin extent:extent
"set both origin and extent"
|newLeft newTop newWidth newHeight|
explicitExtent := true.
"do it as one operation if possible"
origin isBlock ifFalse:[
extent isBlock ifFalse:[
newLeft := origin x.
newLeft isInteger ifTrue:[
newTop := origin y.
newTop isInteger ifTrue:[
newWidth := extent x.
newWidth isInteger ifTrue:[
newHeight := extent y.
newHeight isInteger ifTrue:[
self pixelOrigin:origin extent:extent
]
]
]
]
]
].
self extent:extent.
self origin:origin
"Modified: 15.7.1996 / 09:52:39 / cg"
!
originRelativeTo:aView
"return the origin (in pixels) relative to a superView,
or relative to the rootView (if the aView argument is nil).
If the receiver is nonNil and not a subview of aView, return nil."
|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
].
(aView isNil or:[aView == device rootView]) ifTrue:[
"return relative to screen ..."
^ (sumX @ sumY)
].
^ nil
"
|top sub1 sub2|
top := StandardSystemView new.
top extent:200@200.
sub1 := View origin:0.2 @ 0.2 corner:0.8 @ 0.8 in:top.
sub2 := Button origin:0.3 @ 0.3 corner:0.7 @ 0.7 in:sub1.
top openAndWait.
Transcript show:'button in top:'; showCR:(sub2 originRelativeTo:top).
Transcript show:'button on screen:'; showCR:(sub2 originRelativeTo:nil).
"
!
originRule
"return the origin block - non public; this will vanish without notice"
^ originRule
!
preferredExtent:anExtentPoint
"override the views own preferredExtent computation,
and let it prefer the size given by the argument."
preferredExtent := anExtentPoint.
"Modified: 22.8.1996 / 13:41:47 / cg"
!
relativeCorner
"return the relative corner or nil"
^ relativeCorner
!
relativeCorner:aPoint
"set the relative corner"
relativeCorner := aPoint
!
relativeExtent
"return the relative extent or nil"
^ relativeExtent
!
relativeExtent:aPoint
"set the relative extent"
relativeExtent := aPoint
!
relativeOrigin
"return the relative origin or nil"
^ relativeOrigin
!
relativeOrigin:aPoint
"set the relative origin"
relativeOrigin := aPoint
!
right
"return the x position of the right edge (in pixels)"
^ left + width - 1
"Modified: 31.8.1995 / 19:31:10 / claus"
!
right:aNumber
"set the corners x position"
self corner:(aNumber @ self corner y)
!
rightInset
"return the inset of the right edge; positive is to the left,
negative to the right"
insets isNil ifTrue:[^ 0].
^ insets at:3
!
rightInset:aNumber
"set the inset of the right edge;
positive is to the left (view becomes smaller),
negative to the right (becomes larger)"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:3 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:32 / cg"
!
sizeFixed:aBoolean
"set/clear the fix-size attribute, if supported by concrete subclasses.
Views which want to resize themselfes as appropriate to their contents
should cease to do so and take their current size if sizeFixed is set to
true. Currently, only supported by Labels.
This does NOT prevent the window manager from resizing the view,
instead it tell the view to NOT resize ITSELF.
Added here to provide a common protocol for all views."
^ self
!
top
"return the y position of the top border"
^ top
!
top:aNumber
"set the y position"
self origin:(left @ aNumber)
!
topInset
"return the inset of the top edge; positive is to the bottom,
negative to the top"
insets isNil ifTrue:[^ 0].
^ insets at:2
!
topInset:aNumber
"set the inset of the top edge;
positive is to the bottom (view becomes smaller),
negative to the top (becomes larger)"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:2 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:45 / cg"
!
verticalInset:aNumber
"set the insets of the top/bottom edge;
positive makes it smaller, negative makes it larger"
insets isNil ifTrue:[
insets := Array with:0 with:0 with:0 with:0
].
insets at:2 put:aNumber.
insets at:4 put:aNumber.
"force recomputation"
"/ drawableId isNil ifTrue:[
"/ originChanged := true
"/ ] ifFalse:[
self containerChangedSize.
"/ ]
"Modified: 19.7.1996 / 17:30:50 / cg"
!
viewRectangle
"return the inside area.
This is used by relative sized subviews and layout-computations
to base relative coordinates on.
For most views, the value returned here (actual extent minus any
margins required for 3D levels) is ok.
However, views which want some extra area around (for example: FramedBox)
may redefine this method to return a rectangle without this area
(thus, a relative sized subviews coordinates will be based on this net area) "
|m2|
m2 := margin + margin.
^ (margin @ margin) extent:((width - m2) @ (height - m2))
"Modified: 8.2.1996 / 20:05:00 / cg"
!
width:aNumber
"set the views width in pixels"
self extent:(aNumber @ height)
!
widthIncludingBorder
"return my width including border
(this is my width as seen from the outside view;
while #width returns the width as seen by myself)"
^ width + (2*borderWidth)
! !
!SimpleView methodsFor:'accessing-hierarchy'!
components
"return the collection of non-view components"
^ components
"Created: 28.5.1996 / 23:59:37 / cg"
!
container
"return my container"
^ superView
"Created: 5.6.1996 / 01:08:36 / cg"
"Modified: 10.1.1997 / 19:47:59 / cg"
!
container:aContainer
"set my container (i.e. superView) to be aContainer"
(superView notNil and:[superView ~~ aContainer]) ifTrue:[
"/ actually, this is worth an exception
('View [warning]: ' , self printString , ' already has a container') errorPrintCR.
superView removeComponent:self.
].
superView := aContainer
"Created: 9.5.1996 / 00:40:56 / cg"
"Modified: 29.1.1997 / 17:37:38 / cg"
!
lower
"bring to back"
drawableId isNil ifTrue:[self create].
device lowerWindow:drawableId
"
Transcript topView lower
"
!
raise
"bring to front"
drawableId isNil ifTrue:[self create].
device raiseWindow:drawableId
"
Transcript topView raise
"
!
subViews
"return the collection of subviews"
^ subViews
!
subViews:aListOfViews
"set the collection of subviews"
subViews := aListOfViews.
subViews notNil ifTrue:[
subViews do:[:view |
view container:self
]
]
"Modified: 9.5.1996 / 00:42:28 / cg"
!
superView
"return my superView"
^ superView
!
superView:aView
"set my superView to be aView"
self obsoleteMethodWarning:'use #container:'.
self container:aView.
"Modified: 9.5.1996 / 00:46:24 / cg"
!
topComponent
"return the topmost component - thats the one with no superview.
For ST-80 compatibility."
^ self topView
"Modified: 9.5.1996 / 01:40:24 / cg"
!
topView
"return the topView - thats the one with no superview"
|v next|
v := self.
[v notNil] whileTrue:[
(next := v container) isNil ifTrue:[^ v].
v := next
].
^ nil
"Modified: 5.6.1996 / 01:09:12 / cg"
!
view
"return my view - for real views, thats the receiver.
For wrappers, its the real view that contains it"
^ self
"Created: 4.6.1996 / 21:32:11 / cg"
! !
!SimpleView methodsFor:'accessing-menus'!
menuHolder
"who has the menu ?
By default, I have it."
^ self
!
menuMessage
"Return the symbol sent to myself to aquire the menu"
^ #middleButtonMenu
!
menuPerformer
"who should perform the menu actions ?
By default, I do it."
^ self
!
yellowButtonMenu
"actually, this should be called 'middleButtonMenu'.
But for ST-80 compatibility ....
This method will vanish, once all views have controllers
associated with them; for now, duplicate some code also found in
controller."
|sym menuHolder|
"/ middleButtonMenu notNil ifTrue:[
"/ "/
"/ "/ has been assigned a static middleButtonMenu
"/ "/ (or a cached menu)
"/ "/
"/ ^ middleButtonMenu
"/ ].
menuHolder := self menuHolder.
menuHolder notNil ifTrue:[
sym := self menuMessage.
sym notNil ifTrue:[
"
mhmh - for backward compatibility, try to ask
the model first, then use the views menu.
"
(menuHolder respondsTo:sym) ifFalse:[
(self respondsTo:sym) ifTrue:[
menuHolder := self
]
].
"
ask the menuHolder for the menu
"
^ menuHolder perform:sym.
].
].
^ nil
! !
!SimpleView methodsFor:'accessing-misc'!
bitGravity
"return the bitGravity - thats the direction where the contents will move
when the the view is resized."
^ bitGravity
!
bitGravity:gravity
"set the bitGravity - thats the direction where the contents will move
when the view is resized."
bitGravity ~~ gravity ifTrue:[
bitGravity := gravity.
drawableId notNil ifTrue:[
device setBitGravity:gravity in:drawableId
]
]
!
clippingRectangle:aRectangle
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turns off clipping (i.e. whole view is drawable).
Redefined to care for any margin."
|x y w h|
aRectangle isNil ifTrue:[
clipRect isNil ifTrue:[^ self].
gcId notNil ifTrue:[
device noClipIn:gcId
]
] ifFalse:[
clipRect notNil ifTrue:[
(clipRect = aRectangle) ifTrue:[^ self]
].
gcId notNil ifTrue:[
x := aRectangle left.
y := aRectangle top.
w := aRectangle width.
h := aRectangle height.
transformation notNil ifTrue:[
x := transformation applyToX:x.
y := transformation applyToY:y.
w := transformation applyScaleX:w.
h := transformation applyScaleY:h.
].
(x isMemberOf:SmallInteger) ifFalse:[
w := w + (x - x truncated).
x := x truncated
].
(y isMemberOf:SmallInteger) ifFalse:[
h := h + (y - y truncated).
y := y truncated
].
(w isMemberOf:SmallInteger) ifFalse:[
w := w truncated + 1
].
(h isMemberOf:SmallInteger) ifFalse:[
h := h truncated + 1
].
x < margin ifTrue:[
x := margin.
].
y < margin ifTrue:[
y := margin.
].
x + w - 1 >= (width-margin) ifTrue:[
w := width - margin - x
].
y + h - 1 >= (height-margin) ifTrue:[
h := height - margin - y
].
device setClipX:x y:y width:w height:h in:gcId
]
].
clipRect := aRectangle
"Created: 28.5.1996 / 19:50:03 / cg"
"Modified: 28.5.1996 / 22:32:15 / cg"
!
fullName
"return my full name to be used for resource-access"
superView notNil ifTrue:[
^ superView fullName , '.' , name
].
^ name
!
name
"return my name component to be used for resource-access"
^ name
!
name:aString
"set my name component to be used for resource-access"
name := aString
!
processName
"return a string to be shown in the process monitor"
^ self name
!
styleSheet
"return the styleSheet. This is set at early view-creation time,
from the defaultStyleSheet which is valid at that time.
It is not affected by later defaultStyle changes"
^ styleSheet
"Created: 10.9.1995 / 11:02:20 / claus"
!
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 ifTrue:[
viewGravity := gravity.
drawableId notNil ifTrue:[
device setWindowGravity:gravity in:drawableId
]
]
! !
!SimpleView methodsFor:'accessing-mvc'!
application
"return the application, under which this view was opened,
or nil, if there is no application"
|top|
(top := self topView) notNil ifTrue:[
top ~~ self ifTrue:[
^ top application
]
].
^ nil
"Modified: 13.1.1997 / 20:30:31 / cg"
!
aspect:aspectSymbol
"ST-80 style updating: If a views aspectSymbol is nonNil,
it will respond to changes of this aspect from the model.
Alias for aspectMessage: for ST-80 compatibility."
self aspectMessage:aspectSymbol
!
controller
"return the controller. For non MVC views, return nil"
^ controller
!
controller:aController
"set the controller"
controller := aController.
controller notNil ifTrue:[
controller view:self.
]
!
model
"return nil - simpleViews have no model (only providing geometric)"
^ nil
"Modified: 5.6.1996 / 14:17:29 / cg"
!
sensor
"return the views sensor"
windowGroup notNil ifTrue:[
^ windowGroup sensor.
].
^ nil
"Modified: 10.1.1997 / 19:47:13 / cg"
!
setController:aController
"set the controller but do not affect the model/view releationship"
controller := aController.
"Created: 18.7.1996 / 11:43:40 / cg"
!
windowGroup
"return the window group. For old style views, return nil"
^ windowGroup
!
windowGroup:aGroup
"set the window group."
windowGroup := aGroup
! !
!SimpleView methodsFor:'accessing-transformation'!
maxComponentBottom
"return the maximum of all components bottom"
components isNil ifTrue:[^ 0].
^ components inject:0 into:[:maxSoFar :sub
| (sub bottom) max:maxSoFar].
"Created: 26.5.1996 / 12:44:05 / cg"
"Modified: 26.5.1996 / 12:56:39 / cg"
!
maxComponentRight
"return the maximum of all components rights"
components isNil ifTrue:[^ 0].
^ components inject:0 into:[:maxSoFar :sub
| (sub right) max:maxSoFar].
"Modified: 26.5.1996 / 12:56:39 / cg"
"Created: 26.5.1996 / 13:02:19 / cg"
!
maxSubViewBottom
"/ subViews isNil ifTrue:[^ 0].
"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub top + sub height) max:maxSoFar].
^ 0
!
maxSubViewRight
"/ subViews isNil ifTrue:[^ 0].
"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub left + sub width) max:maxSoFar].
^ 0
!
scale:aPoint
"set the scale factor of the transformation"
super scale:aPoint.
self computeInnerClip
!
setViewOrigin:aPoint
"set the viewOrigin - i.e. virtually scroll without redrawing"
|p|
p := aPoint negated.
transformation isNil ifTrue:[
transformation := WindowingTransformation scale:1 translation:p
] ifFalse:[
transformation translation:p
].
clipRect notNil ifTrue:[
self setInnerClip.
].
!
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)."
transformation isNil ifTrue:[
^ 0@0
].
^ transformation translation negated
!
visibleArea
"return the rectangle that contains the visible part
of the view in user coordinates."
transformation isNil ifTrue:[
^ Rectangle left:0 top:0 width:width height:height.
].
^ Rectangle origin:(transformation translation negated)
extent:((width @ height) scaledBy:(transformation scale)).
"Created: 12.7.1996 / 11:57:04 / stefan"
!
xOriginOfContents
"return the x coordinate of the viewOrigin in pixels;
used by scrollBars to compute thumb position within the document."
^ self viewOrigin x
!
yOriginOfContents
"return the y coordinate of the viewOrigin in pixels;
used by scrollBars to compute thumb position within the document."
^ self viewOrigin y
! !
!SimpleView methodsFor:'accessing-visibility'!
beInvisible
self hiddenOnRealize:true.
realized ifTrue:[
(superView isNil "/ I am a topView
or:[superView realized]) "/ superview already shown
ifTrue:[
self unmap
]
]
"Created: 22.9.1995 / 15:29:01 / claus"
"Modified: 3.5.1996 / 23:49:12 / stefan"
"Modified: 25.2.1997 / 22:43:09 / cg"
!
beVisible
self hiddenOnRealize:false.
realized ifFalse:[
superView isNil "/ I am a topView
ifTrue:[
self remap
] ifFalse:[
superView realized "/ superview already shown
ifTrue:[
self realize
]
]
]
"
|top topFrame check list|
top := StandardSystemView new.
top extent:150@400.
topFrame := VerticalPanelView origin:0.0@0.0 corner:1.0@0.4 in:top.
topFrame horizontalLayout:#leftSpace.
topFrame add:(check := CheckBox label:'hidden').
check pressAction:[list beInvisible].
check releaseAction:[list beVisible].
list := ScrollableView for:SelectionInListView.
list origin:0.0@0.4 corner:1.0@1.0.
list list:#('foo' 'bar' 'baz').
top add:list.
check turnOn.
list beInvisible.
top open
"
"Created: 22.9.1995 / 15:50:33 / claus"
"Modified: 25.5.1996 / 12:05:28 / cg"
!
hidden
"return true, if the view does not want to be realized
automatically when superview is realized"
self obsoleteMethodWarning:'use #isHiddenOnRealize'.
^ hiddenOnRealize
"Modified: 17.1.1996 / 11:44:47 / cg"
!
hidden:aBoolean
"if the argument is true, the receiver view will not
be realized automatically when superview is realized"
self obsoleteMethodWarning:'use #beVisible / #beInvisible'.
hiddenOnRealize := aBoolean
"Modified: 17.1.1996 / 11:45:06 / cg"
!
hiddenOnRealize:aBoolean
"if the argument is true, the receiver view will not
be mapped automatically when the superview is realized.
The hiddenOnRealize flag is useful to create views which are
to be made visible conditionally or later."
hiddenOnRealize := aBoolean
!
isHiddenOnRealize:aBoolean
"return true, if the receiver will NOT be mapped when
realized. False otherwise.
The hiddenOnRealize flag is useful to create views which are
to be made visible conditionally or later."
^ hiddenOnRealize
!
shown
"return true if the view is shown; false if not.
Shown means: the view is mapped and is not completely covered."
^ shown
! !
!SimpleView methodsFor:'adding & removing components'!
add:aComponent
"add a component (either a view or gadget) to the collection of
subComponents."
self addComponent:aComponent
!
add:aComponent at:anOrigin
"for ST-80 compatibility.
add a component at some origin"
|l comp|
(aComponent isWrapper not
or:[aComponent isLayoutWrapper not]) ifTrue:[
comp := LayoutWrapper on:aComponent
] ifFalse:[
comp := aComponent
].
l := anOrigin asLayout.
comp layout:l.
self addComponent:comp
"Modified: 12.2.1997 / 11:55:33 / cg"
!
add:aComponent in:aRectangleOrLayoutFrame
"for ST-80 compatibility.
add a component in some frame; the argument may be either a rectangle
with relative coordinates, or an instance of LayoutFrame, specifying
both relative coordinates and the insets."
|l|
l := aRectangleOrLayoutFrame asLayout.
"/ will soon be replaced by:
"/ aComponent layout:l.
aComponent geometryLayout:l.
self addComponent:aComponent
"Modified: 29.5.1996 / 15:12:50 / cg"
!
addComponent:aComponent
"components (i.e. gadgets or lightweight views) are being prepared.
Dont use this right now for non-views"
aComponent isView ifTrue:[
self addSubView:aComponent
] ifFalse:[
components isNil ifTrue:[
components := OrderedCollection new
].
components add:aComponent.
aComponent container:self.
shown ifTrue:[
aComponent displayOn:self
]
]
"Modified: 13.5.1996 / 21:19:51 / cg"
!
addSubView:newView
"add a view to the collection of subviews"
subViews isNil ifTrue:[
subViews := OrderedCollection with:newView
] ifFalse:[
subViews add:newView.
].
self setContainerIn:newView.
"Modified: 9.5.1996 / 00:47:16 / cg"
!
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:[
aView isNil ifTrue:[
subViews add:newView
] ifFalse:[
subViews add:newView after:aView.
]
].
self setContainerIn:newView.
"Modified: 9.5.1996 / 00:47:20 / cg"
!
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:[
aView isNil ifTrue:[
subViews addFirst:newView
] ifFalse:[
subViews add:newView before:aView.
]
].
self setContainerIn:newView.
"Modified: 9.5.1996 / 00:47:23 / cg"
!
addSubView:aView in:bounds borderWidth:bw
"for ST-80 V2.x compatibility"
aView borderWidth:bw.
self add:aView in:bounds.
!
addSubViewFirst:newView
"add a view to the front of the collection of subviews"
subViews isNil ifTrue:[
subViews := OrderedCollection with:newView
] ifFalse:[
subViews addFirst:newView.
].
self setContainerIn:newView.
"Modified: 9.5.1996 / 00:47:16 / cg"
"Created: 6.3.1997 / 18:43:38 / cg"
!
component:aComponent
"components (i.e. gadgets or lightweight views) are being prepared.
Dont use this right now for non-views"
aComponent origin:0.0@0.0 corner:1.0@1.0.
aComponent isView ifTrue:[
self addSubView:aComponent
] ifFalse:[
components := OrderedCollection with:aComponent.
aComponent container:self.
shown ifTrue:[
aComponent displayOn:self
]
]
"Modified: 13.5.1996 / 21:20:29 / cg"
!
destroySubViews
"remove all subviews"
subViews notNil ifTrue:[
subViews copy do:[:aSubView |
aSubView destroy.
].
"/ paranoia ;-)
subViews size ~~ 0 ifTrue:[
('View [warning]: some subView(s) did not destroy: ' , subViews printString) infoPrintCR.
subViews := nil
].
]
"Modified: 5.9.1995 / 22:35:36 / claus"
"Modified: 29.1.1997 / 17:07:45 / cg"
!
removeComponent:aComponent
"components (i.e. gadgets or lightweight views) are being prepared.
Dont use this right now for non-views"
aComponent isView ifTrue:[
self removeSubView:aComponent
] ifFalse:[
components isNil ifTrue:[^self].
components remove:aComponent ifAbsent:[].
aComponent parent:nil
]
!
removeSubView:aView
"remove a view from the collection of subviews"
subViews notNil ifTrue:[
subViews remove:aView ifAbsent:[nil].
(subViews size == 0) ifTrue:[
subViews := nil
]
]
!
setContainerIn:aView
"common code for addSubView* methods"
aView container:self.
(aView graphicsDevice ~~ device) ifTrue:[
'SimpleView [warning]: subview (' errorPrint. aView class name errorPrint.
') has different device than me (' errorPrint.
self class name errorPrint. ').' errorPrintCR.
aView device:device
]
"Created: 9.5.1996 / 00:46:59 / cg"
"Modified: 10.1.1997 / 18:06:49 / cg"
! !
!SimpleView methodsFor:'change & update'!
changedPreferredBounds:someArgument
"tell any dependents, that I have changed my preferred bounds;
Interface is provided mostly provided for ST80 compatibility;
here, translate into ST/X's mechanism for telling others about this."
^ self changed:#preferredExtent
"Modified: 6.3.1997 / 16:12:02 / cg"
!
update:aspect with:aParameter from:changedObject
"an update request"
aspect == #sizeOfView ifTrue:[
"one of the views we depend on changed its size"
^ self containerChangedSize.
].
^super update:aspect with:aParameter from:changedObject
"Modified: 19.7.1996 / 17:30:48 / cg"
! !
!SimpleView methodsFor:'cursor animation'!
showBusyWhile:aBlock
"evaluate some time consuming block, while doing this,
show a spinning wheel cursor"
|ok bitmaps cursors mask process oldCursor|
oldCursor := cursor.
ok := true.
bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4')
collect:[:name |
|f|
f := Image fromFile:('bitmaps/' , name , '.xbm').
f isNil ifTrue:[
('SimpleView [warning]: no bitmap file: ' , name , '.xbm') errorPrintCR.
ok := false
].
f
].
mask := Image fromFile:'bitmaps/wheelm.xbm'.
mask isNil ifTrue:[
('SimpleView [warning]: no bitmap file: wheelm.xbm') errorPrintCR.
ok := false
].
ok ifFalse:[
self cursor:Cursor wait.
aBlock valueNowOrOnUnwindDo:[
self cursor:oldCursor
]
] ifTrue:[
cursors := bitmaps collect:[:form | (Cursor sourceForm:form
maskForm:mask
hotX:8
hotY:8) on:device].
process := [
Delay waitForSeconds:0.25.
[true] whileTrue:[
cursors do:[:curs |
self cursor:curs.
Delay waitForSeconds:0.05
]
]
] fork.
Processor activeProcess priority:7.
aBlock valueNowOrOnUnwindDo:[
Processor activeProcess priority:8.
process terminate.
self cursor:oldCursor
]
].
"
View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
"
"Modified: 10.1.1997 / 18:07:23 / cg"
! !
!SimpleView methodsFor:'drag & drop'!
canDrop:anObjectOrCollection
"return true, if anObjectOrCollection can be
dropped in the receiver. This method should be
redefined in views which can take objects"
|app|
(app := self application) notNil ifTrue:[
^ app canDrop:anObjectOrCollection in:self
].
^ false
!
drop:anObjectOrCollection at:aPoint
"drop manager wants to drop.
If I have an application, forward the request.
Otherwise, ignore it. This is only sent, if #canDrop: returned true;
if you redefined #canDrop: in a subclass, #drop:at: must also be redefined."
|app|
(app := self application) notNil ifTrue:[
^ app drop:anObjectOrCollection in:self at:aPoint
].
self subclassResponsibility
! !
!SimpleView methodsFor:'edge drawing'!
drawBottomEdge
"draw bottom 3D edge into window frame"
self drawBottomEdgeLevel:level
shadow:shadowColor
light:lightColor
halfShadow:nil
halfLight:nil
style:nil.
!
drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|botFg
count "{ Class: SmallInteger }"
b r|
count := level.
count == 0 ifTrue:[^ self].
(count < 0) ifTrue:[
botFg := lightColor.
count := count negated
] ifFalse:[
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
botFg := halfShadowColor
] ifFalse:[
botFg := shadowColor
].
].
super paint:botFg.
super lineWidth:0.
r := width - 1.
0 to:(count - 1) do:[:i |
b := height - 1 - i.
super displayDeviceLineFromX:i y:b toX:(r - i) y:b
].
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
b := height - 1.
super paint:shadowColor.
super displayDeviceLineFromX:1 y:b toX:r y:b.
].
self edgeDrawn:#bottom.
"Modified: 7.3.1997 / 17:59:39 / cg"
!
drawEdges
"draw all of my 3D edges"
self drawEdgesForX:0 y:0 width:width height:height level:level
shadow:shadowColor
light:lightColor
halfShadow:nil
halfLight:nil
style:nil
!
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:nil
halfLight:nil
style:nil
!
drawLeftEdge
"draw left 3D edge into window frame"
self drawLeftEdgeLevel:level
shadow:shadowColor
light:lightColor
halfShadow:nil
halfLight:nil
style:nil.
!
drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|leftFg leftHalfFg paint b
count "{ Class: SmallInteger }" |
count := level.
count == 0 ifTrue:[^ self].
(count < 0) ifTrue:[
leftFg := shadowColor.
leftHalfFg := halfShadowColor.
count := count negated.
] ifFalse:[
leftFg := lightColor.
leftHalfFg := halfLightColor.
].
leftHalfFg isNil ifTrue:[
leftHalfFg := leftFg
].
((edgeStyle == #soft) and:[level > 0]) ifTrue:[
paint := leftHalfFg
] ifFalse:[
paint := leftFg
].
super paint:paint.
super lineWidth:0.
b := height - 1.
0 to:(count - 1) do:[:i |
super displayDeviceLineFromX:i y:i toX:i y:(b - i)
].
((edgeStyle == #soft) and:[level > 2]) ifTrue:[
super paint:(device blackColor).
super displayDeviceLineFromX:0 y:0 toX:0 y:b.
].
self edgeDrawn:#left.
"Modified: 7.3.1997 / 17:59:53 / cg"
!
drawRightEdge
"draw right 3D edge into window frame"
self drawRightEdgeLevel:level
shadow:shadowColor
light:lightColor
halfShadow:nil
halfLight:nil
style:nil.
!
drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|rightFg
count "{ Class: SmallInteger }"
r b|
count := level.
count == 0 ifTrue:[^ self].
(count < 0) ifTrue:[
rightFg := lightColor.
count := count negated
] ifFalse:[
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
rightFg := halfShadowColor
] ifFalse:[
rightFg := shadowColor
].
].
super paint:rightFg.
super lineWidth:0.
b := height - 1.
0 to:(count - 1) do:[:i |
r := width - 1 - i.
super displayDeviceLineFromX:r y:i toX:r y:(b - i)
].
((edgeStyle == #soft) and:[level > 1]) ifTrue:[
r := width - 1.
super paint:shadowColor.
super displayDeviceLineFromX:r y:1 toX:r y:b.
].
self edgeDrawn:#right.
"Modified: 7.3.1997 / 18:00:02 / cg"
!
drawTopEdge
"draw top 3D edge into window frame"
self drawTopEdgeLevel:level
shadow:shadowColor
light:lightColor
halfShadow:nil
halfLight:nil
style:nil.
!
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|topFg topHalfFg paint r
count "{ Class: SmallInteger }" |
count := level.
count == 0 ifTrue:[^ self].
(count < 0) ifTrue:[
topFg := shadowColor.
topHalfFg := halfShadowColor.
count := count negated
] ifFalse:[
topFg := lightColor.
topHalfFg := halfLightColor.
].
topHalfFg isNil ifTrue:[
topHalfFg := topFg
].
((edgeStyle == #soft) and:[level > 0]) ifTrue:[
paint := topHalfFg
] ifFalse:[
paint := topFg
].
super paint:paint.
super lineWidth:0.
r := width - 1.
0 to:(count - 1) do:[:i |
super displayDeviceLineFromX:i y:i toX:(r - i) y:i
].
((edgeStyle == #soft) and:[level > 2]) ifTrue:[
super paint:(device blackColor).
super displayDeviceLineFromX:0 y:0 toX:r y:0.
].
self edgeDrawn:#top.
"Modified: 7.3.1997 / 18:00:11 / cg"
!
redrawEdges
"redraw my edges (if any)"
(level ~~ 0) ifTrue:[
shown ifTrue:[
self clippingRectangle:nil.
self drawEdges.
self clippingRectangle:innerClipRect
]
]
"Modified: 28.5.1996 / 20:04:51 / cg"
! !
!SimpleView methodsFor:'enumerating subviews'!
allSubViewsDo:aBlock
"evaluate aBlock for all subviews (recursively)"
subViews notNil ifTrue:[
subViews do:[:aSubview |
aSubview withAllSubViewsDo:aBlock
]
]
"Modified: 12.2.1997 / 12:23:38 / cg"
!
changeSequenceOrderFor:aSubView to:anIndex
"change a subview's position into subviews collection
"
|aView|
(subViews notNil and:[subViews size >= anIndex]) ifTrue:[
aView := subViews remove:aSubView ifAbsent:nil.
aView notNil ifTrue:[
subViews add:aView beforeIndex:anIndex.
^ true
]
].
^ false
!
withAllSubViewsDo:aBlock
"evaluate aBlock for the receiver and all subviews (recursively)"
aBlock value:self.
self allSubViewsDo:aBlock
! !
!SimpleView methodsFor:'event handling'!
activateMenu
"activate my menu.
If there is a static middleButtonMenu, that one is taken,
and handled in the superClass (static menus are a historic leftOver).
Otherwise, the follwing steps are performed:
- ask the receiver for the menu (via #yellowButtonMenu)
- ask the receiver for the menuPerformer.
- startUp the menu - it is supposed to return an actionSelector
- if the menuPerformer responds to the selector,
send it to the performer;
otherwise send it to the view (the receiver)
This is funny, it allows additional menuItems to be added
AND still get the views copy/cut/paste functionality.
Without this, you had to redefine and forward all of those
messages in the performer."
|menu menuPerformer actionSelector actionArg haveArg prevReceiver|
middleButtonMenu isNil ifTrue:[
haveArg := false.
"
try ST-80 style menus first:
if there is a model, and a menuMessage is defined,
ask model for the menu and launch that if non-nil.
"
menu := self yellowButtonMenu.
menu notNil ifTrue:[
"
got one, launch the menu. It is supposed
to return an actionSelector.
"
menuPerformer := self menuPerformer.
"
a temporary kludge:
pass myself as receiver, the menuPerformer as performer;
the menu will send its messages to either the
menuPerformer or me (its receiver).
This allows for the ST-80 behavior, where some messages
go to the model, others to the view
(copy/cut/paste).
"
(prevReceiver := menu receiver) isNil ifTrue:[
"/ menu receiver:menuPerformer.
menu menuPerformer:menuPerformer.
menu receiver:self.
].
"/
"/ startup the menu - this returns a selector
"/
actionSelector := menu startUp.
actionSelector notNil ifTrue:[
"
mhmh - kludge for selectors with argument
"
(actionSelector isMemberOf:Array) ifTrue:[
actionArg := actionSelector at:2.
actionSelector := actionSelector at:1.
haveArg := true.
].
"
mhmh - ST-80 seems to send some to the model and
others (copy/cut/paste) to the controller/view
Simulate this behavior, by looking what the model responds to.
"
actionSelector isSymbol ifTrue:[
(menuPerformer respondsTo:actionSelector) ifFalse:[
(self respondsTo:actionSelector) ifTrue:[
menuPerformer := self
]
].
actionSelector numArgs ~~ 0 ifTrue:[
menuPerformer perform:actionSelector with:actionArg
] ifFalse:[
menuPerformer perform:actionSelector
]
].
].
menu receiver:prevReceiver.
^ self
].
].
"/
"/ old style static menu
"/
super activateMenu
"Created: 1.3.1996 / 13:24:18 / cg"
"Modified: 21.1.1997 / 15:33:47 / cg"
!
buttonPress:button x:x y:y
"button was pressed - check my components for a hit."
components notNil ifTrue:[
self componentsContainingX:x y:y do:[:comp :cx :cy |
comp buttonPress:button x:cx y:cy.
^ self
]
].
super buttonPress:button x:x y:y
"Modified: 8.5.1996 / 23:43:41 / cg"
!
buttonRelease:button x:x y:y
"button was released - check my components for a hit."
components notNil ifTrue:[
self componentsContainingX:x y:y do:[:comp :cx :cy |
comp buttonRelease:button x:cx y:cy.
^ self
]
].
super buttonRelease:button x:x y:y
"Modified: 8.5.1996 / 23:41:58 / cg"
"Created: 8.5.1996 / 23:43:25 / cg"
!
configureX:x y:y width:newWidth height:newHeight
"my size has changed by window manager action"
|how anyEdge mustRedrawBottomEdge mustRedrawRightEdge p|
(superView isNil
and:[drawableId notNil]) ifTrue:[
"/ have to be careful - some window managers (motif) wrap another
"/ view around and the reported origin is relative to that.
"/ not relative to the screen.
p := device translatePoint:0@0 from:drawableId to:device rootWindowId.
left := p x.
top := p y.
] ifFalse:[
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
].
level ~~ 0 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.
"
must first process pending exposes;
otherwise, those may be drawn at a wrong position
"
"/ claus: no; expose events are in the same queue as configure events;
"/ which is exactly for that reason ...
"/ windowGroup notNil ifTrue:[
"/ windowGroup processExposeEvents
"/ ].
self sizeChanged:how.
(anyEdge and:[shown]) ifTrue:[
self clippingRectangle:nil.
mustRedrawBottomEdge ifTrue:[
self drawBottomEdge
].
mustRedrawRightEdge ifTrue:[
self drawRightEdge
].
self clippingRectangle:innerClipRect
]
]
"Modified: 19.7.1996 / 21:28:47 / cg"
!
containerChangedSize
"my container has changed size; if I have relative
origin/extent or blocks to evaluate, do it now .."
|oldWidth oldHeight oldTop oldLeft newExt newOrg r|
oldWidth := width.
oldHeight := height.
oldTop := top.
oldLeft := left.
"
slowly migrating to use layoutObjects ...
"
layout isNil ifTrue:[
newOrg := self computeOrigin.
newExt := self computeExtent.
] ifFalse:[
r := (layout rectangleRelativeTo:(superView viewRectangle)
preferred:(self preferredBounds)).
newOrg := r origin rounded.
newExt := r extent rounded.
"/ newOrg printNL.
"/ newExt printNL.
].
newOrg notNil ifTrue:[
((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
newOrg := nil
]
].
newExt notNil ifTrue:[
((newExt x == width) and:[newExt y == height]) ifTrue:[
newExt := nil
]
].
newExt isNil ifTrue:[
newOrg notNil ifTrue:[
self pixelOrigin:newOrg
]
] ifFalse:[
newOrg isNil ifTrue:[
self pixelExtent:newExt
] ifFalse:[
self pixelOrigin:newOrg extent:newExt
]
]
"Modified: 19.7.1996 / 17:32:50 / cg"
!
containerMapped
"my container was mapped (became visible).
If I was previously realized, this implies that I myself
am now mapped as well."
"/ if I was not previously shown, tell it to all of
"/ my subviews (they remember this in the shown instVar)
realized ifTrue:[
shown ifFalse:[
"/ old:
"/ shown := true.
"/ subViews notNil ifTrue:[
"/ subViews do:[:v |
"/ v containerMapped
"/ ]
"/ ]
"/ which is equivalent to:
self mapped.
]
].
"Modified: 30.5.1996 / 11:41:02 / cg"
"Created: 19.7.1996 / 17:41:10 / cg"
!
containerUnmapped
"my container was unmapped
- this implies that the recevier is now also unmapped."
"/ if I was previously shown, tell it to all of
"/ my subviews (they remember this in the shown instVar)
realized ifTrue:[
shown ifTrue:[
self unmapped
]
]
"Modified: 30.5.1996 / 11:41:25 / cg"
"Created: 19.7.1996 / 17:43:50 / cg"
!
coveredBy:aView
"the receiver has been covered by another view;
we are not interested in that here (but see modalBox for more)."
!
destroyed
"view has been destroyed by someone else (usually window system)"
shown := false.
super destroyed
!
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 old|
nw := w.
nh := h.
nx := x.
ny := y.
anyEdge := false.
"
check if there is a need to draw an edge (i.e. if margin is hit)
"
(margin ~~ 0) ifTrue:[
leftEdge := false.
topEdge := false.
rightEdge := false.
botEdge := false.
transformation notNil ifTrue:[
"
need device coordinates for this test
"
nx := transformation applyToX:nx.
ny := transformation applyToY:ny.
nw := transformation applyScaleX:nw.
nh := transformation applyScaleY:nh.
].
"
adjust expose rectangle, to exclude the margin.
Care for rounding errors ...
"
(nx isMemberOf:SmallInteger) ifFalse:[
old := nx.
nx := nx truncated.
nw := nw + (nx - old).
].
(ny isMemberOf:SmallInteger) ifFalse:[
old := ny.
ny := ny truncated.
nh := nh + (ny - old).
].
(nw isMemberOf:SmallInteger) ifFalse:[
nw := nw truncated + 1
].
(nh isMemberOf:SmallInteger) ifFalse:[
nh := nh truncated + 1
].
(nx < margin) ifTrue:[
old := nx.
nx := margin.
nw := nw - (nx - old).
leftEdge := anyEdge := true.
].
((nx + nw - 1) >= (width - margin)) ifTrue:[
nw := (width - margin - nx).
rightEdge := anyEdge := true.
].
(ny < margin) ifTrue:[
old := ny.
ny := margin.
nh := nh - (ny - old).
topEdge := anyEdge := true.
].
((ny + nh - 1) >= (height - margin)) ifTrue:[
nh := (height - margin - ny).
botEdge := anyEdge := true.
].
transformation notNil ifTrue:[
"
need logical coordinates for redraw
"
nx := transformation applyInverseToX:nx.
ny := transformation applyInverseToY:ny.
nw := transformation applyInverseScaleX:nw.
nh := transformation applyInverseScaleY:nh.
].
].
(nw > 0 and:[nh > 0]) ifTrue:[
"
redraw inside area
"
self redrawX:nx y:ny width:nw height:nh.
].
"
redraw edge(s)
"
anyEdge ifTrue:[
self clippingRectangle:nil.
(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
self drawEdges
] ifFalse:[
topEdge ifTrue:[
self drawTopEdge
].
leftEdge ifTrue:[
self drawLeftEdge
].
botEdge ifTrue:[
self drawBottomEdge
].
rightEdge ifTrue:[
self drawRightEdge
]
].
self clippingRectangle:innerClipRect
]
"Modified: 28.5.1996 / 22:31:49 / cg"
!
focusIn
"got keyboard focus (via the window manager)"
delegate notNil ifTrue:[
(delegate respondsTo:#handlesKeyPress:inView:) ifTrue:[
(delegate handlesKeyPress:#Any inView:self) ifTrue:[
delegate showFocus:false.
^ self
]
]
].
self showFocus:false
"Modified: 28.2.1997 / 23:29:12 / cg"
!
focusOut
"lost keyboard focus (via the window manager)"
delegate notNil ifTrue:[
(delegate respondsTo:#handlesKeyPress:inView:) ifTrue:[
(delegate handlesKeyPress:#Any inView:self) ifTrue:[
delegate showNoFocus:false.
^ self
]
]
].
self showNoFocus:false
"Modified: 28.2.1997 / 23:29:23 / cg"
!
hasKeyboardFocus:aBoolean
^ self
!
keyPress:key x:x y:y
"a key has been pressed. If there are components,
pass it to the corresponding one.
Otherwise, forward it to the superview, if there is any."
<resource: #keyboard ( #Menu ) >
components notNil ifTrue:[
components notNil ifTrue:[
self componentsContainingX:x y:y do:[:comp :cx :cy |
comp keyPress:key x:cx y:cy.
^ self
]
].
].
key == #Menu ifTrue:[
^ self activateMenu.
].
x isNil ifTrue:[
"/ already redelegated, but nowhere handled
superView notNil ifTrue:[
superView keyPress:key x:nil y:nil.
].
^ self
].
superView notNil ifTrue:[
WindowEvent
sendEvent:#keyPress:x:y:
arguments:(Array with:key with:0 with:0)
view:superView
] ifFalse:[
super keyPress:key x:x y:y
]
"Modified: 18.7.1996 / 11:47:03 / cg"
!
keyRelease:key x:x y:y
"a key has been released. If there are components,
pass it to the corresponding one.
Otherwise, do whatever my superclass would do."
components notNil ifTrue:[
components notNil ifTrue:[
self componentsContainingX:x y:y do:[:comp :cx :cy |
comp keyRelease:key x:cx y:cy.
^ self
]
].
].
super keyRelease:key x:x y:y
"Modified: 8.5.1996 / 23:44:36 / cg"
"Created: 8.5.1996 / 23:45:28 / cg"
!
mapped
"the view has been mapped (by some outside
action - i.e. window manager de-iconified me)"
"
the old code was:
realized := true.
shown := true.
...
this created a race condition, if the view was
realized and shortly after unrealized - before the mapped event
arrived. This lead to realized being set to true even thought the
view was not.
Boy - that was a bad one (hard to reproduce and hard to find).
"
realized ifTrue:[
"/ currently, the 'shown ifFalse:' optimization is
"/ not ok, since 'shown' is also modified by visibilityChanges.
"/ Also, when remapped, X11 only sends a mapped event for the topView.
"/ Therefore, synthetically generate those #superViewMapped messages
"/ in any case.
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 redrawX:0 y:0 width:width height:height
].
subViews notNil ifTrue:[
subViews do:[:v |
v containerMapped
]
]
]
"Modified: 25.2.1997 / 22:41:34 / cg"
!
pointerEnter:state x:x y:y
"got mouse pointer"
self focusIn
"Modified: 25.2.1997 / 23:43:21 / cg"
!
pointerLeave:state
"got mouse pointer"
self focusOut
"Modified: 25.2.1997 / 23:43:17 / cg"
!
reparented
"the view has changed its parent by some outside
action - i.e. window manager has added a frame.
nothing done here"
^ self
!
saveAndTerminate
"window manager wants me to save and go away;
- notice, that not all window managers are nice enough to
send this event, but simply destroy the view instead.
Can be redefined in subclasses to do whatever is required
to prepare for restart."
^ self destroy
!
sizeChanged:how
"tell subviews if I change size.
How is either #smaller, #larger or nil, and is used to control the order,
in which subviews are notified (possibly reducing redraw activity)"
|subViews|
(subViews := self subViews) notNil ifTrue:[
(how isNil "false"
or:[how == #smaller]) ifTrue:[
subViews do:[:view |
view containerChangedSize
]
] 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 containerChangedSize
]
]
].
components notNil ifTrue:[
(how isNil "false"
or:[how == #smaller]) ifTrue:[
components do:[:view |
view containerChangedSize
]
] 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"
components reverseDo:[:view |
view containerChangedSize
]
]
].
self changed:#sizeOfView with:how.
superView notNil ifTrue:[
superView subViewChangedSize
]
"Modified: 28.1.1997 / 17:58:53 / cg"
!
subViewChangedSize
"some subview has changed its size; we are not interested
in that here, but some geometry managers redefine this, to reorganize
components if that happens."
^ self
"Created: 22.9.1995 / 14:44:59 / claus"
!
terminate
"window manager wants me to go away;
- notice, that not all window managers are nice enough to
send this event, but simply destroy the view instead.
Can be redefined in subclasses to do whatever cleanup is
required."
^ self destroy
!
unmapped
"the view has been unmapped
(either by some outside action - i.e. window manager iconified me,
or due to unmapping of my parentView)."
"/ if I was previously shown, tell it to all of
"/ my subviews (they remember this in the shown instVar)
"/ currently, the 'shown ifTrue:' optimization is
"/ not ok, since 'shown' is also modified by visibilityChanges.
"/ Also, when remapped, X11 only sends a mapped event for the topView.
"/ Therefore, synthetically generate those #superViewUnmapped messages
"/ in any case.
shown := false.
subViews notNil ifTrue:[
subViews do:[:v |
v containerUnmapped
]
]
"Modified: 25.2.1997 / 22:40:52 / cg"
!
visibilityChange:how
"the visibility of the view has changed (by some outside
action - i.e. window manager rearranged things).
Using this knowledge avoids useless redraw in obsucred views."
how == #fullyObscured ifTrue:[
shown := false
] ifFalse:[
shown := true.
]
! !
!SimpleView methodsFor:'event simulation'!
pushEvent:aSelector
"push some messageSend into my event queue -
I will perform the corresponding method when its time
to handle events (useful to update low-prio views from
a higher prio process, to avoid blocking in the high prio one)"
|sensor|
(sensor := self sensor) notNil ifTrue:[
sensor pushUserEvent:aSelector for:self
] ifFalse:[
self perform:aSelector
]
"
|v|
v := View new openAndWait.
v fill:Color red.
v pushEvent:#redraw
"
"Modified: 31.1.1997 / 16:09:27 / cg"
!
pushEvent:aSelector withArguments:args
"push some messageSend into my event queue -
I will perform the corresponding method when its time
to handle events (useful to update low-prio views from
a higher prio process, to avoid blocking in the high prio one)"
|sensor|
(sensor := self sensor) notNil ifTrue:[
sensor pushUserEvent:aSelector for:self withArguments:args
] ifFalse:[
self perform:aSelector
]
"
|v|
v := (Button label:'hello') openAndWait.
Delay waitForSeconds:1.
v pushEvent:#buttonPress:x:y: withArguments:#(1 10 10).
Delay waitForSeconds:1.
v pushEvent:#buttonRelease:x:y: withArguments:#(1 10 10).
"
"Modified: 31.1.1997 / 16:10:40 / cg"
! !
!SimpleView methodsFor:'informing others of changes'!
contentsChanged
"this one is sent, whenever contents changes size -
tell dependents about the change (i.e. scrollers)."
self changed:#sizeOfContents
!
originChanged:delta
"this one is sent, after the origin of my contents has changed -
tell dependents (i.e. scrollers) about this"
self changed:#originOfContents with:delta.
"/ subViews notNil ifTrue:[
"/ subViews do:[:aSubView |
"/ aSubView pixelOrigin:((aSubView left @ aSubView top) - delta)
"/ ]
"/ ]
!
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
! !
!SimpleView methodsFor:'initialization'!
defaultControllerClass
^ nil "/ Controller
!
defaultExtent
"return the default extent of my instances."
^ self class defaultExtent
"Created: 1.3.1996 / 19:20:46 / cg"
"Modified: 22.4.1996 / 23:38:27 / cg"
!
initEvents
"will be sent by create - can be redefined by subclasses to enable
view events"
^ self
!
initStyle
"this method sets up all style dependent things"
self initStyleSheet.
borderWidth := DefaultBorderWidth.
borderWidth isNil ifTrue:[borderWidth := 1].
viewBackground := DefaultViewBackgroundColor.
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor.
] ifFalse:[
device hasGrayscales ifTrue:[
DefaultLightColor := lightColor := viewBackground lightened.
] ifFalse:[
"
this seems strange: on B&W screens, we create the light color
darker than normal viewBackground (White) -
to make the boundary of the view visible
"
lightColor := Color gray:50
]
].
DefaultShadowColor notNil ifTrue:[
shadowColor := DefaultShadowColor.
] ifFalse:[
shadowColor := Black
].
lightColor := lightColor.
shadowColor := shadowColor.
borderColor := DefaultBorderColor.
font := self class defaultFont.
font := font on:device.
"Modified: 28.5.1996 / 21:13:58 / cg"
!
initStyleSheet
"this method gets the styleSheet"
"
when coming here the first time, we read the styleSheet
and keep the values in fast class variables
"
StyleSheet isNil ifTrue:[
DefaultStyle isNil ifTrue:[
"/ the very-very first time (no styleSheet yet)
View defaultStyle:#normal.
].
self class updateStyleCache
].
styleSheet := StyleSheet.
"Modified: 25.7.1996 / 22:00:06 / cg"
!
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 stylechange by being sent another initStyle with a new style value.
(in this case, it should set all of its style-dependent things, but
leave the state and contents as-is)"
|ext myClass controllerClass|
super initialize.
font := self class defaultFont.
shown := hiddenOnRealize := realized := false.
"fill in some defaults - some of them are usually redefined in subclasses
initialize methods"
myClass := self class.
name := myClass name "asString" asLowercaseFirst.
resources := myClass classResources.
level := margin := 0.
margin := 0.
self initStyle.
ext := self defaultExtent.
left := top := 0.
width := ext x.
height := ext y.
originChanged := extentChanged := false.
bitGravity := nil.
viewGravity := nil.
controllerClass := self defaultControllerClass.
controllerClass notNil ifTrue:[
controller := controllerClass new.
controller view:self.
].
"Modified: 1.3.1996 / 19:21:24 / cg"
!
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.
Notice, that static middleButtonmenus are a historic thing in ST/X;
you may prefer to create the menu dynamically (i.e. the ST-80 way)."
^ self
!
prepareForReinit
super prepareForReinit.
windowGroup notNil ifTrue:[
windowGroup reinitialize
]
!
reinitStyle
"this method is called for a style change"
|t|
self initStyle.
drawableId notNil ifTrue:[
"force a change"
t := borderWidth. borderWidth := nil. self borderWidth:t.
t := viewBackground. viewBackground := nil. self viewBackground:t.
self invalidate.
].
"Modified: 29.5.1996 / 18:03:45 / cg"
!
reinitialize
"this is called right after snapIn"
|myController|
"if I have already been reinited - return"
drawableId notNil ifTrue:[
^ self
].
"
superView must be there, first
"
superView notNil ifTrue:[
superView view id isNil ifTrue:[
superView view reinitialize
]
].
myController := controller.
controller := nil.
self recreate.
"if I was mapped, do it again"
realized ifTrue:[
"only remap if I have a superview - otherwise, I might be
a hidden iconView or menu ..."
superView notNil ifTrue:[
"/ shown ifTrue:[
device mapView:self id:drawableId iconified:false
atX:left y:top width:width height:height
"/ ].
].
].
"restore controller"
controller := myController
"Modified: 5.6.1996 / 19:38:22 / cg"
! !
!SimpleView methodsFor:'misc'!
grabPointer
"grab the pointer - that is: report all motion events relative to
myself, even if moved out of myself."
device grabPointerIn:drawableId
!
ungrabPointer
"ungrab the pointer"
device ungrabPointer
! !
!SimpleView methodsFor:'private'!
componentsContainingX:x y:y do:aBlock
components notNil ifTrue:[
components do:[:aComponent |
|thisFrame|
thisFrame := aComponent bounds.
(thisFrame containsPointX:x y:y) ifTrue:[
aBlock value:aComponent
value:x - thisFrame left
value:y - thisFrame top.
]
]
].
"Created: 8.5.1996 / 23:40:59 / cg"
!
computeInnerClip
"compute, but do not set the inside clip-area"
|m2 nX nY nW nH|
(margin ~~ 0) ifTrue:[
m2 := margin + margin.
nX := nY := margin.
nW := width - m2.
nH := height - m2.
transformation notNil ifTrue:[
nX := transformation applyInverseToX:nX.
nY := transformation applyInverseToY:nY.
nW := transformation applyInverseScaleX:nW.
nH := transformation applyInverseScaleY:nH.
].
innerClipRect := Rectangle
left:nX
top:nY
width:nW
height:nH
] ifFalse:[
"no clipping"
innerClipRect := nil
]
!
cornerFromRelativeCorner
"compute & return pixel corner from relativeCorner"
^ self cornerFromRelativeCorner:relativeCorner
!
cornerFromRelativeCorner:aPoint
"compute & return pixel corner from a relativeCorner, aPoint"
|p r b bw|
p := self pointFromRelative:aPoint.
bw := borderWidth.
insets isNil ifTrue:[
bw == 0 ifTrue:[
^ p
].
^ (p x - bw) @ (p y - bw)
].
r := (insets at:3) + bw.
b := (insets at:4) + bw.
"/ r := b := bw.
"/ rightInset notNil ifTrue:[
"/ r := rightInset + bw
"/ ].
"/ bottomInset notNil ifTrue:[
"/ b := bottomInset + bw
"/ ].
((r ~~ 0) or:[b ~~ 0]) ifTrue:[
^ (p x - r) @ (p y - b)
].
^ p
!
extentFromRelativeExtent
"compute & return pixel extent from relativeExtent"
^ self extentFromRelativeExtent:relativeExtent
!
extentFromRelativeExtent:aPoint
"compute & return pixel extent from relativeExtent, aPoint"
|rel newX newY inRect bw2 i|
superView isNil ifTrue:[
inRect := 0@0 extent:device extent
] ifFalse:[
inRect := superView viewRectangle.
].
bw2 := borderWidth * 2.
rel := aPoint x.
rel isInteger ifFalse:[
newX := (rel * (inRect width + bw2)) asInteger + inRect left.
(borderWidth ~~ 0) ifTrue:[
newX := newX - borderWidth
].
] ifTrue:[
newX := rel
].
rel := aPoint y.
rel isInteger ifFalse:[
newY := (rel * (inRect height + bw2)) asInteger + inRect top.
(borderWidth ~~ 0) ifTrue:[
newY := newY - borderWidth
].
] ifTrue:[
newY := rel
].
insets notNil ifTrue:[
i := insets at:1. "top"
(i ~~ 0) ifTrue:[
newX := newX - i
].
i := insets at:3. "left"
(i ~~ 0) ifTrue:[
newX := newX - i
].
i := insets at:2. "right"
(i ~~ 0) ifTrue:[
newY := newY - i
].
i := insets at:4. "bottom"
(i ~~ 0) ifTrue:[
newY := newY - i
].
].
^ newX @ newY
!
originFromRelativeOrigin
"compute & return pixel origin from relativeOrigin"
^ self originFromRelativeOrigin:relativeOrigin
!
originFromRelativeOrigin:aPoint
"compute & return pixel origin from relativeOrigin, aPoint"
|p l t|
p := self pointFromRelative:aPoint.
insets isNil ifTrue:[
^ p
].
l := insets at:1.
t := insets at:2.
"/ l := t := 0.
"/ leftInset notNil ifTrue:[
"/ l := leftInset
"/ ].
"/ topInset notNil ifTrue:[
"/ t := topInset
"/ ].
((l ~~ 0) or:[t ~~ 0]) ifTrue:[
^ (p x + l) @ (p y + t)
].
^ p
!
pixelCorner:corner
"set the views corner in pixels"
|w h|
w := corner x - left + 1.
h := corner y - top + 1.
self pixelOrigin:(left @ top) extent:(w @ h)
"Modified: 31.8.1995 / 18:20:22 / claus"
!
pixelExtent:extent
"set the views extent in pixels"
self pixelOrigin:(left @ top) extent:extent
!
pixelOrigin
"return the views origin in pixels. For subviews. the origin is relative
to the superviews top-left. For topViews, its the screen origin."
^ self computeOrigin
!
pixelOrigin:origin
"set the views origin in pixels. For subviews. the origin is relative
to the superviews top-left. For topViews, its the screen origin."
|newLeft newTop|
newLeft := origin x.
newTop := origin y.
((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
top := newTop.
left := newLeft.
"
if the receiver is visible, or is a topView, perform the
operation right away - otherwise, simply remember that the
origin has changed - will tell the display once we get realized
"
"/ (shown
"/ or:[superView isNil and:[drawableId notNil]]) ifTrue:[
"/ no, have to do it if drawableId is there
"/ (otherwise, we could not move unmapped views around ...
"/
drawableId notNil ifTrue:[
device moveWindow:drawableId x:left y:top
] ifFalse:[
originChanged := true
]
]
!
pixelOrigin:origin corner:corner
"set the views origin and corner in pixels"
|w h|
w := corner x - origin x + 1.
h := corner y - origin y + 1.
self pixelOrigin:origin extent:(w @ h)
"Modified: 31.8.1995 / 18:24:16 / claus"
!
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.
"
X complains badly if you try to create/resize a view with
a dimension <= 0 ... (although I think that 0 maks sense ...)
"
newWidth < 1 ifTrue:[
newWidth := 1.
].
newHeight < 1 ifTrue:[
newHeight := 1
].
((newWidth == width) and:[newHeight == height]) ifTrue:[
sameOrigin ifTrue:[^ self].
^ self pixelOrigin:origin
].
top := newTop.
left := newLeft.
"/ shown ifTrue:[ "4-nov-94 actually correct,"
drawableId notNil ifTrue:[ "but theres a bug in menus when resized while hidden"
mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
((newHeight <= height) and:[newWidth <= width]) ifTrue:[
how := #smaller
].
mustRepaintRight := false.
mustRepaintBottom := false.
(level ~~ 0) ifTrue:[
"clear the old edges"
newWidth > width ifTrue:[
self clippingRectangle:nil.
self paint:viewBackground.
self fillDeviceRectangleX:(width - margin)
y:0
width:margin
height:height.
mustRepaintRight := true.
oldWidth := width
].
newHeight > height ifTrue:[
self clippingRectangle:nil.
self paint:viewBackground.
self fillDeviceRectangleX: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 clippingRectangle:nil.
mustRedrawBottomEdge ifTrue:[
self drawBottomEdge
].
mustRedrawRightEdge ifTrue:[
self drawRightEdge
].
self clippingRectangle:innerClipRect
].
mustRepaintRight ifTrue:[
self redrawDeviceX:(oldWidth - margin)
y:0
width:margin
height:height.
].
mustRepaintBottom ifTrue:[
self redrawDeviceX: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
]
"Modified: 28.5.1996 / 20:04:48 / cg"
!
pointFromRelative:p
"compute absolute coordinate from p"
|newX newY rel inRect bw superWidth superHeight superLeft superTop |
bw := borderWidth.
superView isNil ifTrue:[
superWidth := device width + bw.
superHeight := device height + bw.
superLeft := superTop := 0.
] ifFalse:[
inRect := superView viewRectangle.
superWidth := inRect width.
superHeight := inRect height.
superLeft := inRect left.
superTop := inRect top.
].
rel := p x.
rel isInteger ifTrue:[
newX := rel
] ifFalse:[
newX := (rel * superWidth) asInteger + superLeft.
(bw ~~ 0) ifTrue:[
rel ~= 1.0 ifTrue:[
newX := newX - bw
]
]
].
rel := p y.
rel isInteger ifTrue:[
newY := rel
] ifFalse:[
newY := (rel * superHeight) asInteger + superTop.
(bw ~~ 0) ifTrue:[
rel ~= 1.0 ifTrue:[
newY := newY - bw
]
]
].
^ newX @ newY
!
setBorderColor
"set my borderColor"
|id dither|
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:[
'SimpleView [warning]: bad borderColor' errorPrintCR
]
]
]
"Modified: 10.1.1997 / 18:06:34 / cg"
!
setInnerClip
"compute, and set the inside clip-area"
self computeInnerClip.
self clippingRectangle:innerClipRect
"Modified: 28.5.1996 / 20:04:53 / cg"
! !
!SimpleView methodsFor:'queries'!
buttonMotionEventPending
"return true, if a button motion event is pending.
Normally, you dont want to use this, since no polling is needed
(not even for mouse-tracking).
Dont use it, since it does not honor the windowGroup, but
goes directly to the device instead.
Actually, its a historical leftover"
windowGroup notNil ifTrue:[
^ windowGroup sensor hasButtonMotionEventFor:self
].
^ super buttonMotionEventPending
"Modified: 1.11.1996 / 17:04:38 / cg"
!
canHandle:aKey
"return true, if I like to handle the key (from a keyPress event).
OBSOLETE: do not use & depend on this method, it is a historic
leftOver and will be removed. Use the delegation mechanism for this."
^ false
!
canHandle:aKey from:aView
"return true, if I like to handle the key (from a keyPress event)
in aView.
OBSOLETE: do not use & depend on this method, it is a historic
leftOver and will be removed. Use the delegation mechanism for this."
^ self canHandle:aKey
!
delegatesTo:someone
"return true, if I delegate events to someone"
delegate isNil ifTrue:[^ false].
^ delegate delegatesTo:someone
!
enabled
"return true, if this view is enabled (i.e. accepts user interaction).
Most views are enabled - only a few (buttons, SelectionInList etc.) can
be disabled."
^ true
!
hasFocus
"return true, if the receiver has the keyboard focus
(either via the focusView mechanism in the windowGroup,
or via delegation)"
|focusView delegate|
windowGroup isNil ifTrue:[^ false].
(focusView := windowGroup focusView) == self ifTrue:[^ true].
focusView notNil ifTrue:[
"mhmh - is there a delegation to me ?"
(delegate := focusView delegate) notNil ifTrue:[
delegate == self ifTrue:[^ true].
^ delegate delegatesTo:self
]
].
^ false
!
is3D
"return true, if my style is some kind of 3D style
This is OBSOLETE and will be removed."
^ styleSheet is3D
!
isBorderedWrapper
^ false
"Created: 5.6.1996 / 14:11:15 / cg"
!
isComponentOf:aViewOrComponent
"return true, if I am a (direct or indirect) component of aViewOrComponent"
aViewOrComponent == self isNil ifTrue:[^ true].
superView isNil ifTrue:[^ false].
superView == aViewOrComponent ifTrue:[^ true].
^ superView isComponentOf:aViewOrComponent
"Created: 5.6.1996 / 14:23:57 / cg"
"Modified: 5.6.1996 / 14:26:14 / cg"
!
isInputField
"return true, if the receiver is some kind of input view,
i.e. it should (can) be part of an enterGroup.
Return false here, this is redefined in EnterField."
^ false
"Created: 4.3.1996 / 11:34:07 / cg"
!
isLayoutWrapper
^ false
"Created: 19.7.1996 / 17:51:04 / cg"
!
isPopUpView
"return true, if this view should be put on top (raised) automatically.
usually this is true for alertBoxes etc."
^ false
!
isSubViewOf:aView
"return true, if I am a (direct or indirect) subview of aView"
self obsoleteMethodWarning:'use #isComponentOf:'.
^ self isComponentOf:aView.
"Modified: 5.6.1996 / 14:25:35 / cg"
!
isWrapper
^ false
"Created: 5.6.1996 / 01:05:06 / cg"
!
preferredBounds
"ST-80 compatibility."
^ 0@0 extent:(self preferredExtent)
"Modified: 19.7.1996 / 20:41:36 / cg"
!
preferredExtent
"return my preferred extent - this is the minimum size I would like to have.
If the preferredExtent has been set, that one is returned.
Otherwise, if there are any components, a rectangle enclosing them
is returned. Otherwise, the actual extent is returned."
|maxX maxY|
"/ If I have an explicit preferredExtent ..
preferredExtent notNil ifTrue:[
^ preferredExtent
].
"/ mhmh - if I have subViews, collect their
"/ preferred bounds ...
subViews notNil ifTrue:[
maxX := maxY := 0.
subViews do:[:aSubView |
|org corn|
org := aSubView computeOrigin.
corn := org + aSubView preferredExtent.
maxX := maxX max:corn x.
maxY := maxY max:corn y.
]
].
"/ mhmh - if I have components, collect their
"/ preferred bounds ...
components notNil ifTrue:[
maxX isNil ifTrue:[
maxX := maxY := 0.
].
components do:[:aComponent |
|bounds org corn|
bounds := aComponent preferredBounds.
corn := bounds corner.
maxX := maxX max:corn x.
maxY := maxY max:corn y.
]
].
"/ nothing found - return the actual size
maxX isNil ifTrue:[
^ self extent.
].
^ maxX @ maxY.
"Modified: 19.7.1996 / 20:43:32 / cg"
!
sizeFixed
"return true, if this vew wants its size to remain unchanged.
Used by panels, to check if their components want to keep their size."
^ false
"Created: 17.9.1995 / 20:29:20 / claus"
!
specClass
"fallback - heuristics to get a specClass for some viewClass"
|myName cls|
(self class == View
or:[self class == SimpleView]) ifTrue:[
^ ViewSpec "/ CompositeSpecCollection
].
myName := self class name.
cls := Smalltalk classNamed:(myName , 'Spec').
(cls notNil and:[cls isLoaded not]) ifTrue:[
cls autoload
].
(cls notNil and:[cls isSubclassOf:UISpecification]) ifTrue:[^ cls].
(myName endsWith:'View') ifTrue:[
"/ try name without 'View'
cls := Smalltalk classNamed:(myName copyWithoutLast:4).
(cls notNil and:[cls isLoaded not]) ifTrue:[
cls autoload
].
(cls notNil and:[cls isSubclassOf:UISpecification]) ifTrue:[^ cls].
"/ try with 'View' replaced by 'Spec'
cls := Smalltalk classNamed:((myName copyWithoutLast:4) , 'View').
(cls notNil and:[cls isLoaded not]) ifTrue:[
cls autoload
].
(cls notNil and:[cls isSubclassOf:UISpecification]) ifTrue:[^ cls].
].
^ ArbitraryComponentSpec
"/ self error:'no spec class (subclassResponsibility)'
"
FramedBox new specClass
"
"Modified: 27.3.1997 / 11:04:17 / cg"
! !
!SimpleView methodsFor:'realization'!
create
"create (i.e. tell my device about me) if not already created.
This does not make the view visible (needs a #map for that)"
drawableId isNil ifTrue:[
"
make certain that superview is created also
"
superView notNil ifTrue:[
superView view create.
"/ "and put my controller into the superviews controller list"
"/ controller notNil ifTrue:[
"/ superView controller notNil ifTrue:[
"/ controller manager:(superView controller manager)
"/ ]
"/ ]
] ifFalse:[
"/
"/ if the display is not already dispatching events,
"/ this starts the event process.
"/
device startDispatch
].
cursor notNil ifTrue:[
cursor := cursor onDevice:device.
].
explicitExtent ~~ true ifTrue:[
self resize
].
self physicalCreate.
viewBackground notNil ifTrue:[
self setViewBackground
].
self initializeMiddleButtonMenu.
self initEvents.
"
this is the first create,
force sizechange messages to be sent to the view
"
extentChanged := true.
originChanged := true
]
"Modified: 28.3.1997 / 13:50:17 / cg"
!
createWithAllSubViews
"create, then create all subviews"
drawableId isNil ifTrue:[self create].
subViews notNil ifTrue:[
subViews do:[:subView | subView createWithAllSubViews]
]
!
destroy
"unmap & destroy - make me invisible, destroy subviews then
make me unknown to the device"
realized ifTrue:[
self unmap.
"/ "make it go away immediately
"/ - also, this hides the subview killing"
"/
"/ device synchronizeOutput.
].
"/ controller notNil ifTrue:[
"/ controller release.
"/ controller := nil.
"/ ].
subViews notNil ifTrue:[
self destroySubViews.
].
superView notNil ifTrue:[
superView removeSubView:self.
superView := nil
].
super destroy.
"/ superView isNil ifTrue:[
"/ device flush
"/ ].
controller notNil ifTrue:[
controller release.
controller := nil.
].
windowGroup notNil ifTrue:[
windowGroup removeView:self.
windowGroup := nil
].
"Modified: 3.5.1996 / 23:49:24 / stefan"
"Modified: 20.3.1997 / 22:11:53 / cg"
!
fetchDeviceResources
"fetch all device specific resources. This is invoked,
when the view is made visible on some device for the very first
time, to allocate device specific colors, fonts, bitmaps etc.
The view may keep those in instance variables, to avoid reallocating
those with every redraw.
If you ommit to do this, the views will still be able to display themself,
but possibly slower, since resources are reallocated over and over.
If you redefine this method, make certain that 'super fetchDeviceResources'
is always sent."
shadowColor notNil ifTrue:[shadowColor := shadowColor on:device].
lightColor notNil ifTrue:[lightColor := lightColor on:device].
"Created: 13.1.1997 / 21:51:59 / cg"
!
fixSize
"This is called right before the view is made visible.
Adjust the size of the view according to either relative/abs or
block extent; also set origin. Also, subclasses may redefine this
method to adjust the size based on some extent (for example, PopUpMenus
do so to take care of changed number of menu entries)."
|org ext r|
"
slowly migrating to use layoutObjects ...
"
layout notNil ifTrue:[
(originChanged or:[extentChanged or:[cornerChanged]]) ifTrue:[
r := (layout rectangleRelativeTo:(superView viewRectangle)
preferred:(self preferredBounds)).
org := r origin rounded.
ext := r extent rounded.
self pixelOrigin:org extent:ext.
].
^ self.
].
"if the extent is not the one we created the window with ..."
"/ extentChanged ifTrue:[
"/ self sizeChanged:nil.
"/ extentChanged := false
"/ ].
originChanged ifTrue:[
"/ org := self computeOrigin.
"/ self pixelOrigin:org.
originRule notNil ifTrue:[
self pixelOrigin:self computeOrigin
] ifFalse:[
relativeOrigin notNil ifTrue:[
self originFromRelativeOrigin:relativeOrigin
] ifFalse:[
shown ifTrue:[
device moveWindow:drawableId x:left y:top.
] ifFalse:[
self pixelOrigin:left@top
].
].
].
originChanged := false
]
"Modified: 18.6.1996 / 21:44:03 / cg"
!
hide
"only useful with modal views: hide the view and return control
back to the suspended main view. Ignored for non-modal views."
|p|
realized ifFalse:[^ self].
windowGroup isNil ifTrue:[^ self].
windowGroup isModal ifFalse:[^ self].
windowGroup notNil ifTrue:[windowGroup focusView:nil].
self unmap.
device flush.
(windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
"
this is a kludge for IRIS which does not provide backingstore:
when we hide a modalbox (such as a searchbox) which covered
a scrollbar, the scrollbars bitblt-method will copy from the
not-yet redrawn area - effectively clearing the scroller.
We need a short delay here, since at this time, the expose event has
not yet arrived.
"
Delay waitForSeconds:0.1.
p processExposeEvents
].
WindowGroup leaveSignal raise.
"/ not reached
^ self
!
hideRequest
"for protocol compatibility with modal dialogs;
ignored here."
^ self
!
map
"make the view visible on the screen"
realized ifFalse:[
drawableId isNil ifTrue:[
self realize
] ifFalse:[
"
no, make the view visible
"
realized := true.
device mapWindow:drawableId.
]
]
"Modified: 23.8.1996 / 14:53:55 / stefan"
"Modified: 25.2.1997 / 22:43:58 / cg"
!
physicalCreate
"common code for create & recreate:
physically create (but do not map) the view on the device."
|sv|
sv := superView isNil ifTrue:[superView] ifFalse:[superView view].
drawableId := device
createWindowFor:self
type:nil
origin:(left @ top)
extent:(width @ height)
minExtent:nil
maxExtent:nil
borderWidth:borderWidth
subViewOf:sv
onTop:(self isPopUpView)
inputOnly:(self isInputOnly)
label:nil
cursor:cursor
icon:nil iconMask:nil
iconView:nil.
Lobby registerChange:self.
extentChanged := false.
originChanged := false.
(borderColor notNil and:[borderColor ~= Black]) ifTrue:[
"/ borderColor := borderColor on:device.
self setBorderColor
].
(viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
device setWindowGravity:viewGravity in:drawableId
].
(bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
device setBitGravity:bitGravity in:drawableId
].
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
].
"Modified: 13.1.1997 / 23:10:56 / cg"
!
realize
"realize - make visible;
realizing is done very late (after layout is fixed) to avoid
visible rearranging of windows on the screen"
"/ fetch device colors, to avoid reallocation at redraw time
self fetchDeviceResources.
"/ now, really realize mySelf
self realizeKeepingGroup:false
"Modified: 13.1.1997 / 21:52:13 / cg"
!
realizeAllSubViews
"realize all my subviews - but not myself."
subViews notNil ifTrue:[
subViews do:[:subView |
subView realize
]
].
components notNil ifTrue:[
components do:[:component |
component realize
]
].
"Modified: 5.9.1995 / 23:30:47 / claus"
"Modified: 13.1.1997 / 21:25:49 / cg"
!
realizeInGroup
"special realize - leave windowgroup as is;
This allows a view to be realized in any windowgroup;
for special applications, like the kill button in the Filebrowser which has
a windowGroup different from its superview's and is handled as a separate process."
windowGroup isForModalSubview:true.
self realize.
"/ self realizeKeepingGroup:true
!
realizeKeepingGroup:keepGroupAsIs
"common helper for realize and realizeInGroup.
Create the view, if the argument is not true, assign my windowGroup,
if hiddenOnRealize is not true, map it."
|superGroup groupChange keep|
drawableId isNil ifTrue:[
self create.
].
groupChange := false.
(windowGroup notNil and:[windowGroup isForModalSubview]) ifTrue:[
keep := true.
] ifFalse:[
keep := keepGroupAsIs
].
keep ifFalse:[
"
put myself into superviews windowgroup if there is a superview
"
superView notNil ifTrue:[
superGroup := superView windowGroup.
(windowGroup notNil and:[superGroup ~~ windowGroup]) ifTrue:[
"
mhmh - seems that the windowgroup has changed ....
"
"/ 'oops - wgroup change on realize' printNL.
windowGroup removeView:self.
windowGroup := nil
].
superGroup ~~ windowGroup ifTrue:[
groupChange := true.
windowGroup := superGroup.
windowGroup notNil ifTrue:[
windowGroup addView:self.
]
]
].
].
(originChanged or:[extentChanged]) ifTrue:[
self fixSize.
self sizeChanged:nil. "/ new 29-aug-1995
].
(subViews notNil or:[components notNil]) ifTrue:[
(realized not or:[groupChange]) ifTrue:[
self realizeAllSubViews.
].
].
hiddenOnRealize ifFalse:[
self setInnerClip.
realized ifFalse:[
"
now, make the view visible
"
self map
]
].
controller notNil ifTrue:[
controller startUp
]
"Modified: 5.6.1996 / 01:02:01 / cg"
"Modified: 23.8.1996 / 15:07:16 / stefan"
!
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
]
!
remap
"make the view visible on the screen at its previous position.
In contrast to map, this asks the windowManager to show the view
immediately (instead of asking for a frame). However, some windowManagers
are known to ignore this ..."
realized ifFalse:[
"
now, make the view visible
"
realized := true.
device mapView:self id:drawableId iconified:false
atX:left y:top width:width height:height.
]
"Created: 8.5.1996 / 09:33:06 / cg"
"Modified: 25.2.1997 / 22:44:33 / cg"
!
rerealize
"rerealize at old position in (a possibly different) windowGroup."
self fetchDeviceResources.
self rerealizeInGroup:windowGroup.
"Created: 7.11.1996 / 16:27:09 / cg"
"Modified: 13.1.1997 / 21:53:18 / cg"
!
rerealizeInGroup:aWindowGroup
"rerealize at old position in (a possibly different) windowGroup."
drawableId isNil ifTrue:[
self create
].
drawableId notNil ifTrue:[
aWindowGroup ~~ windowGroup ifTrue:[
windowGroup notNil ifTrue:[
windowGroup removeView:self
].
windowGroup := aWindowGroup.
aWindowGroup addTopView:self.
].
self remap.
]
"Modified: 3.5.1996 / 23:59:30 / stefan"
"Modified: 7.11.1996 / 16:28:16 / cg"
!
rerealizeWithAllSubViews
"rerealize myself with all subviews"
drawableId notNil ifTrue:[
realized := true.
self realizeAllSubViews.
device mapView:self id:drawableId iconified:false
atX:left y:top width:width height:height
]
"Modified: 28.1.1997 / 17:59:28 / cg"
!
resize
"resize myself to make everything fit into me.
Here, nothing special is done (except for setting my extent to the
preferredExtent), but may be redefined in some subclasses."
explicitExtent ~~ true ifTrue:[
self extent:(self preferredExtent).
explicitExtent := false.
]
"Modified: 15.7.1996 / 11:20:27 / cg"
!
unmap
"hide me - the view stays created, and can be remapped again later."
realized ifTrue:[
drawableId notNil ifTrue:[
realized := false.
device unmapWindow:drawableId
].
shown := realized := false.
].
"
|top sub|
top := StandardSystemView new.
top extent:200@200.
sub := View
origin:0.2@0.2
corner:0.8@0.8
in:top.
sub viewBackground:Color red.
sub hiddenOnRealize:true.
top open.
(Delay forSeconds:5) wait.
sub map.
(Delay forSeconds:3) wait.
sub unmap.
sub viewBackground:(Color green).
(Delay forSeconds:3) wait.
sub map.
"
"Modified: 25.2.1997 / 23:13:26 / cg"
!
unrealize
"alias for unmap, for historic reasons"
self obsoleteMethodWarning:'use unmap'.
self unmap.
"Modified: 4.5.1996 / 00:07:48 / stefan"
! !
!SimpleView methodsFor:'redrawing'!
flash
"flash the view - fill it black, then white, finally
redraw completely.
Can be used to wakeup the user :- when problem or warning conditions
arise)"
self fill:Black.
Delay waitForSeconds:0.1.
self fill:White.
Delay waitForSeconds:0.1.
self clear.
self invalidate
"
|v|
v := View new openAndWait.
Delay waitForSeconds:2.
v flash.
Delay waitForSeconds:2.
v destroy
"
"Modified: 29.5.1996 / 14:09:46 / cg"
!
invalidate
"add a damage to redraw the recevier to its input event queue.
This is preferable to calling redraw directly, in that the drawing is done by
the views process itself, and there is a possibilty to merge
multiple damage rectangles into single redraws."
|sensor|
shown ifTrue:[
(sensor := self sensor) notNil ifTrue:[
sensor flushExposeEventsFor:self.
sensor addDamage:(0@0 extent:width@height) view:self
] ifFalse:[
self redrawX:0 y:0 width:width height:height
]
]
"Created: 26.5.1996 / 17:17:38 / cg"
"Modified: 28.5.1996 / 22:15:05 / cg"
!
invalidate:aRectangle
"add a damage to redraw part of the recevier, to its input event queue.
This is preferable to calling redraw directly,
in that the drawing is done by the views process itself,
and there is a possibilty to merge multiple damage rectangles into
single redraws."
|sensor|
shown ifTrue:[
(sensor := self sensor) notNil ifTrue:[
sensor addDamage:aRectangle view:self.
] ifFalse:[
self redrawX:(aRectangle left)
y:(aRectangle top)
width:(aRectangle width)
height:(aRectangle height)
]
]
"Created: 26.5.1996 / 17:18:25 / cg"
"Modified: 28.5.1996 / 22:15:21 / cg"
!
redraw
"redraw myself completely - this is sent by redrawX:y:width:height:
as a fallback.
Cannot do much here - is redefined in subclasses which dont care for
updating regions but instead update everything."
"Modified: 29.5.1996 / 18:02:52 / cg"
!
redrawDeviceX:x y:y width:w height:h
"have to redraw part of the view.
The coordinates are in device space - if there is a transformation,
must inverse-transform back to logical coordinates. (since the view thinks
in its coordinate space)"
|lx ly lw lh|
lx := x.
ly := y.
lw := w.
lh := h.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
lw := transformation applyInverseScaleX:lw.
lh := transformation applyInverseScaleY:lh.
].
self redrawX:lx y:ly width:lw height:lh
!
redrawX:x y:y width:w height:h
"have to redraw part of myself, given logical coordinates (if trans is nonNil)
default is to redraw everything - subclasses should add intelligence"
|area oldClip|
shown ifFalse:[^ self].
area := Rectangle left:x top:y width:w height:h.
oldClip := clipRect.
self clippingRectangle:area.
components notNil ifTrue:[
self clearRectangleX:x y:y width:w height:h.
components do:[:aComponent |
|thisFrame is|
thisFrame := aComponent bounds.
(thisFrame intersects:area) ifTrue:[
aComponent displayOn:self
]
]
] ifFalse:[
"/ redraw everything - a fallBack for lazy views.
self redraw
].
self clippingRectangle:oldClip.
"Modified: 3.6.1996 / 11:52:51 / cg"
!
showActive
"redraw myself as active (i.e. busy).
Nothing done here, but redefined in some classes."
^ self
!
showFocus:explicit
"highlight myself somehow to tell user that I have the focus.
If explicit is true, the focus came via focusStepping (i.e. tabbing);
if false, it came via the window manager (i.e. pointer entering).
Only change my border, if this is an explicit focusChange."
|delta clrId|
explicit ifTrue:[
drawableId notNil ifTrue:[
delta := DefaultFocusBorderWidth - borderWidth.
delta ~~ 0 ifTrue:[
device moveWindow:drawableId x:left-delta y:top-delta.
device setWindowBorderWidth:DefaultFocusBorderWidth in:drawableId.
].
clrId := (DefaultFocusColor on:device) colorId.
clrId isNil ifTrue:[
clrId := device blackpixel
].
device setWindowBorderColor:clrId in:drawableId.
]
] ifFalse:[
superView notNil ifTrue:[
superView showFocus:explicit
]
]
"Modified: 25.2.1997 / 23:46:56 / cg"
!
showNoFocus:explicit
"undo the effect of showFocus.
Explicit tells if the focus came via focusStepping (i.e. tabbing)
or via the window manager (i.e. pointer entering).
Only change my border, if this is an explicit focusChange."
|delta|
explicit ifTrue:[
drawableId notNil ifTrue:[
(windowGroup notNil
and:[windowGroup focusView == self]) ifTrue:[
delta := DefaultFocusBorderWidth - borderWidth.
delta ~~ 0 ifTrue:[
device setWindowBorderWidth:borderWidth in:drawableId.
device moveWindow:drawableId x:left y:top.
].
self setBorderColor.
]
]
]
"Modified: 25.2.1997 / 23:51:12 / cg"
!
showPassive
"redraw myself as inactive (i.e. nonbusy).
Nothing done here, but redefined in some classes."
^ self
! !
!SimpleView methodsFor:'scrolling'!
horizontalScrollStep
"return the amount to scroll when stepping left/right.
Subclasses may want to redefine this."
^ (device horizontalPixelPerMillimeter * 20) asInteger
!
pageDown
self scrollDown:(self innerHeight)
"Created: 13.9.1996 / 14:06:54 / cg"
!
pageUp
self scrollUp:(self innerHeight)
"Created: 13.9.1996 / 14:07:01 / cg"
!
scrollDown
"scroll down by some amount; this is called when the scrollbars
scroll-step down button is pressed."
self scrollDown:(self verticalScrollStep)
!
scrollDown:nPixels
"change origin to scroll down some pixels"
|viewOrigin|
viewOrigin := self viewOrigin.
^ self scrollTo:(viewOrigin x @ (viewOrigin y + nPixels))
"Modified: 20.8.1996 / 17:34:36 / stefan"
!
scrollHorizontalTo:aPixelOffset
"change origin to make aPixelOffset be the left col"
|orgY|
orgY := self viewOrigin y.
^ self scrollTo:(aPixelOffset @ orgY).
"Modified: 8.7.1996 / 15:34:54 / stefan"
!
scrollHorizontalToPercent:percent
"scroll to a position given in percent of total"
|wCont|
wCont := self widthOfContents.
transformation notNil ifTrue:[
wCont := transformation applyScaleX:wCont.
].
self scrollHorizontalTo:
((((wCont * percent) / 100.0) + 0.5) asInteger)
!
scrollLeft
"scroll left by some amount; this is called when the scrollbars
scroll-step left button is pressed."
self scrollLeft:(self horizontalScrollStep)
!
scrollLeft:nPixels
"change origin to scroll left some pixels"
|viewOrigin|
viewOrigin := self viewOrigin.
^ self scrollTo:((viewOrigin x - nPixels) @ viewOrigin y).
"Modified: 20.8.1996 / 17:35:09 / stefan"
!
scrollRight
"scroll right by some amount; this is called when the scrollbars
scroll-step right button is pressed."
self scrollRight:(self horizontalScrollStep)
!
scrollRight:nPixels
"change origin to scroll right some pixels"
|viewOrigin|
viewOrigin := self viewOrigin.
^ self scrollTo:((viewOrigin x + nPixels) @ viewOrigin y)
"Modified: 20.8.1996 / 17:35:37 / stefan"
!
scrollToBottom
self scrollTo:0 @ (self heightOfContents - self innerHeight)
"Created: 13.9.1996 / 14:08:03 / cg"
"Modified: 13.9.1996 / 14:09:32 / cg"
!
scrollToPercent:originAsPercent
"scroll to a position given in percent of total (x and y as a Point)"
|wCont hCont percent|
percent := originAsPercent asPoint.
wCont := self widthOfContents.
hCont := self heightOfContents.
transformation notNil ifTrue:[
wCont := transformation applyScaleX:wCont.
hCont := transformation applyScaleY:hCont.
].
self scrollTo:
((((wCont * percent x) / 100.0) + 0.5) asInteger) @
((((hCont * percent y) / 100.0) + 0.5) asInteger)
"Created: 5.8.1996 / 12:15:53 / stefan"
"Modified: 5.8.1996 / 12:42:57 / stefan"
!
scrollToTop
"move viewOrigin to top"
self scrollVerticalTo:0
!
scrollToTopLeft
"move viewOrigin to top/left"
self scrollTo:(0 @ 0).
!
scrollUp
"scroll up by some amount; this is called when the scrollbars
scroll-step up button is pressed."
self scrollUp:(self verticalScrollStep)
!
scrollUp:nPixels
"change origin to scroll up (towards the origin) by some pixels"
|viewOrigin|
viewOrigin := self viewOrigin.
^ self scrollTo:(viewOrigin x @ (viewOrigin y - nPixels)).
"Modified: 20.8.1996 / 17:36:16 / stefan"
!
scrollVerticalTo:aPixelOffset
"change origin to make aPixelOffset be the top line"
|orgX|
orgX := self viewOrigin x.
^ self scrollTo:(orgX @ aPixelOffset).
"Modified: 8.7.1996 / 15:35:40 / stefan"
!
scrollVerticalToPercent:percent
"scroll to a position given in percent of total"
|hCont|
hCont := self heightOfContents.
transformation notNil ifTrue:[
hCont := transformation applyScaleY:hCont.
].
self scrollVerticalTo:
((((hCont * percent) / 100.0) + 0.5) asInteger)
!
verticalScrollStep
"return the amount to scroll when stepping up/down.
Subclasses may want to redefine this."
^ (device verticalPixelPerMillimeter * 20) asInteger
!
widthForScrollBetween:yStart and:yEnd
"return the width in pixels for a scroll between yStart and yEnd
- return full width here since we do not know how wide contents is.
Views which only use part of their space (short lists, text) may redefine
this method and return the number of pixels that have to be scrolled.
On slow displays, this may make a difference; on fast ones you will probably
not notice any difference."
^ (width - margin - margin)
! !
!SimpleView methodsFor:'scrolling-basic'!
scrollTo:newOrigin
"change origin to have newOrigin be visible at the top-left.
The argument defines the integer device coordinates of the new top-left
point."
^ self scrollTo:newOrigin redraw:true
"Modified: 15.7.1996 / 11:35:08 / stefan"
"Modified: 13.9.1996 / 14:09:19 / cg"
!
scrollTo:newOrigin redraw:doRedraw
"change origin to have newOrigin be visible at the top-left.
The argument defines the integer device coordinates of the new top-left
point."
|dX "{ Class:SmallInteger }"
dY "{ Class:SmallInteger }"
orgX "{ Class:SmallInteger }"
orgY "{ Class:SmallInteger }"
x y iw ih
hCont wCont fromX toX fromY toY copyWidth copyHeight
redrawX redrawY|
hCont := self heightOfContents.
wCont := self widthOfContents.
transformation isNil ifTrue:[
orgY := orgX := 0
] ifFalse:[
wCont := (transformation applyScaleX:wCont) rounded.
hCont := (transformation applyScaleY:hCont) rounded.
orgY := transformation translation y negated.
orgX := transformation translation x negated
].
iw := self innerWidth.
ih := self innerHeight.
"don't scroll outside of displayed area"
x := newOrigin x.
y := newOrigin y.
x + iw > wCont ifTrue:[
x := wCont - iw.
].
x < 0 ifTrue:[
x := 0
].
y + ih > hCont ifTrue:[
y := hCont - ih.
].
y < 0 ifTrue:[
y := 0.
].
dX := x - orgX.
dY := y - orgY.
(dX == 0 and:[dY == 0]) ifTrue:[
^ self
].
self originWillChange.
(shown and:[doRedraw]) ifTrue:[
copyWidth := iw - dX abs.
copyHeight := ih - dY abs.
((copyWidth > 0) and:[copyHeight > 0]) ifTrue:[
"/ some of the currently displayed pixels
"/ remain visible. Copy them
dX < 0 ifTrue:[
fromX := margin.
toX := margin - dX.
redrawX := margin
] ifFalse:[
fromX := margin + dX.
toX := margin.
redrawX := margin + copyWidth.
].
dY < 0 ifTrue:[
fromY := margin.
toY := margin - dY.
redrawY := margin.
] ifFalse:[
fromY := margin + dY.
toY := margin.
redrawY := margin + copyHeight.
].
self catchExpose.
self setViewOrigin:(x @ y).
self
copyFrom:self
x:fromX y:fromY
toX:toX y:toY
width:copyWidth
height:copyHeight
async:true.
self setInnerClip.
"first redraw the rectangle above/below the
copied area (with full width)."
copyHeight < ih ifTrue:[
self
redrawDeviceX:margin y:redrawY
width:iw height:(ih - copyHeight).
].
"second redraw the rectangle left/right of the
copied area"
copyWidth < iw ifTrue:[
self redrawDeviceX:redrawX y:toY
width:iw - copyWidth
height:copyHeight.
].
self waitForExpose.
] ifFalse:[
"redraw everything"
self setViewOrigin:(x @ y).
self redrawDeviceX:margin y:margin
width:iw
height:ih.
].
] ifFalse:[
self setViewOrigin:(x @ y).
].
self originChanged:(dX negated @ dY negated).
"Modified: 5.8.1996 / 11:57:09 / stefan"
"Modified: 29.1.1997 / 13:08:26 / cg"
! !
!SimpleView methodsFor:'startup'!
open
"open up the view - for normal views, this is a modeless open
(i.e. the new view comes up as independent process).
Although #open is only to be sent to topviews (i.e. it could have been
implemented in TopView), it is implemented here - therefore, every view
can be opened as a topView.
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
"
View new open
(Button label:'hello') open
|top|
top := StandardSystemView new.
top extent:200@200.
Button label:'hello' in:top.
top open
YesNoBox new open
"
!
openAndWait
"open up the view - wait until it is visible.
In normal applications, you do not need to wait till the view is
open - it should do all of its drawing itself when it gets the
first expose event.
However, if you want to 'manually' draw into the view (for example,
in doIt expressions) the view must be visible (realized) before doing so.
Use this open in those situations."
self open.
self waitUntilVisible.
"does not work:
|v|
v := View new open.
v displayLineFrom:0@0 to:50@50
does work:
|v|
v := View new openAndWait.
v displayLineFrom:0@0 to:50@50
"
!
openAt:aPoint
"open up the view modeless - positions the view"
^self openModelessAt:aPoint
"Created: 18.9.1995 / 23:30:43 / claus"
!
openAtCenter
"open up the view modeless - positions the view"
^self openModelessAtCenter
"Created: 18.9.1995 / 23:30:56 / claus"
!
openAutonomous
"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. This entry is for non-topviews, which want to be served
autonomous from the topview. (see the fileBrowsers kill-button
when executing unix commands as an example)"
|wg|
"/ non-thread operation is no longer supported
"/
"/ Processor isPureEventDriven ifTrue:[
"/ self realize.
"/ ^ self
"/ ].
wg := WindowGroup new.
self windowGroup:wg.
wg addView:self.
wg startup:false.
wg isForModalSubview:true.
self realizeInGroup.
"Modified: 29.5.1996 / 13:23:12 / cg"
!
openInGroup:aGroup
"special open within another windowGroup.
This allows a view to be realized in any windowgroup;
for applications where multiple views act as a group
(i.e. close and iconify together)."
self windowGroup:aGroup.
aGroup addTopView:self.
"/ self realizeKeepingGroup:true
aGroup isForModalSubview:true.
self realize.
!
openModal
"create a new windowgroup, but start processing in the current process
actually suspending event processing for the currently active group.
Stay in the modalLoop while the view is visible.
(i.e. control is returned to the sender when the receiver is closed)"
self openModal:[true]
"
the same:
YesNoBox new open
YesNoBox new openModal
different:
(Button label:'hello') open
(Button label:'hello') openModal
"
!
openModal:aBlock
"create a new windowgroup, but start processing in the current process -
actually suspending event processing for the currently active group.
Stay in this modal loop while aBlock evaluates to true AND the receiver is
visible.
(i.e. control is returned to the sender when the receiver is closed)
This makes any interaction with the current window impossible -
however, other views (in other windowgroups) still work."
|mainGroup|
mainGroup := WindowGroup activeGroup.
mainGroup notNil ifTrue:[
mainGroup := mainGroup mainGroup.
].
^ self openModal:aBlock inGroup:mainGroup.
"Created: 10.12.1995 / 14:06:45 / cg"
"Modified: 28.2.1997 / 22:31:50 / cg"
!
openModal:aBlock inGroup:mainGroup
"create a new windowgroup, but start processing in the current process -
actually suspending event processing for the main group.
Stay in this modal loop while aBlock evaluates to true AND the receiver is
visible.
(i.e. control is returned to the sender when the receiver is closed)
This makes any interaction with the current window impossible -
however, other views (in other windowgroups) still work."
|tops mainView mainViewID|
ModalBox usingTransientViews ifTrue:[
mainGroup notNil ifTrue:[
mainGroup topViews notNil ifTrue:[
mainView := mainGroup topViews first.
].
mainView notNil ifTrue:[
mainViewID := mainView id.
]
].
mainViewID isNil ifTrue:[
self origin:(device center - (self extent//2))
].
self create.
device setTransient:drawableId for:mainViewID.
].
self raise.
Processor activeProcessIsSystemProcess ifTrue:[
"
put myself into the modal group, let it handle events for
me as well. This is only a half way solution, since the view
is not modal at all ... however, the only situation
where this happens is with modal boxes popped while in a
modal browser. You will forgive me for that inconvenience.
"
windowGroup := mainGroup.
mainGroup notNil ifTrue:[mainGroup addTopView:self].
self realize
] ifFalse:[
"
show a stop-cursor in the main group
"
mainGroup notNil ifTrue:[
self isPopUpView ifFalse:[
mainGroup showCursor:(Cursor stop).
]
].
"
create a new window group and put myself into it
"
windowGroup := WindowGroup new.
windowGroup addTopView:self.
superView notNil ifTrue:[
"/
"/ special: this is a modal subview,
"/ prevent the view to reassign its windowGroup when realized
"/ (subviews normally place themself into the superviews group)
"/
windowGroup isForModalSubview:true.
].
"
go dispatch events in this new group
(thus current windowgroup is blocked from interaction)
"
AbortSignal handle:[:ex |
self hide.
ex return.
] do:[
[
[
windowGroup startupModal:[realized and:aBlock] forGroup:mainGroup
] valueOnUnwindDo:[
self hide
]
] valueNowOrOnUnwindDo:[
mainGroup notNil ifTrue:[
ReturnFocusWhenClosingModalBoxes ifTrue:[
"
return input focus to previously active groups top.
This helps with windowmanagers which need an explicit click
on the view for the focus.
"
tops := mainGroup topViews.
(tops notNil and:[tops notEmpty]) ifTrue:[
tops first getKeyboardFocus
]
].
"
restore cursors in the main group & flush its buffered key & mouse events
"
mainGroup restoreCursors.
"/ mainGroup sensor flushUserEvents.
]
]
].
]
"Created: 10.12.1995 / 14:06:14 / cg"
"Modified: 28.2.1997 / 22:29:56 / cg"
!
openModalAt:aPoint
"open up the view modeless - positions the view
(i.e. circumvents window managers positioning)"
self origin:aPoint.
self create.
"/ device setTransient:drawableId for:0.
^ self openModal
"
View new openModal
View new openModalAt:100@100
"
"Created: 18.9.1995 / 23:21:42 / claus"
"Modified: 18.9.1995 / 23:32:26 / claus"
"Modified: 12.4.1996 / 19:02:29 / cg"
!
openModalAtCenter
"open up the view modeless - positions the view
(i.e. circumvents window managers positioning)"
^ self openModalAt:(device center - (self extent//2)).
"Created: 18.9.1995 / 23:31:47 / claus"
!
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 (i.e. control is returned to the sender immediately)."
Processor isPureEventDriven ifFalse:[
windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
windowGroup startup:false.
] ifFalse:[
windowGroup addTopView:self.
windowGroup startup:false.
self realizeInGroup.
].
] ifTrue:[
self realize
]
"
the same:
(Button label:'hello') open
(Button label:'hello') openModeless
different:
YesNoBox new open
YesNoBox new openModeless
"
"
(almost) the same:
YesNoBox new open
YesNoBox new openModal
different:
(Button label:'hello') open
(Button label:'hello') openModal
"
"Modified: 13.4.1996 / 20:34:45 / cg"
!
openModelessAt:aPoint
"open up the view modeless - positions the view
(i.e. circumvents window managers positioning)"
self origin:aPoint.
self create.
^ self openModeless
"
View new openModeless
View new openModelessAt:100@100
"
"Created: 18.9.1995 / 23:21:42 / claus"
"Modified: 12.4.1996 / 19:02:28 / cg"
!
openModelessAtCenter
"open up the view modeless - positions the view
(i.e. circumvents window managers positioning)"
^ self openModelessAt:(device center - (self extent//2)).
"
View new openModeless
View new openModelessAtCenter
"
"Created: 18.9.1995 / 23:21:42 / claus"
!
waitUntilVisible
"wait until the receiver visible.
In normal applications, you do not need to wait till a view is
open - it should do all of its drawing itself when it gets the
first expose event.
However, if you want to 'manually' draw into the view (for example,
in doIt expressions), or subsequent views depend on some state of
another view (which is only available once visible),
use this to suspend the current process until the receiver is shown.
Caveat:
we poll here for the view to be shown - we need a semaphore
which is raised by the view in order to do it right."
[self shown] whileFalse:[
Delay waitForSeconds:0.05.
].
"does not work (the view is in its opening phase,
when we attempt to draw a line - this gives an error, since
its internals are not yet correctly setup):
|v|
v := View new open.
v displayLineFrom:0@0 to:50@50
does work (since we wait until the view has completely finished
its startup phase):
|v|
v := View new open.
v waitUntilVisible.
v displayLineFrom:0@0 to:50@50
"
! !
!SimpleView methodsFor:'user notification'!
warn:aString
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString) withCRs
!
warn:aString with:argument
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:argument) withCRs
!
warn:aString with:arg1 with:arg2
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
super warn:(resources string:aString with:arg1 with:arg2) withCRs
! !
!SimpleView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.193 1997-03-28 12:52:47 cg Exp $'
! !
SimpleView initialize!