--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ObjectView.st Fri Jul 16 11:44:44 1993 +0200
@@ -0,0 +1,1880 @@
+"
+ 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
+! !