"
COPYRIGHT (c) 1989-92 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.
"
View subclass:#ObjectView
instanceVariableNames:'contents
sorted
lastButt lastPointer lastButtonTime
pressAction releaseAction
shiftPressAction doublePressAction
motionAction keyPressAction
selection
gridShown gridPixmap
scaleShown scaleMetric
groupRectangleFrame
leftHandCursor readCursor oldCursor
movedObject moveStartPoint
moveDelta
buffer
documentFormat
leftMarginForScale topMarginForScale
canDragOutOfView rootMotion rootView aligning'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
!
ObjectView comment:'
COPYRIGHT (c) 1989-92 by Claus Gittinger
All Rights Reserved
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.
%W% %E%
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:'initialization'!
initialize
|pixPerMM|
super initialize.
viewBackground := White.
bitGravity := #NorthWest.
contents := OrderedCollection new.
gridShown := false.
scaleShown := false.
canDragOutOfView := false.
rootView := DisplayRootView new.
rootView noClipByChildren.
rootMotion := false.
(Language == #english) ifTrue:[
documentFormat := 'letter'.
scaleMetric := #inch
] ifFalse:[
documentFormat := 'a4'.
scaleMetric := #mm
].
pixPerMM := self verticalPixelPerMillimeter:1.
topMarginForScale := ((pixPerMM * 2.0) + 0.5) asInteger.
pixPerMM := self horizontalPixelPerMillimeter:1.
leftMarginForScale := ((pixPerMM * 2.0) + 0.5) asInteger.
readCursor := Cursor read.
leftHandCursor := Cursor leftHand.
sorted := false.
aligning := false
!
initEvents
self backingStore:true.
self enableButtonEvents.
self enableButtonMotionEvents
! !
!ObjectView methodsFor:'queries'!
heightOfContentsInMM
"answer the height of the document in millimeters"
(documentFormat = 'a3') ifTrue:[
^ 420
].
(documentFormat = 'a4') ifTrue:[
^ 296
].
(documentFormat = 'a5') ifTrue:[
^ 210
].
(documentFormat = 'letter') ifTrue:[
^ 11 * 25.4
].
"assuming window size is document size"
^ (height / self verticalPixelPerMillimeter:1) asInteger
!
widthOfContentsInMM
"answer the width of the document in millimeters"
(documentFormat = 'a3') ifTrue:[
^ 296
].
(documentFormat = 'a4') ifTrue:[
^ 210
].
(documentFormat = 'a5') ifTrue:[
^ 148
].
(documentFormat = 'letter') ifTrue:[
^ 8.5 * 25.4
].
"assuming window size is document size"
^ (width / self horizontalPixelPerMillimeter:1) asInteger
!
heightOfContents
"answer the height of the document in pixels"
^ ((self heightOfContentsInMM
* (self verticalPixelPerMillimeter:1)) + 0.5) asInteger
!
widthOfContents
"answer the width of the document in pixels"
^ ((self widthOfContentsInMM
* (self horizontalPixelPerMillimeter:1)) + 0.5) asInteger
! !
!ObjectView methodsFor:'drawing'!
redraw
"redraw complete View"
realized ifTrue:[
gridShown ifTrue:[
self redrawGrid
] ifFalse:[
self fill:viewBackground
].
scaleShown ifTrue:[
self redrawScale
].
self redrawObjects
]
!
redrawGrid
"redraw the grid"
gridPixmap notNil ifTrue:[
self drawOpaqueForm:gridPixmap x:0 y:0
]
!
redrawHorizontalScale
"redraw the horizontal scale"
|x mmH short step xRounded shortLen longLen len|
self clearRectangle:((0 @ 0) corner:(width @ topMarginForScale)).
scaleShown ifFalse:[^ self].
(scaleMetric == #mm) ifTrue:[
"long blibs every centimeter; short ones every half"
mmH := self horizontalPixelPerMillimeter.
step := mmH * 5.0.
x := step.
short := true.
shortLen := (topMarginForScale / 2) asInteger.
longLen := topMarginForScale.
[x < width] whileTrue:[
xRounded := (x + 0.5) asInteger.
short ifTrue:[
len := shortLen
] ifFalse:[
len := longLen
].
self displayLineFromX:xRounded y:0 toX:xRounded y:len.
short := short not.
x := x + step
]
]
!
redrawVerticalScale
"redraw the vertical scale"
|y mmV short step yRounded shortLen longLen len|
self clearRectangle:((0 @ 0) corner:(leftMarginForScale @ height)).
scaleShown ifFalse:[^ self].
(scaleMetric == #mm) ifTrue:[
"long blibs every centimeter; short ones every half"
mmV := self verticalPixelPerMillimeter.
step := mmV * 5.0.
y := step.
short := true.
shortLen := (leftMarginForScale / 2) asInteger.
longLen := leftMarginForScale.
[y < height] whileTrue:[
yRounded := (y + 0.5) asInteger.
short ifTrue:[
len := shortLen
] ifFalse:[
len := longLen
].
self displayLineFromX:0 y:yRounded toX:len y:yRounded.
short := short not.
y := y + step
]
]
!
redrawScale
"redraw the scales"
self redrawHorizontalScale.
self redrawVerticalScale
!
redrawObjectsOn:aGC
"redraw all objects on a graphic context"
|vFrame org|
(aGC == self) ifTrue:[
realized ifFalse:[^ self].
org := viewOrigin + (leftMarginForScale @ topMarginForScale).
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
]
!
redrawObjects
"redraw all objects"
self redrawObjectsOn:self
!
redrawObjectsIntersecting:aRectangle
"redraw all objects which have part of themself in aRectangle"
self objectsIntersecting:aRectangle do:[:theObject |
self show:theObject
]
!
redrawObjectsIntersectingVisible:aRectangle
"redraw all objects which have part of themself in a vis rectangle"
self objectsIntersectingVisible:aRectangle do:[:theObject |
self show:theObject
]
!
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
]
!
redrawObjectsIn:aRectangle
"redraw all objects which have part of themselfes in aRectangle
draw only in (i.e. clip output to) aRectangle"
|visRect|
realized ifTrue:[
visRect := Rectangle origin:(aRectangle origin - viewOrigin)
extent:(aRectangle extent).
self clippedTo:visRect do:[
gridShown ifTrue:[
self redrawGrid
] ifFalse:[
self paint:viewBackground.
self fillRectangle:visRect
].
self redrawObjectsIntersecting:aRectangle
]
]
!
redrawObjectsInVisible:visRect
"redraw all objects which have part of themselfes in a vis rectangle
draw only in (i.e. clip output to) aRectangle"
realized ifTrue:[
self clippedTo:visRect do:[
gridShown ifTrue:[
self redrawGrid
] ifFalse:[
self paint:viewBackground.
self fillRectangle:visRect
].
self redrawObjectsIntersectingVisible:visRect
]
]
!
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"
realized ifTrue:[
self clippedTo:aRectangle do:[
self redrawObjectsAbove:anObject intersecting:aRectangle
]
]
!
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"
realized ifTrue:[
self clippedTo:aRectangle do:[
self redrawObjectsAbove:anObject intersectingVisible:aRectangle
]
]
!
show:anObject
"show the object, either selected or not"
(self isSelected:anObject) ifTrue:[
self showSelected:anObject
] ifFalse:[
self showUnselected:anObject
]
!
showDragging:something offset:anOffset
"show an object while dragging"
|drawOffset top drawer|
canDragOutOfView 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
]
!
showSelected:anObject
"show an object as selected"
shown ifTrue:[anObject drawSelectedIn:self]
!
showUnselected:anObject
"show an object as unselected"
shown ifTrue:[anObject drawIn:self]
! !
!ObjectView methodsFor:'selections'!
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
]
!
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
]
!
selectAll
"select all objects"
self hideSelection.
selection := contents.
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
!
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
!
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
!
withSelectionHiddenDo:aBlock
"evaluate aBlock while selection is hidden"
|sel|
sel := selection.
self unselect.
aBlock value.
self select:sel
! !
!ObjectView methodsFor:'testing objects'!
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
!
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
!
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
!
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
! !
!ObjectView methodsFor:'layout manipulation'!
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'
!
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 by:delta
"change the position of anObject by delta, aPoint"
self moveObject:anObject to:(anObject origin + 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|
anObject isNil ifTrue:[^ self].
anObject canBeMoved ifFalse:[^ self].
oldOrigin := anObject origin.
(oldOrigin = newOrigin) ifTrue:[^ self].
oldFrame := self frameOf:anObject.
objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
wasObscured := self isObscured:anObject.
anObject moveTo:newOrigin.
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:[
(objectsIntersectingOldFrame size == 1) ifTrue:[
(objectsIntersectingNewFrame size == 1) 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 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
]
]
!
objectToFront:anObject
"bring the argument, anObject to front"
|wasObscured|
anObject notNil ifTrue:[
wasObscured := self isObscured:anObject.
contents remove:anObject.
contents addLast:anObject.
wasObscured ifTrue:[
self redrawObjectsIn:(anObject frame)
]
]
!
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.
selection := nil
!
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
]
!
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
]
!
addObject:anObject
"add the argument, anObject to the contents - with redraw"
anObject notNil ifTrue:[
contents addLast:anObject.
"its on top - only draw this one"
realized ifTrue:[
self showUnselected: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.
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:'misc'!
setDefaultActions
motionAction := [:movePoint | nil].
releaseAction := [nil]
!
setRectangleDragActions
motionAction := [:movePoint | self doRectangleDrag:movePoint].
releaseAction := [self endRectangleDrag]
!
setMoveActions
motionAction := [:movePoint | self doObjectMove:movePoint].
releaseAction := [self endObjectMove]
!
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
]
!
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
!
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
]
]
!
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
!
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
!
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
!
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]
]
]
!
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
!
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:'view manipulation'!
showScale
"show the scale"
scaleShown := true.
self redrawScale
!
hideScale
"hide the scale"
scaleShown := false.
self redrawScale
!
millimeterMetric
(scaleMetric == #inch) ifTrue:[
scaleMetric := #mm.
gridShown ifTrue:[
self defineGrid.
self redraw
]
]
!
inchMetric
(scaleMetric == #mm) ifTrue:[
scaleMetric := #inch.
gridShown ifTrue:[
self defineGrid.
self redraw
]
]
!
defineGrid
"define the grid pattern"
|mmH mmV gridW gridH xp yp y x
bigStepH bigStepV littleStepH littleStepV hires
oldCursor|
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
hires := self horizontalPixelPerInch > 120.
(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)
].
bigStepH isNil ifTrue:[^ self].
oldCursor := cursor.
self cursor:Cursor wait.
gridW := (self widthOfContentsInMM * mmH + 1) asInteger.
gridH := (self heightOfContentsInMM * mmV + 1) asInteger.
gridPixmap := Form width:gridW height:gridH depth:(device depth).
gridPixmap fill:viewBackground.
gridPixmap paint:paint.
"draw first row point-by-point"
yp := 0.0.
xp := 0.0.
y := yp asInteger.
[xp <= gridW] whileTrue:[
x := xp rounded.
hires ifTrue:[
gridPixmap drawPointX:(x + 1) y:y.
gridPixmap drawPointX:(x + 2) y:y
].
gridPixmap drawPointX:x y:y.
xp := xp + littleStepH
].
"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 drawPointX:x y:(y + 1).
gridPixmap drawPointX:x y:(y + 2)
].
gridPixmap drawPointX:x y:y.
yp := yp + littleStepV
].
"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
].
self cursor:oldCursor
!
showGrid
"show the grid"
gridShown := true.
gridPixmap isNil ifTrue:[
self defineGrid
].
self redraw
!
hideGrid
"hide the grid"
gridShown := false.
self redraw
!
alignOn
"align points to grid"
aligning := true
!
alignOff
"do no align point to grid"
aligning := false
! !
!ObjectView methodsFor:'user interface'!
alignToGrid:aPoint
"round aPoint to the next nearest point on the grid"
|mmH mmV aH aV|
aligning ifFalse:[
^ aPoint
].
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
(scaleMetric == #mm) ifTrue:[
"align to mm"
aH := mmH.
aV := mmV
].
(scaleMetric == #inch) ifTrue:[
"align to eights inch"
aH := mmH * (25.4 / 8).
aV := mmV * (25.4 / 8)
].
^ (aPoint grid:(aH @ aV)) grid:(1 @ 1)
!
startRectangleDrag:startPoint
"start a rectangle drag"
self setRectangleDragActions.
groupRectangleFrame := Rectangle origin:startPoint corner:startPoint.
self xoring:[self drawRectangle:groupRectangleFrame].
oldCursor := cursor.
self cursor:leftHandCursor
!
doRectangleDrag:aPoint
"do drag a rectangle"
self xoring:[
self drawRectangle:groupRectangleFrame.
groupRectangleFrame corner:aPoint.
self drawRectangle:groupRectangleFrame
]
!
endRectangleDrag
"cleanup after rectangle drag; select them"
self xoring:[self drawRectangle:groupRectangleFrame].
self cursor:oldCursor.
self selectAllIn:(groupRectangleFrame + viewOrigin)
!
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
!
startSelectOrMove:aPoint
"start a rectangleDrag or objectMove - if aPoint hits an object,
an object move is started, otherwise a rectangleDrag"
|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
!
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"
|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
!
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
]
]
!
doObjectMove:aPoint
"do an object move"
|dragger offs2|
canDragOutOfView ifTrue:[
dragger := rootView.
offs2 := viewOrigin
] ifFalse:[
dragger := self.
offs2 := 0@0
].
movedObject isNil ifTrue:[
movedObject := selection.
movedObject notNil ifTrue:[
moveDelta := 0@0.
dragger xoring:[
self showDragging:movedObject
offset:(moveDelta - offs2)
]
]
].
movedObject notNil ifTrue:[
dragger xoring:[
self showDragging:movedObject offset:(moveDelta - offs2).
moveDelta := aPoint - moveStartPoint.
self showDragging:movedObject offset:(moveDelta - offs2)
]
]
!
endObjectMove
"cleanup after object move - physically move the object now"
|dragger inMySelf offs2 rootPoint destinationPoint
viewId destinationView destinationId lastViewId|
movedObject notNil ifTrue:[
canDragOutOfView 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:[
self move:movedObject to:destinationPoint
inAlienViewId:destinationId
]
].
self setDefaultActions.
movedObject := nil
]
! !
!ObjectView methodsFor:'events'!
buttonPress:button x:x y:y
"user pressed left button"
(button == 1) ifTrue:[
pressAction notNil ifTrue:[
lastButt := x @ y.
pressAction value:lastButt
]
] ifFalse:[
super buttonPress:button x:x y:y
]
!
buttonShiftPress:button x:x y:y
"user pressed left button with shift"
(button == 1) 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) ifTrue:[
doublePressAction notNil ifTrue:[
doublePressAction value:(x @ y)
]
] ifFalse:[
super buttonMultiPress:button x:x y:y
]
!
buttonMotion:button x:buttX y:buttY
"user moved mouse while button pressed"
|xpos ypos movePoint|
(lastButt == nil) ifFalse:[
xpos := buttX.
ypos := buttY.
"check against view limits if move outside is not allowed"
rootMotion ifFalse:[
(xpos < 0) ifTrue:[
xpos := 0
] ifFalse: [
(xpos > width) ifTrue:[xpos := width]
].
(ypos < 0) ifTrue:[
ypos := 0
] ifFalse: [
(ypos > height) ifTrue:[ypos := height]
]
].
movePoint := xpos @ ypos.
(xpos == (lastButt x)) ifTrue:[
(ypos == (lastButt y)) ifTrue:[
^ self "no move"
]
].
motionAction notNil ifTrue:[
motionAction value:movePoint
].
lastButt := movePoint
]
!
buttonRelease:button x:x y:y
(button == 1) ifTrue: [
releaseAction notNil ifTrue:[releaseAction value]
] ifFalse:[
super buttonRelease:button x:x y:y
]
!
keyPress:key x:x y:y
keyPressAction notNil ifTrue:[
selection notNil ifTrue:[
self selectionDo: [:obj |
obj keyInput:key
]
]
]
!
redrawX:x y:y width:w height:h
|innerX innerY innerW innerH redrawFrame |
innerX := x.
innerY := y.
innerW := w.
innerH := h.
scaleShown ifTrue:[
(x < leftMarginForScale) ifTrue:[
self redrawVerticalScale.
innerW := w - (leftMarginForScale - x).
innerX := leftMarginForScale
].
(y < topMarginForScale) ifTrue:[
self redrawHorizontalScale.
innerH := h - (topMarginForScale - y).
innerY := topMarginForScale
]
].
(contents size ~~ 0) ifTrue:[
redrawFrame := Rectangle left:innerX top:innerY
width:innerW height:innerH.
self redrawObjectsInVisible:redrawFrame
]
! !
!ObjectView methodsFor:'saving / restoring'!
storeContentsOn:aStream
|excla|
excla := aStream class chunkSeparator.
self forEach:contents do:[:theObject |
theObject storeOn:aStream.
aStream nextPut:excla.
aStream cr
].
aStream nextPut:excla
!
initializeFileInObject:anObject
"each object may be processed here after its beeing filed-in
- subclasses may do whatever they want here ...
(see LogicView for example)"
^ self
!
withoutRedrawFileInContentsFrom:aStream
self fileInContentsFrom:aStream redraw:false
!
fileInContentsFrom:aStream
self fileInContentsFrom:aStream redraw:true
!
fileInContentsFrom:aStream redraw:redraw
|newObject chunk savCursor|
savCursor := self cursor.
self cursor:readCursor.
self unselect.
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
]
]
]
].
self cursor:savCursor
! !