.
"
COPYRIGHT (c) 1992 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.
"
DeviceDrawable subclass:#PseudoView
instanceVariableNames:'viewBackground
cursor eventMask
middleButtonMenu
keyCommands
gotExpose exposePending
backed saveUnder delegate'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
!
PseudoView comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.39 1995-08-03 01:32:32 claus Exp $
'!
!PseudoView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.39 1995-08-03 01:32:32 claus Exp $
"
!
documentation
"
this abstract class describes stuff common to any Window on a display
device. i.e. RootWindow, TopWindows, PopUps and Subwindows.
That is, they have a viewBackground, cursor etc. and especially events.
A special feature is the delegate field, which allows key- and button
events to be stolen from a view.
If the delegate is non-nil, these events will be sent to it instead.
So you can change a views behavior even if it was not initially designed
for it. Also, controller functionality could be simulated using delegates.
instance variables:
viewBackground <Color|Form|Image> the views background
cursor <Cursor> the cursor
eventMask mask specifying the enabled
events.
middleButtonMenu a popup menu for the middle
button.
keyCommands not yet supported
gotExpose for exposure handling after
exposePending after a scroll
backed true if backing store for that
view is enabled
saveUnder true if saveunder store for
that view is enabled
delegate for event delegation
"
! !
!PseudoView methodsFor:'initialize / release'!
initialize
"initialize defaults"
super initialize.
eventMask := Display defaultEventMask.
viewBackground := background.
backed := false.
saveUnder := false.
exposePending := false.
self initCursor
!
initStyle
"nothing done here"
^ self
!
initCursor
"default cursor for all views"
cursor := Cursor arrow
!
reinitStyle
"nothing done here"
^ self
!
recreate
"recreate (i.e. tell X about me) after a snapin"
viewBackground isColor ifTrue:[
viewBackground := viewBackground on:device
].
super recreate.
cursor := cursor on:device.
exposePending := false
!
destroy
"view is about to be destroyed -
first destroy menu if there is one and also destroy the GC.
then the view is physically destroyed."
middleButtonMenu notNil ifTrue:[
middleButtonMenu destroy.
middleButtonMenu := nil
].
keyCommands := nil.
gcId notNil ifTrue:[
device destroyGC:gcId.
gcId := nil
].
drawableId notNil ifTrue:[
device destroyView:self withId:drawableId.
drawableId := nil
].
Lobby unregister:self.
!
destroyed
"view has been destroyed by someone else"
drawableId notNil ifTrue:[
device removeKnownView:self.
drawableId := nil.
realized := false.
].
self destroy
!
reAdjustGeometry
"sent late during snapin processing, nothing done here"
^ self
!
disposed
"view was collected - release system resources"
drawableId notNil ifTrue:[
gcId notNil ifTrue:[
device destroyGC:gcId.
gcId := nil.
].
device destroyView:self withId:drawableId.
drawableId := nil.
].
! !
!PseudoView methodsFor:'accessing'!
widget
"ST-80 compatibility"
^ self
!
viewOrigin
"0@0 here, since by default we cannot be scrolled"
^ 0 @ 0
!
viewGravity
"return the views gravity"
^ #NorthWest
!
depth
"return the depth in pixels of the view.
Notice, that this is currently the devices depth,
but support for mixed depth views is being prepared.
(especially useful on SGI, with 24bit view)"
^ device depth
!
viewBackground
"return the viewBackground"
^ viewBackground
!
viewBackground:something
"set the viewBackground to something, a color, image or form.
The viewBackground is the color or pattern with which exposed
regions are filled - do not confuse this with the drawing background
color, which is used with opaque drawing."
viewBackground ~~ something ifTrue:[
viewBackground := something.
drawableId notNil ifTrue:[
self setViewBackground
]
]
!
setViewBackground
"install the viewBackground for the receiver on the device"
|id devBgPixmap bgPixmap w h colors|
drawableId notNil ifTrue:[
viewBackground isColor ifTrue:[
viewBackground := viewBackground on:device.
id := viewBackground colorId.
"
a real color (i.e. one supported by the device) ?
"
id notNil ifTrue:[
device setWindowBackground:id in:drawableId.
^ self
].
"
no, a dithered one - must have a dither-pattern
(which is ready for the device, since viewBackground
is already assigned to the device)
"
bgPixmap := viewBackground ditherForm.
] ifFalse:[
"
assume, it can convert itself to a form
"
bgPixmap := viewBackground asFormOn:device
].
"
must now have:
a dithered color or bitmap or pixmap
"
bgPixmap isNil ifTrue:[
'PSEUDOVIEW: background not convertable - ignored' errorPrintNL.
^ self
].
w := bgPixmap width.
h := bgPixmap height.
(bgPixmap depth ~~ device depth) ifTrue:[
(bgPixmap depth ~~ 1) ifTrue:[
self error:'bad dither depth'.
^ self
].
"
convert it into a deep form
"
colors := bgPixmap colorMap.
devBgPixmap := Form width:w height:h depth:(device depth) on:device.
devBgPixmap paint:(colors at:1).
devBgPixmap fillRectangleX:0 y:0 width:w height:h.
devBgPixmap foreground:(colors at:2) background:(colors at:1).
devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
bgPixmap := devBgPixmap.
] ifFalse:[
(bgPixmap depth == 1) ifTrue:[
"
although depth matches,
values in the dither are to be interpreted via the ditherForms
colormap, which is not always the same as blackpixel/whitepixel ...
"
(bgPixmap colorMap at:1) colorId == device whitepixel ifTrue:[
(bgPixmap colorMap at:2) colorId == device blackpixel ifTrue:[
"
ok, can use it
"
device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
^ self
]
].
"
no, must invert it
"
devBgPixmap := Form width:w height:h depth:(device depth) on:device.
devBgPixmap paint:(bgPixmap colorMap at:2) on:(bgPixmap colorMap at:1).
devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
bgPixmap := devBgPixmap.
]
].
device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
]
!
insideColor:aColor
"set the views background color - ST-80 compatibility"
self viewBackground:aColor.
self background:aColor
! !
!PseudoView methodsFor:'accessing-cursor'!
cursor
"return the views cursor"
^ cursor
!
cursor:aCursor
"set the views cursor. This cursor will be automatically displayed whenever
the mouse-pointer enters the receiver.
Cursors are typically set at view creation time and left as installed."
|id|
aCursor notNil ifTrue:[
(aCursor ~~ cursor) ifTrue:[
cursor := aCursor.
drawableId notNil ifTrue:[
cursor := cursor on:device.
id := cursor id.
id isNil ifTrue:[
'PSEUDOVIEW: nil cursorId ignored; shape=' errorPrint. cursor shape errorPrintNL.
^ self
].
device setCursor:id in:drawableId.
realized ifTrue:[
"flush, to make cursor immediately visible"
device flush
]
]
]
]
"
|v|
v := View new.
v cursor:(Cursor wait).
v open.
[v shown] whileFalse:[Processor yield].
[v shown] whileTrue:[
(Delay forSeconds:1) wait.
v cursor:(Cursor normal).
(Delay forSeconds:1) wait.
v cursor:(Cursor wait).
]
"
!
withCursor:aCursor do:aBlock
"evaluate aBlock showing aCursor until ready; then restore the old cursor
and return the value as returned by aBlock.
Notice, that this method only changes the cursor for a SINGLE (sub-)view.
Most applications want to have the cursor changed in all views of its
application. Use 'aView windowGroup withCursor:do:' to acomplish this."
|savedCursor|
savedCursor := cursor.
self cursor:aCursor.
^ aBlock valueNowOrOnUnwindDo:[self cursor:savedCursor]
! !
!PseudoView methodsFor:'accessing-hierarchy'!
superView
"return the superView - nil here"
^ nil
!
topView
"return the topView - that the one with no superview"
^ self
!
delegate
"return the delegate - thats the one getting keyboard and button events"
^ delegate
!
delegate:someOne
"set the delegate - keyboard- and button events will be forwarded to
that object if it is interrested in them.
See the sendEvent... method in WindowEvent."
delegate := someOne
! !
!PseudoView methodsFor:'accessing-names'!
label
"return the views label - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
label:aLabel
"set the views label - ignored here.
Only standardSystemViews support labels and icons."
^ self
!
iconLabel
"return the views icon label - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
iconLabel:aLabel
"set the views icon label - ignored here.
Only standardSystemViews support labels and icons."
^ self
!
iconView
"return the views iconView - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
iconView:aView
"set the views icon view - ignored here.
Only standardSystemViews support labels and icons."
^ self
!
icon
"return the views icon - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
icon:aBitmap
"set the views icon - ignored here.
Only standardSystemViews support labels and icons."
^ self
! !
!PseudoView methodsFor:'queries-contents'!
heightOfContents
"return the height of the contents in pixels.
Since we dont know here, just return the views size.
This will make your scrollbars show 100%-visible.
Must be redefined in subviews to make scrollbars really work."
^ self height
!
widthOfContents
"return the width of the contents in pixels.
Since we dont know here, just return the views size.
This will make your scrollbars show 100%-visible.
Must be redefined in subviews to make scrollbars really work."
^ self width
!
yOriginOfContents
"return the y-origin of the contents in pixels.
Since we dont know here, just return 0 for top.
Must be redefined in subviews to make scrollbars really work."
^ 0
!
xOriginOfContents
"return the x-origin of the contents in pixels.
Since we dont know here, just return 0 for left.
Must be redefined in subviews to make scrollbars really work."
^ 0
! !
!PseudoView methodsFor:'accessing-limits'!
minExtent:extent
"set the views minimum extent - ignored here.
Only standardSystemViews support this."
^ self
!
minExtent
"return the views minimum extent - this is nil here.
Only standardSystemViews support this."
^ nil
!
maxExtent:extent
"set the views maximum extent - ignored here.
Only standardSystemViews support this."
^ self
!
maxExtent
"return the views maximum extent - this is nil here.
Only standardSystemViews support this."
^ nil
! !
!PseudoView methodsFor:'accessing-misc'!
realized
"return true, if the receiver is realized"
^ realized
!
inputOnly
"return true, if the receiver is an input only view - that is:
the view will realize as a transparent view, into which you cannot
draw, but get events as usual. Thich can be used to catch events away from
others, which where never meant to work in such a setup.
(for example, if you want to manipulate views in some DrawTool-like manner).
This uses a special X feature, which might not be supported in the near future
or on other plattforms."
^ false
!
getKeyboardFocus
"tell the Display to assign keyboard focus to the receiver"
device setInputFocusTo:drawableId.
!
eventMask
"return a (numeric) mask of allowed events -
this is X-specific and will be removed / replaced by symbolic values)"
^ eventMask
!
eventMask:aMask
"set a (numeric) mask of allowed events -
this is X-specific and will be removed / replaced by symbolic values)"
eventMask := aMask
!
clippedByChildren:aBoolean
"turn on/off drawing over children.
If on, a superview may draw 'over' its children.
If off (the default), drawing is 'under' its children.
Only useful for the rootView, to draw over any visible views.
(for example, when dragging a rubber-line)"
gcId isNil ifTrue:[
self initGC
].
device setClipByChildren:aBoolean in:gcId
!
clipByChildren
"drawing shall be done into my view only (default)"
^ self clippedByChildren:true
!
noClipByChildren
"drawing shall also be done into subviews"
^ self clippedByChildren:false
!
saveUnder:aBoolean
"turn on/off saveUnder (saving pixels under myself)
- used for temporary views (i.e. PopUps and ModalBoxes)"
saveUnder := aBoolean.
drawableId notNil ifTrue:[
device setSaveUnder:aBoolean in:drawableId
]
!
backingStore:how
"turn on/off backingStore (saving my pixels)
how may true/false, but also #always, #whenMapped or #never."
how ~~ backed ifTrue:[
backed := how.
drawableId notNil ifTrue:[
device setBackingStore:how in:drawableId
]
]
!
preferredVisual
"return a non nil id, if a specific visual is wanted in this view.
Return nil if we do not care (i.e. the displays default is wanted).
This is experimental and may change/vanish - do not use it."
^ nil
!
preferredDepth
"return a non nil integer, if a specific depth is wanted in this view.
Return nil if we do not care (i.e. the displays default is wanted).
This is experimental and may change/vanish - do not use it."
^ nil
! !
!PseudoView methodsFor:'drawing'!
redraw
"nothing done here"
^ self
!
clearDeviceRectangleX:x y:y width:w height:h
"clear a rectangular area to viewBackground -
redefined since DisplayMedium fills with background
- not viewBackground as we want here."
|oldPaint org|
oldPaint := paint.
self paint:viewBackground.
viewBackground isColor ifFalse:[
gcId notNil ifTrue:[
org := self viewOrigin.
device setMaskOriginX:org x rounded negated
y:org y rounded negated
in:gcId
].
].
"
fill in device coordinates - not logical coordinates
"
self fillDeviceRectangleX:x y:y width:w height:h "with:viewBackground".
self paint:oldPaint
!
clearRectangleX:x y:y width:w height:h
"clear a rectangular area to viewBackground -
redefined since DisplayMedium fills with background
- not viewBackground as we want here."
|oldPaint org|
oldPaint := paint.
self paint:viewBackground.
viewBackground isColor ifFalse:[
gcId notNil ifTrue:[
org := self viewOrigin.
device setMaskOriginX:org x rounded negated
y:org y rounded negated
in:gcId
].
].
self fillRectangleX:x y:y width:w height:h.
self paint:oldPaint
! !
!PseudoView methodsFor:'keyboard commands'!
addActionForKey:aKey action:aBlock
"define a keyboard command function"
keyCommands isNil ifTrue:[
keyCommands := IdentityDictionary new
].
keyCommands at:aKey put:aBlock
!
removeActionForKey:aKey
keyCommands notNil ifTrue:[
keyCommands removeKey:aKey ifAbsent:[]
]
! !
!PseudoView methodsFor:'button menus'!
middleButtonMenu
"return the menu associated with the middle mouse button"
^ middleButtonMenu
!
middleButtonMenu:aMenu
"associate aMenu with the middle mouse button"
middleButtonMenu notNil ifTrue:[
middleButtonMenu destroy
].
middleButtonMenu := aMenu
!
setMiddleButtonMenu:aMenu
"associate aMenu with the middle mouse button.
Do not destroy old menu if any"
middleButtonMenu := aMenu
! !
!PseudoView methodsFor:'enable/disable events'!
enableEvent:anEventSymbol
"enable an event -
this is a private (internal) method not to be used externally.
for a list of allowed event symbols see Workstation class"
eventMask := eventMask bitOr:(device eventMaskFor:anEventSymbol).
drawableId notNil ifTrue:[
device setEventMask:eventMask in:drawableId
]
!
disableEvent:anEventSymbol
"disable an event -
this is a private (internal) method not to be used externally.
for a list of allowed event symbols see Workstation class"
eventMask := eventMask bitAnd:(device eventMaskFor:anEventSymbol) bitInvert.
drawableId notNil ifTrue:[
device setEventMask:eventMask in:drawableId
]
!
enableKeyEvents
"this is a compatibility leftover -
starting with 2.10.3, keyPress is always enabled to allow
^C processing."
!
enableKeyPressEvents
"this is a compatibility leftover -
starting with 2.10.3, keyPress is always enabled to allow
^C processing."
!
enableKeyReleaseEvents
"enable key release events"
self enableEvent:#keyRelease
!
enableButtonPressEvents
"enable mouse button press events.
These are enabled by default anyway."
self enableEvent:#buttonPress
!
enableButtonReleaseEvents
"enable mouse button release events.
These are enabled by default anyway."
self enableEvent:#buttonRelease
!
enableButtonEvents
"enable both mouse button press and release events.
These are enabled by default anyway."
self enableEvent:#buttonPress.
self enableEvent:#buttonRelease
!
enableEnterEvents
"enable mouse-pointer enter events"
self enableEvent:#enter
!
enableLeaveEvents
"enable mouse-pointer leave events"
self enableEvent:#leave
!
enableEnterLeaveEvents
"enable both mouse-pointer enter and leave events"
self enableEvent:#enter.
self enableEvent:#leave
!
enableMotionEvents
"enable mouse-pointer motion events"
self enableEvent:#pointerMotion
!
compressMotionEvents:aBoolean
"enable/disable motion event compression
(i.e. replacing all motion events by the last one).
Compression makes almost always sense, except when
doing things like freehand drawing"
|s|
(s := self sensor) notNil ifTrue:[
s compressMotionEvents:aBoolean
]
!
enableButtonMotionEvents
"enable mouse-pointer motion-while-button-is-pressed events.
These are enabled by default anyway."
self enableEvent:#buttonMotion
!
enableFocusEvents
"enable keyboard focus change events"
self enableEvent:#focusChange
!
disableButtonPressEvents
"disable button press events"
self disableEvent:#buttonPress
!
disableButtonReleaseEvents
"disable button release events"
self disableEvent:#buttonRelease
!
disableButtonEvents
"disable all button events"
self disableEvent:#buttonpress.
self disableEvent:#buttonRelease
!
disableMotionEvents
"disable motion events"
self disableEvent:#pointerMotion
!
disableButtonMotionEvents
"disable button motion-while-button-is-pressed events"
self disableEvent:#buttonMotion
!
disableEnterLeaveEvents
"disable both mouse-pointer enter and leave events"
self disableEvent:#enter.
self disableEvent:#leave
! !
!PseudoView methodsFor:'queries'!
isView
"return true, if the receiver is a view"
^ true
!
isXtWidget
^ false
!
exposeEventPending
"return true, if an expose event is pending."
|sensor|
((sensor := self sensor) notNil and:[sensor hasDamageFor:self]) ifTrue:[^ true].
^ device eventPending:#expose for:drawableId
!
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"
device flush.
^ device eventPending:#buttonMotion for:drawableId
!
buttonReleaseEventPending
"return true, if a button release event is pending.
Dont use it, since it does not honor the windowGroup, but
goes directly to the device instead.
Actually, its a historical leftover"
device flush.
^ device eventPending:#buttonRelease for:drawableId
! !
!PseudoView methodsFor:'selection handling '!
selectionClear:selectionID
"someone else has the selection"
"
workaround a bug in olvwm: it clears selections
on window raise. In this case, keep my last own selection
"
Smalltalk at:#LastCopyBuffer put:(Smalltalk at:#CopyBuffer).
Smalltalk at:#CopyBuffer put:nil.
!
getSelection
"return the object selection - either the local one, or the displays
selection buffer."
|sel|
sel := Smalltalk at:#CopyBuffer.
sel isNil ifTrue:[
sel := device getSelectionFor:drawableId.
sel isNil ifTrue:[^ nil].
].
^ sel
!
getTextSelection
"return the text selection - either the local one, or the displays
selection buffer."
|sel|
sel := Smalltalk at:#CopyBuffer.
sel isNil ifTrue:[
sel := device getTextSelectionFor:drawableId.
sel isNil ifTrue:[^ nil].
].
^ sel
!
setTextSelection:something
"set the text selection - both the local one, and tell the display
that we have changed it."
|s|
Smalltalk at:#LastCopyBuffer put:nil.
Smalltalk at:#CopyBuffer put:something.
s := something.
s isString ifFalse:[
s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
].
(device setTextSelection:s owner:drawableId) ifFalse:[
'PSEUDOVIEW: selection failed' errorPrintNL
]
!
setSelection:something
"set the object selection - both the local one, and tell the display
that we have changed it."
Smalltalk at:#LastCopyBuffer put:nil.
Smalltalk at:#CopyBuffer put:something.
(device setSelection:something owner:drawableId) ifFalse:[
'PSEUDOVIEW: selection failed' errorPrintNL
]
!
selectionAsString
"our current selection as a string"
|o s|
o := Smalltalk at:#CopyBuffer.
s := o.
o isString ifFalse:[
o isNil ifTrue:[
s := ''
] ifFalse:[
(o isKindOf:StringCollection) ifTrue:[
s := o asStringWithCRsFrom:1 to:(o size) compressTabs:false withCR:false
] ifFalse:[
s := o storeString
]
]
].
^ s
!
selectionRequest:propertyID target:targetID selection:selectionID from:windowID
"someone asks for our selection"
|o s stream|
"
the code below has been hacked in a hurry -
it MUST go into the XWorkstation class,
since PseudoV should stay independend of any particular
implementation (i.e. indep. of the display device)
Expect this stuff to vanish in the next version ...
"
targetID == (device atomIDOfLENGTH) ifTrue:[
"the other one wants to know the size of our selection ..."
s := self selectionAsString.
device
setLengthProperty:propertyID
value:s size
for:windowID.
device
sendSelectionNotifySelection:selectionID
property:propertyID
target:targetID
from:drawableId
to:windowID.
^ self
].
targetID == (device atomIDOfSTRING) ifTrue:[
s := self selectionAsString.
device
sendSelection:s
property:propertyID
target:targetID
from:drawableId
to:windowID.
^ self
].
o := Smalltalk at:#CopyBuffer.
stream := WriteStream on:(ByteArray new:200).
o storeBinaryOn:stream.
device
sendSelection:(stream contents)
property:propertyID
target:(device atomIDOf:'ST_OBJECT' create:true)
from:drawableId
to:windowID
!
selectionNotify:propertyID target:targetID selection:selectionID from:windowID
"this is sent from the display as a reply to a request for a
selection. The view should be prepared to paste the received
string (it asked for it so that should not be a problem)"
|s|
"workaround a bug in olvwm:
it looses selection when bringing a view
up front
"
propertyID == 0 ifTrue:[
"invalid olvwm behavior"
s := Smalltalk at:#LastCopyBuffer
] ifFalse:[
targetID == (device atomIDOfSTRING) ifTrue:[
"
a returned string
"
s := device getTextProperty:propertyID from:windowID.
s notNil ifTrue:[
(s endsWith:Character cr) ifTrue:[
s := s asStringCollection copyWith:''
]
]
] ifFalse:[
"
a returned object
"
s := device getObjectProperty:propertyID from:windowID.
].
].
s notNil ifTrue:[
self paste:s
]
! !
!PseudoView methodsFor:'event handling'!
catchExpose
"this MUST be sent BEFORE doing a bit-blt copy (i.e. copyFrom...),
to tell the sensor that incoming expose events are to be remembered.
Sometime after the bit-blt, waitForExpose should be sent, to finally
suspend until the expose/noExpose event arrives.
This may be an X speciality and be reimplemented to handle devices
which do not need this kind of asynchronous bit-blt confirmation.
"
|wg|
gotExpose := false.
wg := self windowGroup.
wg notNil ifTrue:[
"
must process eny pending expose events, since
usually the origin is changed soon so that previous
expose events coordinates are invalid
"
wg processExposeEvents.
wg sensor catchExpose
]
!
waitForExpose
"wait until an expose event arrives (to wait for scroll-finish)"
|wg|
wg := self windowGroup.
wg notNil ifTrue:[
"
a normal (suspendable) view.
wait by doing a real wait
"
wg waitForExposeFor:self
] ifFalse:[
"
a pure event driven view.
wait by doing a direct dispatch loop until the event arrives.
"
[gotExpose] whileFalse:[
device dispatchExposeEventFor:drawableId
].
]
!
noExpose
"a no expose event after a scroll (event-mode only)"
exposePending := false.
gotExpose := true
!
deviceGraphicExposeX:x y:y width:w height:h
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a graphicExpose with the logical coordinates."
|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 graphicExposeX:lx y:ly width:lw height:lh
!
deviceExposeX:x y:y width:w height:h
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send an expose with the logical coordinates."
|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 exposeX:lx y:ly width:lw height:lh
!
deviceKeyPress:key x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a keyPress with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self keyPress:key x:lx y:ly
!
deviceKeyRelease:key x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a keyRelease with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self keyRelease:key x:lx y:ly
!
deviceButtonPress:butt x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a buttonPress with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self buttonPress:butt x:lx y:ly
!
deviceButtonRelease:butt x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a buttonRelease with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self buttonRelease:butt x:lx y:ly
!
deviceButtonShiftPress:butt x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a buttonShiftPress with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self buttonShiftPress:butt x:lx y:ly
!
deviceButtonMultiPress:butt x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a buttonMultiPress with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self buttonMultiPress:butt x:lx y:ly
!
deviceButtonMotion:state x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a buttonMotion with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self buttonMotion:state x:lx y:ly
!
devicePointerEnter:state x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
and send a pointerEnter with the logical coordinates."
|lx ly|
lx := x.
ly := y.
transformation notNil ifTrue:[
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
self pointerEnter:state x:lx y:ly
!
graphicExposeX:x y:y width:w height:h
"an expose event after a scroll - do normal redraw processing"
self exposeX:x y:y width:w height:h
!
exposeX:x y:y width:w height:h
"an expose event - nothing done here"
^ self
!
keyPress:key x:x y:y
"a key was pressed in this view.
Here only keyCommands are handled - more action has to
be implemented by redefining this method"
|action|
keyCommands notNil ifTrue:[
action := keyCommands at:key ifAbsent:[nil].
action notNil ifTrue:[
action value
]
]
!
keyRelease:key x:x y:y
"default action is to do nothing"
^ self
!
buttonShiftPress:button x:x y:y
"button was pressed with shift - default to unshift-press action"
^ self buttonPress:button x:x y:y
!
buttonPress:button x:x y:y
"button was pressed - if its middle button and there is a menu,
show it."
((button == 2) or:[button == #menu]) ifTrue:[
middleButtonMenu notNil ifTrue:[
middleButtonMenu showAtPointer
]
]
!
buttonMultiPress:button x:x y:y
"button was pressed fast after previous press - default to press-again"
^ self buttonPress:button x:x y:y
!
buttonRelease:button x:x y:y
"button was released - do nothing here"
^ self
!
buttonMotion:state x:x y:y
"mouse was moved while button is pressed - do nothing here"
^ self
!
focusIn
"got keayboard focus - do nothing here"
^ self
!
focusOut
"lost keayboard focus - do nothing here"
^ self
!
pointerEnter:state x:x y:y
"mouse cursor entered view - do nothing here"
^ self
!
pointerLeave:state
"mouse cursor left view - do nothing here"
^ self
!
resizeRequest
^ self
! !
!PseudoView methodsFor: 'binary storage'!
readBinaryContentsFrom: stream manager: manager
"tell the newly restored View to recreate itself.
Bug: does not work correctly yet.
(restored view looses its position & wg process)"
super readBinaryContentsFrom: stream manager: manager.
gcId := nil.
drawableId := nil.
self recreate.
realized ifTrue:[
self rerealize
]
"
|s|
s := 'storedLabel.boss' asFilename writeStream binary.
(Label label:'hello there') realize storeBinaryOn:s.
s close.
"
"
|s l|
s := 'storedLabel.boss' asFilename writeStream binary.
(l := Label label:'hello there') open.
(Delay forSeconds:10) wait.
l storeBinaryOn:s.
s close.
l destroy.
"
"
|s|
s := 'storedLabel.boss' asFilename readStream binary.
(Object readBinaryFrom:s)
"
! !