"
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.
"
'From Smalltalk/X, Version:2.10.4 on 7-nov-1994 at 1:19:10'!
View subclass:#ObjectView
instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
releaseAction shiftPressAction doublePressAction motionAction
keyPressAction selection gridShown gridPixmap
scaleMetric dragObject leftHandCursor readCursor oldCursor
movedObject moveStartPoint moveDelta buffer documentFormat
canDragOutOfView rootMotion
rootView aligning gridAlign'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
!
ObjectView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
'!
!ObjectView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.12 1994-11-21 16:45:37 claus Exp $
"
!
documentation
"
a View which can hold DisplayObjects, can make selections, move them around etc.
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
written spring/summer 89 by claus
"
! !
!ObjectView class methodsFor:'defaults'!
hitDelta
"when clicking an object, allow for hitDelta pixels around object;
0 is exact; 1*pixelPerMillimeter is good for draw programs"
^ 0
! !
!ObjectView methodsFor:'events'!
redrawX:x y:y width:w height:h
|innerX innerY innerW innerH redrawFrame |
innerX := x.
innerY := y.
innerW := w.
innerH := h.
((contents size ~~ 0) or:[gridShown]) ifTrue:[
redrawFrame := Rectangle left:innerX top:innerY
width:innerW height:innerH.
self redrawObjectsInVisible:redrawFrame
]
!
buttonMotion:buttonMask x:buttX y:buttY
"user moved mouse while button pressed"
|xpos ypos movePoint limitW limitH|
"is it the select or 1-button ?"
(device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
(device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
^ self
].
].
lastButt notNil ifTrue:[
xpos := buttX.
ypos := buttY.
"check against visible limits if move outside is not allowed"
rootMotion ifFalse:[
limitW := width.
limitH := height.
transformation notNil ifTrue:[
limitW := transformation applyInverseToX:width.
limitH := transformation applyInverseToY:height.
].
(xpos < 0) ifTrue:[
xpos := 0
] ifFalse: [
(xpos > limitW) ifTrue:[xpos := limitW]
].
(ypos < 0) ifTrue:[
ypos := 0
] ifFalse: [
(ypos > limitH) ifTrue:[ypos := limitH]
]
].
movePoint := xpos @ ypos.
(xpos == (lastButt x)) ifTrue:[
(ypos == (lastButt y)) ifTrue:[
^ self "no move"
]
].
motionAction notNil ifTrue:[
motionAction value:movePoint
].
lastButt := movePoint
]
!
buttonPress:button x:x y:y
"user pressed left button"
((button == 1) or:[button == #select]) ifTrue:[
pressAction notNil ifTrue:[
lastButt := x @ y.
pressAction value:lastButt
]
] ifFalse:[
super buttonPress:button x:x y:y
]
!
buttonRelease:button x:x y:y
((button == 1) or:[button == #select]) ifTrue:[
releaseAction notNil ifTrue:[releaseAction value]
] ifFalse:[
super buttonRelease:button x:x y:y
]
!
buttonShiftPress:button x:x y:y
"user pressed left button with shift"
((button == 1) or:[button == #select]) ifTrue:[
shiftPressAction notNil ifTrue:[
lastButt := x @ y.
shiftPressAction value:lastButt
]
] ifFalse:[
super buttonShiftPress:button x:x y:y
]
!
buttonMultiPress:button x:x y:y
"user pressed left button twice (or more)"
((button == 1) or:[button == #select]) ifTrue:[
doublePressAction notNil ifTrue:[
doublePressAction value:(x @ y)
]
] ifFalse:[
super buttonMultiPress:button x:x y:y
]
!
keyPress:key x:x y:y
keyPressAction notNil ifTrue:[
selection notNil ifTrue:[
self selectionDo: [:obj |
obj keyInput:key
]
]
]
! !
!ObjectView methodsFor:'scrolling'!
horizontalScrollStep
"return the amount to scroll when stepping left/right."
scaleMetric == #inch ifTrue:[
^ (device horizontalPixelPerInch * (1/2)) asInteger
].
^ (device horizontalPixelPerMillimeter * 20) asInteger
!
verticalScrollStep
"return the amount to scroll when stepping left/right."
scaleMetric == #inch ifTrue:[
^ (device verticalPixelPerInch * (1/2)) asInteger
].
^ (device verticalPixelPerMillimeter * 20) asInteger
! !
!ObjectView methodsFor:'queries'!
heightOfContents
"answer the height of the document in pixels"
|h|
h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
transformation isNil ifTrue:[
^ h rounded
].
^ (transformation applyScaleY:h) rounded
!
widthOfContentsInMM
"answer the width of the document in millimeters"
"landscape"
(documentFormat = 'a1l') ifTrue:[
^ 840
].
(documentFormat = 'a2l') ifTrue:[
^ 592
].
(documentFormat = 'a3l') ifTrue:[
^ 420
].
(documentFormat = 'a4l') ifTrue:[
^ 296
].
(documentFormat = 'a5l') ifTrue:[
^ 210
].
(documentFormat = 'a6l') ifTrue:[
^ 148
].
(documentFormat = 'letterl') ifTrue:[
^ 11 * 25.4
].
(documentFormat = 'a1') ifTrue:[
^ 592
].
(documentFormat = 'a2') ifTrue:[
^ 420
].
(documentFormat = 'a3') ifTrue:[
^ 296
].
(documentFormat = 'a4') ifTrue:[
^ 210
].
(documentFormat = 'a5') ifTrue:[
^ 148
].
(documentFormat = 'a6') ifTrue:[
^ 105
].
(documentFormat = 'letter') ifTrue:[
^ 8.5 * 25.4
].
"*** more formats needed here ...***"
"assuming window size is document size"
^ (width / self horizontalPixelPerMillimeter:1) asInteger
!
heightOfContentsInMM
"answer the height of the document in millimeters"
"landscape"
(documentFormat = 'a1l') ifTrue:[
^ 592
].
(documentFormat = 'a2l') ifTrue:[
^ 420
].
(documentFormat = 'a3l') ifTrue:[
^ 296
].
(documentFormat = 'a4l') ifTrue:[
^ 210
].
(documentFormat = 'a5l') ifTrue:[
^ 148
].
(documentFormat = 'a6l') ifTrue:[
^ 105
].
(documentFormat = 'letterl') ifTrue:[
^ 8.5 * 25.4
].
(documentFormat = 'a1') ifTrue:[
^ 840
].
(documentFormat = 'a2') ifTrue:[
^ 592
].
(documentFormat = 'a3') ifTrue:[
^ 420
].
(documentFormat = 'a4') ifTrue:[
^ 296
].
(documentFormat = 'a5') ifTrue:[
^ 210
].
(documentFormat = 'a6') ifTrue:[
^ 148
].
(documentFormat = 'letter') ifTrue:[
^ 11 * 25.4
].
"*** more formats needed here ...***"
"assuming window size is document size"
^ (height / self verticalPixelPerMillimeter:1) asInteger
!
widthOfContents
"answer the width of the document in pixels"
|w|
w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
transformation isNil ifTrue:[
^ w rounded
].
^ (transformation applyScaleX:w) rounded
! !
!ObjectView methodsFor:'user interface'!
alignToGrid:aPoint
"round aPoint to the next nearest point on the grid"
|p0 pG|
aligning ifFalse:[
^ aPoint
].
viewOrigin ~= (0@0) ifTrue:[
p0 := aPoint - viewOrigin.
pG := (p0 grid:gridAlign) rounded. "/grid:(1 @ 1).
^ pG + viewOrigin
].
^ (aPoint grid:gridAlign) rounded
!
startSelectOrMove:aPoint
"start a rectangleDrag or objectMove - if aPoint hits an object,
an object move is started, otherwise a rectangleDrag.
This is typically the button pressAction."
|anObject|
anObject := self findObjectAtVisible:aPoint.
anObject notNil ifTrue:[
(self isSelected:anObject) ifFalse:[self unselect].
self startObjectMove:anObject at:aPoint.
^ self
].
"nothing was hit by this click - this starts a group select"
self unselect.
self startRectangleDrag:aPoint
!
selectMore:aPoint
"add/remove an object from the selection"
|anObject|
anObject := self findObjectAtVisible:aPoint.
anObject notNil ifTrue:[
(self isSelected:anObject) ifTrue:[
"remove from selection"
self removeFromSelection:anObject
] ifFalse:[
"add to selection"
self addToSelection:anObject
]
].
^ self
!
startSelectMoreOrMove:aPoint
"add/remove object hit by aPoint, then start a rectangleDrag or move
- if aPoint hits an object, a move is started, otherwise a rectangleDrag.
This is typically the button shiftPressAction."
|anObject|
anObject := self findObjectAtVisible:aPoint.
anObject notNil ifTrue:[
(self isSelected:anObject) ifTrue:[
"remove from selection"
self removeFromSelection:anObject
] ifFalse:[
"add to selection"
self addToSelection:anObject
].
self startObjectMove:selection at:aPoint.
^ self
].
self unselect.
self startRectangleDrag:aPoint
! !
!ObjectView methodsFor:'initialization'!
setInitialDocumentFormat
(Language == #english) ifTrue:[
documentFormat := 'letter'.
scaleMetric := #inch
] ifFalse:[
documentFormat := 'a4'.
scaleMetric := #mm
].
!
initialize
|pixPerMM|
super initialize.
viewBackground := White.
bitGravity := #NorthWest.
contents := OrderedCollection new.
gridShown := false.
canDragOutOfView := false.
rootView := DisplayRootView new.
rootView noClipByChildren.
rootMotion := false.
self setInitialDocumentFormat.
readCursor := Cursor read.
leftHandCursor := Cursor leftHand.
sorted := false.
aligning := false
!
initEvents
self backingStore:true.
self enableButtonEvents.
self enableButtonMotionEvents
! !
!ObjectView methodsFor:'drawing'!
redrawObjectsInVisible:visRect
"redraw all objects which have part of themselfes in a vis rectangle
draw only in (i.e. clip output to) aRectangle"
|vis|
shown ifTrue:[
vis := visRect.
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
transformation notNil ifTrue:[
vis := vis origin truncated
corner:(vis corner + (1@1)) truncated.
].
self clippedTo:vis do:[
self clearRectangle:vis.
self redrawObjectsIntersectingVisible:vis
]
]
!
redrawObjectsIntersectingVisible:aRectangle
"redraw all objects which have part of themself in a vis rectangle"
self objectsIntersectingVisible:aRectangle do:[:theObject |
self show:theObject
]
!
redraw
"redraw complete View"
shown ifTrue:[
self clear.
self redrawObjects
]
!
redrawObjectsIntersecting:aRectangle
"redraw all objects which have part of themself in aRectangle"
self objectsIntersecting:aRectangle do:[:theObject |
self show:theObject
]
!
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
|vFrame org|
(aGC == self) ifTrue:[
shown "realized" ifFalse:[^ self].
org := viewOrigin.
vFrame := Rectangle origin:org
corner:(viewOrigin + (width @ height)).
self redrawObjectsIntersecting:vFrame
] ifFalse:[
"loop over pages"
org := 0 @ 0.
vFrame := Rectangle origin:org
corner:(org + (width @ height)).
"
self redrawObjectsIntersecting:vFrame
"
self objectsIntersecting:vFrame do:[:theObject |
theObject drawIn:aGC
]
]
!
redrawObjects
"redraw all objects"
self redrawObjectsOn:self
!
showDragging:something offset:anOffset
"show an object while dragging"
|drawOffset top drawer|
rootMotion ifTrue:[
"drag in root-window"
top := self topView.
drawOffset := device translatePoint:anOffset
from:(self id) to:(rootView id).
drawer := rootView
] ifFalse:[
drawOffset := anOffset.
drawer := self
].
self forEach:something do:[:anObject |
anObject drawDragIn:drawer offset:drawOffset
]
!
redrawObjectsIn:aRectangle
"redraw all objects which have part of themselfes in aRectangle
draw only in (i.e. clip output to) aRectangle"
|visRect|
shown ifTrue:[
visRect := Rectangle origin:(aRectangle origin - viewOrigin)
extent:(aRectangle extent).
clipRect notNil ifTrue:[
visRect := visRect intersect:clipRect
].
transformation notNil ifTrue:[
visRect := visRect origin truncated
corner:(visRect corner + (1@1)) truncated.
].
self clippedTo:visRect do:[
self clearRectangle:visRect.
self redrawObjectsIntersecting:aRectangle
]
]
!
redrawScale
"redraw the scales"
self redrawHorizontalScale.
self redrawVerticalScale
!
redrawObjectsAbove:anObject intersecting:aRectangle
"redraw all objects which have part of themself in aRectangle
and are above (in front of) anObject"
self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
self show:theObject
]
!
redrawObjectsAbove:anObject intersectingVisible:aRectangle
"redraw all objects which have part of themself in a vis rectangle
and are above (in front of) anObject"
self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
self show:theObject
]
!
redrawObjectsAbove:anObject in:aRectangle
"redraw all objects which have part of themselfes in aRectangle
and are above (in front of) anObject.
draw only in (i.e. clip output to) aRectangle"
|vis|
shown ifTrue:[
vis := aRectangle.
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
self clippedTo:vis do:[
self redrawObjectsAbove:anObject intersecting:vis
]
]
!
redrawObjectsAbove:anObject inVisible:aRectangle
"redraw all objects which have part of themselfes in a vis rectangle
and are above (in front of) anObject.
draw only in (i.e. clip output to) aRectangle"
|vis|
shown ifTrue:[
vis := aRectangle.
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
self clippedTo:vis do:[
self redrawObjectsAbove:anObject intersectingVisible:vis
]
]
!
show:anObject
"show the object, either selected or not"
(self isSelected:anObject) ifTrue:[
self showSelected:anObject
] ifFalse:[
self showUnselected:anObject
]
!
showSelected:anObject
"show an object as selected"
anObject drawSelectedIn:self
!
showUnselected:anObject
"show an object as unselected"
anObject drawIn:self
! !
!ObjectView methodsFor:'selections'!
unselect
"unselect - hide selection; clear selection buffer"
self hideSelection.
selection := nil
!
select:something
"select something - hide previouse selection, set to something and hilight"
(selection == something) ifFalse:[
self hideSelection.
selection := something.
self showSelection
]
!
withSelectionHiddenDo:aBlock
"evaluate aBlock while selection is hidden"
|sel|
sel := selection.
self unselect.
aBlock value.
self select:sel
!
selectionDo:aBlock
"apply block to every object in selection"
self forEach:selection do:aBlock
!
showSelection
"show the selection - draw hilights - whatever that is"
self selectionDo:[:object |
self showSelected:object
]
!
hideSelection
"hide the selection - undraw hilights - whatever that is"
self selectionDo:[:object |
self showUnselected:object
]
!
selectAll
"select all objects"
self hideSelection.
selection := contents copy.
self showSelection
!
addToSelection:anObject
"add anObject to the selection"
(selection isKindOf:Collection) ifFalse:[
selection := OrderedCollection with:selection
].
selection add:anObject.
self showSelected:anObject
!
removeFromSelection:anObject
"remove anObject from the selection"
(selection isKindOf:Collection) ifTrue:[
selection remove:anObject ifAbsent:[nil].
(selection size == 1) ifTrue:[
selection := selection first
]
] ifFalse:[
(selection == anObject) ifTrue:[
selection := nil
]
].
self showUnselected:anObject
!
selectAllIn:aRectangle
"select all objects fully in aRectangle"
self hideSelection.
selection := OrderedCollection new.
self objectsIn:aRectangle do:[:theObject |
selection add:theObject
].
(selection size == 0) ifTrue:[
selection := nil
] ifFalse:[
(selection size == 1) ifTrue:[selection := selection first]
].
self showSelection
!
selectAllIntersecting:aRectangle
"select all objects touched by aRectangle"
self hideSelection.
selection := OrderedCollection new.
self objectsIntersecting:aRectangle do:[:theObject |
selection add:theObject
].
(selection size == 0) ifTrue:[
selection := nil
] ifFalse:[
(selection size == 1) ifTrue:[selection := selection first]
].
self showSelection
! !
!ObjectView methodsFor:'testing objects'!
frameOf:anObjectOrCollection
"answer the maximum extent defined by the argument, anObject or a
collection of objects"
|first frameAll|
anObjectOrCollection isNil ifTrue:[^ nil ].
first := true.
self forEach:anObjectOrCollection do:[:theObject |
first ifTrue:[
frameAll := theObject frame.
first := false
] ifFalse:[
frameAll := frameAll merge:(theObject frame)
]
].
^ frameAll
!
isObscured:something
"return true, if the argument something, anObject or a collection of
objects is obscured (partially or whole) by any other object"
self forEach:something do:[:anObject |
(self objectIsObscured:anObject) ifTrue:[
^ true
]
].
^ false
!
findObjectAt:aPoint
"find the last object (by looking from back to front) which is hit by
the argument, aPoint - this is the topmost object hit"
|hdelta|
hdelta := self class hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
].
^ nil
!
findObjectAtVisible:aPoint
"find the last object (by looking from back to front) which is hit by
a visible point - this is the topmost object hit"
^ self findObjectAt:(aPoint + viewOrigin)
!
findObjectAt:aPoint suchThat:aBlock
"find the last object (back to front ) which is hit by
the argument, aPoint and for which the testBlock, aBlock evaluates to
true"
|hdelta|
hdelta := self class hitDelta.
contents reverseDo:[:object |
(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
(aBlock value:object) ifTrue:[^ object]
]
].
^ nil
!
findObjectAtVisible:aPoint suchThat:aBlock
"find the last object (back to front ) which is hit by
the argument, aPoint and for which the testBlock, aBlock evaluates to
true"
^ self findObjectAt:(aPoint + viewOrigin) suchThat:aBlock
!
canMove:something
"return true, if the argument, anObject or a collection can be moved"
(something isKindOf:Collection) ifTrue:[
self forEach:something do:[:theObject |
(theObject canBeMoved) ifFalse:[^ false]
].
^ true
].
^ something canBeMoved
!
isSelected:anObject
"return true, if the argument, anObject is in the selection"
selection isNil ifTrue:[^ false].
(selection == anObject) ifTrue:[^ true].
(selection isKindOf:Collection) ifTrue:[
^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
].
^ false
!
objectIsObscured:objectToBeTested
"return true, if the argument, anObject is obscured (partially or whole)
by any other object"
|frameToBeTested frameleft frameright frametop framebot
objectsFrame startIndex|
(objectToBeTested == (contents last)) ifTrue:[
"quick return if object is on top"
^ false
].
frameToBeTested := self frameOf:objectToBeTested.
frameleft := frameToBeTested left.
frameright := frameToBeTested right.
frametop := frameToBeTested top.
framebot := frameToBeTested bottom.
"check objects after the one to check"
startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
contents from:(startIndex + 1) to:(contents size) do:[:object |
objectsFrame := self frameOf:object.
(objectsFrame right < frameleft) ifFalse:[
(objectsFrame left > frameright) ifFalse:[
(objectsFrame bottom < frametop) ifFalse:[
(objectsFrame top > framebot) ifFalse:[
^ true
]
]
]
]
].
^ false
! !
!ObjectView methodsFor:'misc'!
forEach:aCollection do:aBlock
"apply block to every object in a collectioni;
(adds a check for non-collection)"
aCollection isNil ifTrue:[^self].
(aCollection isKindOf:Collection) ifTrue:[
aCollection do:[:object |
object notNil ifTrue:[
aBlock value:object
]
]
] ifFalse: [
aBlock value:aCollection
]
!
objectsIntersecting:aRectangle do:aBlock
"do something to every object which intersects a rectangle"
|f top bot
firstIndex "{ Class: SmallInteger }"
delta "{ Class: SmallInteger }"
theObject
nObjects "{ Class: SmallInteger }"|
sorted ifFalse:[
"have to check every object"
contents do:[:theObject |
(theObject frame intersects:aRectangle) ifTrue:[
aBlock value:theObject
]
].
^ self
].
nObjects := contents size.
(nObjects == 0) ifTrue:[^ self].
"can break, when 1st object below aRectangle is reached"
bot := aRectangle bottom.
top := aRectangle top.
"binary search an object in aRectangle ..."
delta := nObjects // 2.
firstIndex := delta.
(firstIndex == 0) ifTrue:[
firstIndex := 1
].
theObject := contents at:firstIndex.
(theObject frame bottom < top) ifTrue:[
[theObject frame bottom < top and:[delta > 1]] whileTrue:[
delta := delta // 2.
firstIndex := firstIndex + delta.
theObject := contents at:firstIndex
]
] ifFalse:[
[theObject frame top > bot and:[delta > 1]] whileTrue:[
delta := delta // 2.
firstIndex := firstIndex - delta.
theObject := contents at:firstIndex
]
].
"now, theObject at:firstIndex is in aRectangle; go backward to the object
following first non-visible"
[theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
firstIndex := firstIndex - 1.
theObject := contents at:firstIndex
].
firstIndex to:nObjects do:[:index |
theObject := contents at:index.
f := theObject frame.
(f intersects:aRectangle) ifTrue:[
aBlock value:theObject
] ifFalse:[
(f top > bot) ifTrue:[^ self]
]
]
!
setDefaultActions
motionAction := [:movePoint | nil].
releaseAction := [nil]
!
setMoveActions
motionAction := [:movePoint | self doObjectMove:movePoint].
releaseAction := [self endObjectMove]
!
objectsIntersectingVisible:aRectangle do:aBlock
"do something to every object which intersects a visible rectangle"
|absRect|
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
height:(aRectangle height).
self objectsIntersecting:absRect do:aBlock
!
objectsIntersecting:aRectangle
"answer a Collection of objects intersecting the argument, aRectangle"
|newCollection|
newCollection := OrderedCollection new.
self objectsIntersecting:aRectangle do:[:theObject |
newCollection add:theObject
].
(newCollection size == 0) ifTrue:[^ nil].
^ newCollection
!
documentFormat:aFormatString
"set the document format (mostly used by scrollbars).
The argument should be a string such as 'a4', 'a5'
or 'letter'. See widthOfContentsInMM for supported formats."
aFormatString ~= documentFormat ifTrue:[
documentFormat := aFormatString.
self contentsChanged.
self defineGrid.
gridShown ifTrue:[
self clear.
self redraw
]
]
!
setRectangleDragActions
motionAction := [:movePoint | self doRectangleDrag:movePoint].
releaseAction := [self endRectangleDrag]
!
setLineDragActions
motionAction := [:movePoint | self doLineDrag:movePoint].
releaseAction := [self endLineDrag]
!
objectsIn:aRectangle do:aBlock
"do something to every object which is completely in a rectangle"
|bot|
sorted ifTrue:[
bot := aRectangle bottom.
contents do:[:theObject |
(theObject isContainedIn:aRectangle) ifTrue:[
aBlock value:theObject
] ifFalse:[
theObject frame top > bot ifTrue:[^ self]
]
].
^ self
].
contents do:[:theObject |
(theObject isContainedIn:aRectangle) ifTrue:[
aBlock value:theObject
]
]
!
objectsInVisible:aRectangle do:aBlock
"do something to every object which is completely in a
visible rectangle"
|absRect|
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
height:(aRectangle height).
self objectsIn:absRect do:aBlock
!
visibleObjectsDo:aBlock
"do something to every visible object"
|absRect|
absRect := Rectangle left:viewOrigin x
top:viewOrigin y
width:width
height:height.
self objectsIntersecting:absRect do:aBlock
!
numberOfObjectsIntersectingVisible:aRectangle
"answer the number of objects intersecting the argument, aRectangle"
|absRect|
absRect := Rectangle
left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
height:(aRectangle height).
^ self numberOfObjectsIntersecting:aRectangle
!
numberOfObjectsIntersecting:aRectangle
"answer the number of objects intersecting the argument, aRectangle"
|tally|
tally := 0.
contents do:[:theObject |
(theObject frame intersects:aRectangle) ifTrue:[
tally := tally + 1
]
].
^ tally
!
objectsIntersectingVisible:aRectangle
"answer a Collection of objects intersecting a visible aRectangle"
|absRect|
absRect := Rectangle left:(aRectangle left + viewOrigin x)
top:(aRectangle top + viewOrigin y)
width:(aRectangle width)
height:(aRectangle height).
^ self objectsIntersecting:absRect
!
objectsBelow:objectToBeTested do:aBlock
"do something to every object below objectToBeTested
(does not mean obscured by - simply below in hierarchy)"
|endIndex|
endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
contents from:1 to:(endIndex - 1) do:aBlock
!
objectsAbove:objectToBeTested do:aBlock
"do something to every object above objectToBeTested
(does not mean obscured - simply above in hierarchy)"
|startIndex|
startIndex := contents identityIndexOf:objectToBeTested
ifAbsent:[self error].
contents from:startIndex to:(contents size) do:aBlock
!
objectsAbove:anObject intersecting:aRectangle do:aBlock
"do something to every object above objectToBeTested
and intersecting aRectangle"
self objectsAbove:anObject do:[:theObject |
(theObject frame intersects:aRectangle) ifTrue:[
aBlock value:theObject
]
]
!
rectangleForScroll
"find the area occupied by visible objects"
|left right top bottom frame oLeft oRight oTop oBottom orgX orgY|
orgX := viewOrigin x.
orgY := viewOrigin y.
left := 9999.
right := 0.
top := 9999.
bottom := 0.
self visibleObjectsDo:[:anObject |
frame := anObject frame.
oLeft := frame left - orgX.
oRight := frame right - orgX.
oTop := frame top - orgY.
oBottom := frame bottom - orgY.
(oLeft < left) ifTrue:[left := oLeft].
(oRight > right) ifTrue:[right := oRight].
(oTop < top) ifTrue:[top := oTop].
(oBottom > bottom) ifTrue:[bottom := oBottom]
].
(left < margin) ifTrue:[left := margin].
(top < margin) ifTrue:[top := margin].
(right > (width - margin)) ifTrue:[right := width - margin].
(bottom > (height - margin)) ifTrue:[bottom := height - margin].
((left > right) or:[top > bottom]) ifTrue:[^ nil].
^ Rectangle left:left right:right top:top bottom:bottom
! !
!ObjectView methodsFor:'layout manipulation'!
moveObject:anObject by:delta
"change the position of anObject by delta, aPoint"
self moveObject:anObject to:(anObject origin + delta)
!
move:something by:delta
"change the position of something, an Object or Collection
by delta, aPoint"
(delta x == 0) ifTrue:[
(delta y == 0) ifTrue:[^ self]
].
self forEach:something do:[:anObject |
self moveObject:anObject by:delta
]
!
moveObject:anObject to:newOrigin
"move anObject to newOrigin, aPoint"
|oldOrigin oldFrame newFrame
objectsIntersectingOldFrame objectsIntersectingNewFrame
wasObscured isObscured intersects
vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
griddedNewOrigin := self alignToGrid:newOrigin.
oldOrigin := anObject origin.
(oldOrigin = griddedNewOrigin) ifTrue:[^ self].
oldFrame := self frameOf:anObject.
objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
wasObscured := self isObscured:anObject.
anObject moveTo:griddedNewOrigin.
newFrame := self frameOf:anObject.
objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
"try to redraw the minimum possible"
"if no other object intersects both frames we can do a copy:"
intersects := oldFrame intersects:newFrame.
intersects ifFalse:[
gridShown ifFalse:[
transformation isNil ifTrue:[
(objectsIntersectingOldFrame size == 1) ifTrue:[
(objectsIntersectingNewFrame size == 1) ifTrue:[
(oldFrame isContainedIn:self clipRect) ifTrue:[
vx := viewOrigin x.
vy := viewOrigin y.
oldLeft := oldFrame left - vx.
oldTop := oldFrame top - vy.
newLeft := newFrame left - vx.
newTop := newFrame top - vy.
w := oldFrame width.
h := oldFrame height.
((newLeft < width) and:[newTop < height]) ifTrue:[
((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
self copyFrom:self x:oldLeft y:oldTop
toX:newLeft y:newTop
width:w height:h.
self waitForExpose
]
].
((oldLeft < width) and:[oldTop < height]) ifTrue:[
((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
self clearRectangleX:oldLeft y:oldTop width:w height:h.
"/ self fillRectangleX:oldLeft y:oldTop width:w height:h
"/ with:viewBackground
]
].
^ self
]
]
]
]
]
].
isObscured := self isObscured:anObject.
(oldFrame intersects:newFrame) ifTrue:[
isObscured ifFalse:[
self redrawObjectsIn:oldFrame.
self show: anObject
] ifTrue:[
self redrawObjectsIn:(oldFrame merge:newFrame)
]
] ifFalse:[
self redrawObjectsIn:oldFrame.
isObscured ifFalse:[
self show: anObject
] ifTrue:[
self redrawObjectsIn:newFrame
]
]
!
move:something to:aPoint in:aView
"can only happen when dragOutOfView is true
- should be redefined in subclasses"
self notify:'cannot move object(s) out of view'
!
move:something to:aPoint inAlienViewId:aViewId
"can only happen when dragOutOfView is true
- should be redefined in subclasses"
self notify:'cannot move object(s) to alien views'
!
objectToFront:anObject
"bring the argument, anObject to front"
|wasObscured|
anObject notNil ifTrue:[
wasObscured := self isObscured:anObject.
contents remove:anObject.
contents addLast:anObject.
wasObscured ifTrue:[
"old:
self redrawObjectsIn:(anObject frame)
"
self hideSelection.
self show:anObject.
self showSelection
]
]
!
toFront:something
"bring the argument, anObject or a collection of objects to front"
self forEach:something do:[:anObject |
self objectToFront:anObject
]
!
selectionToFront
"bring the selection to front"
self toFront:selection
!
objectToBack:anObject
"bring the argument, anObject to back"
anObject notNil ifTrue:[
contents remove:anObject.
contents addFirst:anObject.
(self isObscured:anObject) ifTrue:[
self redrawObjectsIn:(anObject frame)
]
]
!
toBack:something
"bring the argument, anObject or a collection of objects to back"
self forEach:something do:[:anObject |
self objectToBack:anObject
]
!
selectionToBack
"bring the selection to back"
self toBack:selection
!
alignLeft:something
|leftMost|
leftMost := 999999.
self forEach:something do:[:anObject |
leftMost := leftMost min:(anObject frame left)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(leftMost @ (anObject frame top))
]
]
!
alignRight:something
|rightMost|
rightMost := -999999.
self forEach:something do:[:anObject |
rightMost := rightMost max:(anObject frame right)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(rightMost - (anObject frame width))
@ (anObject frame top)
]
]
!
alignTop:something
|topMost|
topMost := 999999.
self forEach:something do:[:anObject |
topMost := topMost min:(anObject frame top)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:((anObject frame left) @ topMost)
]
]
!
alignBottom:something
|botMost|
botMost := -999999.
self forEach:something do:[:anObject |
botMost := botMost max:(anObject frame bottom)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(anObject frame left)
@
(botMost - (anObject frame height))
]
]
!
selectionAlignLeft
"align selected objects left"
self alignLeft:selection
!
selectionAlignRight
"align selected objects right"
self alignRight:selection
!
selectionAlignTop
"align selected objects at top"
self alignTop:selection
!
selectionAlignBottom
"align selected objects at bottom"
self alignBottom:selection
! !
!ObjectView methodsFor:'adding / removing'!
deleteSelection
"delete the selection"
buffer := selection.
self unselect.
self remove:buffer.
!
pasteBuffer
"add the objects in the paste-buffer"
self unselect.
self addSelected:buffer
!
copySelection
"copy the selection into the paste-buffer"
buffer := OrderedCollection new.
self selectionDo:[:object |
buffer add:(object copy)
].
self forEach:buffer do:[:anObject |
anObject moveTo:(anObject origin + (8 @ 8))
]
!
addSelected:something
"add something, anObject or a collection of objects to the contents
and select it"
self add:something.
self select:something
!
addWithoutRedraw:something
"add something, anObject or a collection of objects to the contents
do not redraw"
self forEach:something do:[:anObject |
self addObjectWithoutRedraw:anObject
]
!
addObject:anObject
"add the argument, anObject to the contents - with redraw"
anObject notNil ifTrue:[
contents addLast:anObject.
"its on top - only draw this one"
shown "realized" ifTrue:[
self showUnselected:anObject
]
]
!
addObjectWithoutRedraw:anObject
"add the argument, anObject to the contents - no redraw"
anObject notNil ifTrue:[
contents addLast:anObject
]
!
add:something
"add something, anObject or a collection of objects to the contents
with redraw"
self forEach:something do:[:anObject |
self addObject:anObject
]
!
remove:something
"remove something, anObject or a collection of objects from the contents
do redraw"
self forEach:something do:[:anObject |
self removeObject:anObject
]
!
removeObject:anObject
"remove the argument, anObject from the contents - no redraw"
anObject notNil ifTrue:[
self removeFromSelection:anObject.
contents remove:anObject.
shown "realized" ifTrue:[
self redrawObjectsIn:(anObject frame)
]
]
!
removeWithoutRedraw:something
"remove something, anObject or a collection of objects from the contents
do not redraw"
self forEach:something do:[:anObject |
self removeObjectWithoutRedraw:anObject
]
!
removeObjectWithoutRedraw:anObject
"remove the argument, anObject from the contents - no redraw"
anObject notNil ifTrue:[
self removeFromSelection:anObject.
contents remove:anObject
]
!
removeAllWithoutRedraw
"remove all - no redraw"
selection := nil.
contents := OrderedCollection new
!
removeAll
"remove all - redraw"
self removeAllWithoutRedraw.
self redraw
! !
!ObjectView methodsFor:'view manipulation'!
zoom:factor
"set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
0.5 is shrink by 2"
(factor isNil or:[factor = 1]) ifTrue:[
transformation := nil
] ifFalse:[
transformation := WindowingTransformation scale:factor translation:0.
].
self setInnerClip.
gridShown ifTrue:[
self newGrid
].
shown ifTrue:[
self clear.
self redraw
].
self contentsChanged
!
millimeterMetric
(scaleMetric ~~ #mm) ifTrue:[
scaleMetric := #mm.
self newGrid
]
!
inchMetric
(scaleMetric ~~ #inch) ifTrue:[
scaleMetric := #inch.
self newGrid
]
! !
!ObjectView methodsFor:'grid manipulation'!
gridParameters
"used by defineGrid, and in a separate method for
easier redefinition in subclasses.
Returns the parameters in an array of 7 elements,
which control the appearance of the grid-pattern.
elements:
bigStepH number of pixels horizontally between 2 major steps
bigStepV number of pixels vertically between 2 major steps
littleStepH number of pixels horizontally between 2 minor steps
littleStepV number of pixels vertically between 2 minor steps
gridAlignH number of pixels for horizontal grid align
gridAlignV number of pixels for vertical grid align
docBounds true, if document boundary shouldbe shown
"
|mmH mmV bigStepH bigStepV littleStepH littleStepV arr|
"example: 12grid & 12snapIn"
"/ ^ #(12 12 nil nil 12 12 false).
"example: 12grid & 24snapIn"
"/ ^ #(12 12 nil nil 24 24 false).
"default: cm/mm grid & mm snapIn for metric,
1inch , 1/8inch grid & 1/8 inch snapIn"
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
(scaleMetric == #mm) ifTrue:[
"dots every mm; lines every cm"
bigStepH := mmH * 10.0.
bigStepV := mmV * 10.0.
littleStepH := mmH.
littleStepV := mmV
].
(scaleMetric == #inch) ifTrue:[
"dots every eights inch; lines every half inch"
bigStepH := mmH * (25.4 / 2).
bigStepV := mmV * (25.4 / 2).
littleStepH := mmH * (25.4 / 8).
littleStepV := mmV * (25.4 / 8)
].
arr := Array new:8.
arr at:1 put:bigStepH.
arr at:2 put:bigStepV.
arr at:3 put:littleStepH.
arr at:4 put:littleStepV.
arr at:5 put:littleStepH.
arr at:6 put:littleStepV.
arr at:7 put:false.
^ arr
!
defineGrid
"define the grid pattern"
|mmH mmV params showDocumentBoundary gridW gridH
bigStepH bigStepV littleStepH littleStepV hires|
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
hires := self horizontalPixelPerInch > 120.
gridW := (self widthOfContentsInMM * mmH).
gridH := (self heightOfContentsInMM * mmV).
params := self gridParameters.
bigStepH := params at:1.
bigStepV := params at:2.
littleStepH := params at:3.
littleStepV := params at:4.
showDocumentBoundary := params at:7.
transformation notNil ifTrue:[
mmH := mmH * transformation scale x.
mmV := mmV * transformation scale y.
bigStepH := bigStepH * transformation scale x.
bigStepV := bigStepV * transformation scale y.
littleStepH notNil ifTrue:[
littleStepH := littleStepH * transformation scale x.
].
littleStepV notNil ifTrue:[
littleStepV := littleStepV * transformation scale y.
].
].
bigStepH isNil ifTrue:[^ self].
self withCursor:(Cursor wait) do:[
|xp yp y x|
"
up to next full unit
"
gridW := ((gridW // bigStepH) + 1 * bigStepH) asInteger.
gridH := ((gridH // bigStepV) + 1 * bigStepV) asInteger.
gridPixmap := Form width:gridW height:gridH depth:1.
gridPixmap colorMap:(Array with:White with:Black).
gridPixmap clear.
gridPixmap paint:(Color colorId:1).
"draw first row point-by-point"
yp := 0.0.
xp := 0.0.
y := yp asInteger.
[xp <= gridW] whileTrue:[
x := xp rounded.
hires ifTrue:[
gridPixmap displayPointX:(x + 1) y:y.
gridPixmap displayPointX:(x + 2) y:y
].
gridPixmap displayPointX:x y:y.
littleStepH notNil ifTrue:[
xp := xp + littleStepH
] ifFalse:[
xp := xp + bigStepH
]
].
"copy rest from what has been drawn already"
yp := yp + bigStepV.
[yp <= gridH] whileTrue:[
y := yp rounded.
hires ifTrue:[
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:(y + 1)
width:gridW height:1.
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:(y + 2)
width:gridW height:1
].
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:y
width:gridW height:1.
yp := yp + bigStepV
].
"draw first col point-by-point"
xp := 0.0.
yp := 0.0.
x := xp asInteger.
[yp <= gridH] whileTrue:[
y := yp rounded.
hires ifTrue:[
gridPixmap displayPointX:x y:(y + 1).
gridPixmap displayPointX:x y:(y + 2)
].
gridPixmap displayPointX:x y:y.
littleStepV notNil ifTrue:[
yp := yp + littleStepV
] ifFalse:[
yp := yp + bigStepV
]
].
"copy rest from what has been drawn already"
xp := xp + bigStepH.
[xp <= gridW] whileTrue:[
x := xp rounded.
hires ifTrue:[
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:(x + 1) y:0
width:1 height:gridH.
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:(x + 2) y:0
width:1 height:gridH
].
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:x y:0
width:1 height:gridH.
xp := xp + bigStepH
].
showDocumentBoundary ifTrue:[
"
mark the right-end and bottom of the document
"
gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
].
]
!
newGrid
"define a new grid"
gridPixmap := nil.
shown ifTrue:[
self viewBackground:White.
self clear.
].
gridShown ifTrue:[
self defineGrid.
self viewBackground:gridPixmap.
].
shown ifTrue:[
self redraw
].
!
showGrid
"show the grid"
gridShown := true.
self newGrid
!
hideGrid
"hide the grid"
gridShown := false.
self newGrid
!
getAlignParameters
|params|
params := self gridParameters.
gridAlign := (params at:5) @ (params at:6)
!
alignOn
"align points to grid"
|params|
aligning := true.
self getAlignParameters
!
alignOff
"do no align point to grid"
aligning := false
! !
!ObjectView methodsFor:'dragging rectangle'!
startRectangleDrag:startPoint
"start a rectangle drag"
self setRectangleDragActions.
dragObject := Rectangle origin:startPoint corner:startPoint.
self invertDragRectangle.
oldCursor := cursor.
self cursor:leftHandCursor
!
endRectangleDrag
"cleanup after rectangle drag; select them"
self invertDragRectangle.
self cursor:oldCursor.
self selectAllIn:(dragObject + viewOrigin)
!
doRectangleDrag:aPoint
"do drag a rectangle"
self invertDragRectangle.
dragObject corner:aPoint.
self invertDragRectangle.
!
invertDragRectangle
"helper for rectangle drag - invert the dragRectangle.
Extracted into a separate method to allow easier redefinition
(different lineWidth etc)"
self xoring:[self displayRectangle:dragObject].
! !
!ObjectView methodsFor:'dragging line'!
startLineDrag:startPoint
"start a line drag"
self setLineDragActions.
dragObject := Rectangle origin:startPoint corner:startPoint.
self invertDragLine.
oldCursor := cursor.
self cursor:leftHandCursor
!
startRootLineDrag:startPoint
"start a line drag possibly crossing my view boundaries"
self setLineDragActions.
rootMotion := true.
dragObject := Rectangle origin:startPoint corner:startPoint.
self invertDragLine.
oldCursor := cursor.
self cursor:leftHandCursor
!
doLineDrag:aPoint
"do drag a line"
|dragger top offs2 org|
rootMotion ifTrue:[
dragger := rootView.
offs2 := viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
] ifFalse:[
dragger := self.
offs2 := 0@0.
].
self invertDragLine.
dragObject corner:aPoint.
self invertDragLine.
!
endLineDrag
"cleanup after line drag; select them. Find the origin and destination
views and relative offsets, then dispatch to one of the endLineDrag methods.
These can be redefined in subclasses to allow connect between views."
|dragger offs2 top org rootPoint viewId
lastViewId destinationId destinationView destinationPoint inMySelf|
rootMotion ifTrue:[
dragger := rootView.
offs2 := viewOrigin.
top := self topView.
org := device translatePoint:0@0 from:(self id) to:(rootView id).
offs2 := offs2 - org
] ifFalse:[
dragger := self.
offs2 := 0@0.
].
dragger xoring:[
dragger displayLineFrom:dragObject origin-offs2
to:dragObject corner-offs2
].
self cursor:oldCursor.
"check if line drag is into another view"
rootMotion ifTrue:[
rootPoint := device translatePoint:lastButt
from:(self id)
to:(rootView id).
"search view the drop is in"
viewId := rootView id.
[viewId notNil] whileTrue:[
destinationId := device viewIdFromPoint:rootPoint in:viewId.
lastViewId := viewId.
viewId := destinationId
].
destinationView := device viewFromId:lastViewId.
destinationId := lastViewId.
inMySelf := (destinationView == self).
rootMotion := false
] ifFalse:[
inMySelf := true
].
inMySelf ifTrue:[
"a simple line within myself"
self lineDragFrom:dragObject origin
to:dragObject corner
] ifFalse:[
"into another one"
destinationPoint := device translatePoint:rootPoint
from:(rootView id)
to:(destinationView id).
destinationView notNil ifTrue:[
"
move into another smalltalk view
"
self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
] ifFalse:[
"
not one of my views
"
self lineDragFrom:dragObject origin
to:destinationPoint
inAlienViewId:destinationId
]
].
self setDefaultActions.
dragObject := nil
!
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
"this is called after a line-drag with rootmotion set
to true, IFF the endpoint is in an alien view
- should be redefined in subclasses"
self notify:'cannot connect object in alien view'
!
lineDragFrom:startPoint to:endPoint
"this is called after a line-drag. Nothing is done here.
- should be redefined in subclasses"
^ self
!
lineDragFrom:startPoint to:endPoint in:destinationView
"this is called after a line-drag crossing view boundaries.
- should be redefined in subclasses"
^ self notify:'dont know how to connect to external views'
!
invertDragLine
"helper for line dragging - invert the dragged line.
Extracted for easier redefinition in subclasses
(different line width etc.)"
self xoring:[self displayLineFrom:dragObject origin to:dragObject corner].
! !
!ObjectView methodsFor:'dragging object move'!
startObjectMove:something at:aPoint
"start an object move"
something notNil ifTrue:[
self select:something.
(self canMove:something) ifTrue:[
self setMoveActions.
moveStartPoint := aPoint.
rootMotion := canDragOutOfView.
"self doObjectMove:aPoint "
] ifFalse:[
self setDefaultActions
]
]
!
endObjectMove
"cleanup after object move - find the destination view and dispatch to
one of the moveObjectXXX-methods. These can be redefined in subclasses."
|dragger inMySelf offs2 rootPoint destinationPoint
viewId destinationView destinationId lastViewId|
movedObject notNil ifTrue:[
rootMotion ifTrue:[
dragger := rootView.
offs2 := viewOrigin
] ifFalse:[
dragger := self.
offs2 := 0@0
].
dragger xoring:[
self showDragging:movedObject offset:moveDelta - offs2
].
dragger device synchronizeOutput.
"check if object is to be put into another view"
rootMotion ifTrue:[
rootPoint := device translatePoint:lastButt
from:(self id)
to:(rootView id).
"search view the drop is in"
viewId := rootView id.
[viewId notNil] whileTrue:[
destinationId := device viewIdFromPoint:rootPoint in:viewId.
lastViewId := viewId.
viewId := destinationId
].
destinationView := device viewFromId:lastViewId.
destinationId := lastViewId.
inMySelf := (destinationView == self).
rootMotion := false
] ifFalse:[
inMySelf := true
].
inMySelf ifTrue:[
"simple move"
self move:movedObject by:moveDelta
] ifFalse:[
destinationPoint := device translatePoint:rootPoint
from:(rootView id)
to:destinationId.
destinationView notNil ifTrue:[
"
move into another smalltalk view
"
self move:movedObject to:destinationPoint in:destinationView
] ifFalse:[
"
not one of my views
"
self move:movedObject to:destinationPoint inAlienViewId:destinationId
]
].
self setDefaultActions.
movedObject := nil
]
!
doObjectMove:aPoint
"do an object move.
moveStartPoint is the original click-point.
moveDelta"
|dragger offset d p|
rootMotion ifTrue:[
dragger := rootView.
offset := viewOrigin.
] ifFalse:[
dragger := self.
offset := 0@0.
].
"
when drawing in the root window, we have to use its coordinates
this is kept in offset.
"
movedObject isNil ifTrue:[
movedObject := selection.
"
draw first outline
"
movedObject notNil ifTrue:[
moveDelta := 0@0.
dragger xoring:[
"tricky, the moved object may not currently be aligned.
if so, simulate a frame move of the delta"
aligning ifTrue:[
d := movedObject origin
- (self alignToGrid:(movedObject origin)).
d printNL.
moveDelta := d negated.
].
moveDelta printNL.
self showDragging:movedObject offset:moveDelta - offset.
]
]
].
movedObject notNil ifTrue:[
"
clear prev outline,
draw new outline
"
dragger xoring:[
self showDragging:movedObject offset:moveDelta - offset.
moveDelta := aPoint - moveStartPoint.
aligning ifTrue:[
moveDelta := self alignToGrid:moveDelta
].
self showDragging:movedObject offset:moveDelta - offset.
]
]
! !
!ObjectView methodsFor:'saving / restoring'!
initializeFileInObject:anObject
"each object may be processed here after its being filed-in
- subclasses may do whatever they want here ...
(see LogicView for example)"
^ self
!
storeContentsOn:aStream
"store the contents in textual representation on aStream.
Notice, that for huge objects (such as DrawImages) this ascii output
can become quite large, and the time to save and reload can become
long."
|excla|
self topView withCursor:Cursor write do:[
excla := aStream class chunkSeparator.
self forEach:contents do:[:theObject |
theObject storeOn:aStream.
aStream nextPut:excla.
aStream cr
].
aStream nextPut:excla
]
!
withoutRedrawFileInContentsFrom:aStream
self fileInContentsFrom:aStream redraw:false
!
fileInContentsFrom:aStream
"remove all objects, load new contents from aStream and redraw"
self fileInContentsFrom:aStream redraw:true
!
fileInContentsFrom:aStream redraw:redraw new:new
"if the new argument is true, remove all objects.
Then load objects from aStream,
finally, redraw if the redraw argument is true"
|newObject chunk|
self topView withCursor:Cursor read do:[
self unselect.
new ifTrue:[self removeAll].
[aStream atEnd] whileFalse:[
chunk := aStream nextChunk.
chunk notNil ifTrue:[
chunk isEmpty ifFalse:[
newObject := Compiler evaluate:chunk.
self initializeFileInObject:newObject.
redraw ifFalse:[
self addObjectWithoutRedraw:newObject
] ifTrue:[
self addObject:newObject
]
]
]
].
]
!
fileInContentsFrom:aStream redraw:redraw
"remove all objects, load new contents from aStream
and redraw if the redraw argument is true"
self fileInContentsFrom:aStream redraw:redraw new:true
! !