--- a/HVScrView.st Mon Nov 27 21:32:45 1995 +0100
+++ b/HVScrView.st Mon Nov 27 23:28:58 1995 +0100
@@ -11,10 +11,10 @@
"
ScrollableView subclass:#HVScrollableView
- instanceVariableNames:'hScrollBar'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'hScrollBar'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!HVScrollableView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.13 1995-11-11 16:20:43 cg Exp $'
-!
-
documentation
"
a view containing both horizontal and vertical scrollbars
@@ -46,6 +42,83 @@
"
! !
+!HVScrollableView methodsFor:'accessing'!
+
+horizontalScrollBar
+ "return the horizontal scrollbar"
+
+ ^ hScrollBar
+!
+
+scrolledView:aView
+ "set the scrolled view"
+
+ super scrolledView:aView.
+
+ "redefine subviews size"
+ styleSheet is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
+ ]
+ ] ifFalse:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - scrollBar borderWidth
+ "- scrolledView borderWidth")
+ @
+ (height
+ - hScrollBar height
+ - hScrollBar borderWidth
+ "- scrolledView borderWidth")
+ ]
+ ].
+ self setScrollActions
+! !
+
+!HVScrollableView methodsFor:'changes '!
+
+update:something with:argument from:changedObject
+ "whenever the scrolledview changes its contents, we have to
+ update the scrollers too"
+
+ changedObject == scrolledView ifTrue:[
+ something == #sizeOfContents ifTrue:[
+ scrollBar setThumbFor:scrolledView.
+ hScrollBar setThumbFor:scrolledView.
+ ^ self
+ ].
+ something == #originOfContents ifTrue:[
+ lockUpdates ifFalse:[
+ scrollBar setThumbOriginFor:scrolledView.
+ hScrollBar setThumbOriginFor:scrolledView.
+ ].
+ ^ self
+ ].
+ ].
+! !
+
+!HVScrollableView methodsFor:'event processing'!
+
+sizeChanged:how
+ super sizeChanged:how.
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ].
+ hScrollBar thumbOrigin + hScrollBar thumbHeight >= 100 ifTrue:[
+ hScrollBar thumbOrigin:(100 - hScrollBar thumbHeight).
+ scrolledView scrollHorizontalToPercent:hScrollBar thumbOrigin.
+ ].
+
+ "Modified: 8.9.1995 / 12:46:36 / claus"
+! !
+
!HVScrollableView methodsFor:'initialization'!
initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
@@ -188,46 +261,6 @@
scrolledView addDependent:self.
! !
-!HVScrollableView methodsFor:'accessing'!
-
-horizontalScrollBar
- "return the horizontal scrollbar"
-
- ^ hScrollBar
-!
-
-scrolledView:aView
- "set the scrolled view"
-
- super scrolledView:aView.
-
- "redefine subviews size"
- styleSheet is3D ifTrue:[
- scrolledView
- extent:[(width
- - scrollBar width
- - (innerMargin * 2))
- @
- (height
- - hScrollBar height
- - (innerMargin * 2))
- ]
- ] ifFalse:[
- scrolledView
- extent:[(width
- - scrollBar width
- - scrollBar borderWidth
- "- scrolledView borderWidth")
- @
- (height
- - hScrollBar height
- - hScrollBar borderWidth
- "- scrolledView borderWidth")
- ]
- ].
- self setScrollActions
-! !
-
!HVScrollableView methodsFor:'queries'!
preferredExtent
@@ -243,39 +276,8 @@
^ super preferredExtent.
! !
-!HVScrollableView methodsFor:'changes '!
-
-update:something with:argument from:changedObject
- "whenever the scrolledview changes its contents, we have to
- update the scrollers too"
+!HVScrollableView class methodsFor:'documentation'!
- changedObject == scrolledView ifTrue:[
- something == #sizeOfContents ifTrue:[
- scrollBar setThumbFor:scrolledView.
- hScrollBar setThumbFor:scrolledView.
- ^ self
- ].
- something == #originOfContents ifTrue:[
- lockUpdates ifFalse:[
- scrollBar setThumbOriginFor:scrolledView.
- hScrollBar setThumbOriginFor:scrolledView.
- ].
- ^ self
- ].
- ].
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/HVScrView.st,v 1.14 1995-11-27 22:28:01 cg Exp $'
! !
-
-!HVScrollableView methodsFor:'event processing'!
-
-sizeChanged:how
- super sizeChanged:how.
- scrolledView notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView
- ].
- hScrollBar thumbOrigin + hScrollBar thumbHeight >= 100 ifTrue:[
- hScrollBar thumbOrigin:(100 - hScrollBar thumbHeight).
- scrolledView scrollHorizontalToPercent:hScrollBar thumbOrigin.
- ].
-
- "Modified: 8.9.1995 / 12:46:36 / claus"
-! !
--- a/HVScrollableView.st Mon Nov 27 21:32:45 1995 +0100
+++ b/HVScrollableView.st Mon Nov 27 23:28:58 1995 +0100
@@ -11,10 +11,10 @@
"
ScrollableView subclass:#HVScrollableView
- instanceVariableNames:'hScrollBar'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'hScrollBar'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!HVScrollableView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.13 1995-11-11 16:20:43 cg Exp $'
-!
-
documentation
"
a view containing both horizontal and vertical scrollbars
@@ -46,6 +42,83 @@
"
! !
+!HVScrollableView methodsFor:'accessing'!
+
+horizontalScrollBar
+ "return the horizontal scrollbar"
+
+ ^ hScrollBar
+!
+
+scrolledView:aView
+ "set the scrolled view"
+
+ super scrolledView:aView.
+
+ "redefine subviews size"
+ styleSheet is3D ifTrue:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - (innerMargin * 2))
+ @
+ (height
+ - hScrollBar height
+ - (innerMargin * 2))
+ ]
+ ] ifFalse:[
+ scrolledView
+ extent:[(width
+ - scrollBar width
+ - scrollBar borderWidth
+ "- scrolledView borderWidth")
+ @
+ (height
+ - hScrollBar height
+ - hScrollBar borderWidth
+ "- scrolledView borderWidth")
+ ]
+ ].
+ self setScrollActions
+! !
+
+!HVScrollableView methodsFor:'changes '!
+
+update:something with:argument from:changedObject
+ "whenever the scrolledview changes its contents, we have to
+ update the scrollers too"
+
+ changedObject == scrolledView ifTrue:[
+ something == #sizeOfContents ifTrue:[
+ scrollBar setThumbFor:scrolledView.
+ hScrollBar setThumbFor:scrolledView.
+ ^ self
+ ].
+ something == #originOfContents ifTrue:[
+ lockUpdates ifFalse:[
+ scrollBar setThumbOriginFor:scrolledView.
+ hScrollBar setThumbOriginFor:scrolledView.
+ ].
+ ^ self
+ ].
+ ].
+! !
+
+!HVScrollableView methodsFor:'event processing'!
+
+sizeChanged:how
+ super sizeChanged:how.
+ scrolledView notNil ifTrue:[
+ hScrollBar setThumbFor:scrolledView
+ ].
+ hScrollBar thumbOrigin + hScrollBar thumbHeight >= 100 ifTrue:[
+ hScrollBar thumbOrigin:(100 - hScrollBar thumbHeight).
+ scrolledView scrollHorizontalToPercent:hScrollBar thumbOrigin.
+ ].
+
+ "Modified: 8.9.1995 / 12:46:36 / claus"
+! !
+
!HVScrollableView methodsFor:'initialization'!
initializeFor:aViewClass miniScrollerH:miniH miniScrollerV:miniV
@@ -188,46 +261,6 @@
scrolledView addDependent:self.
! !
-!HVScrollableView methodsFor:'accessing'!
-
-horizontalScrollBar
- "return the horizontal scrollbar"
-
- ^ hScrollBar
-!
-
-scrolledView:aView
- "set the scrolled view"
-
- super scrolledView:aView.
-
- "redefine subviews size"
- styleSheet is3D ifTrue:[
- scrolledView
- extent:[(width
- - scrollBar width
- - (innerMargin * 2))
- @
- (height
- - hScrollBar height
- - (innerMargin * 2))
- ]
- ] ifFalse:[
- scrolledView
- extent:[(width
- - scrollBar width
- - scrollBar borderWidth
- "- scrolledView borderWidth")
- @
- (height
- - hScrollBar height
- - hScrollBar borderWidth
- "- scrolledView borderWidth")
- ]
- ].
- self setScrollActions
-! !
-
!HVScrollableView methodsFor:'queries'!
preferredExtent
@@ -243,39 +276,8 @@
^ super preferredExtent.
! !
-!HVScrollableView methodsFor:'changes '!
-
-update:something with:argument from:changedObject
- "whenever the scrolledview changes its contents, we have to
- update the scrollers too"
+!HVScrollableView class methodsFor:'documentation'!
- changedObject == scrolledView ifTrue:[
- something == #sizeOfContents ifTrue:[
- scrollBar setThumbFor:scrolledView.
- hScrollBar setThumbFor:scrolledView.
- ^ self
- ].
- something == #originOfContents ifTrue:[
- lockUpdates ifFalse:[
- scrollBar setThumbOriginFor:scrolledView.
- hScrollBar setThumbOriginFor:scrolledView.
- ].
- ^ self
- ].
- ].
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/HVScrollableView.st,v 1.14 1995-11-27 22:28:01 cg Exp $'
! !
-
-!HVScrollableView methodsFor:'event processing'!
-
-sizeChanged:how
- super sizeChanged:how.
- scrolledView notNil ifTrue:[
- hScrollBar setThumbFor:scrolledView
- ].
- hScrollBar thumbOrigin + hScrollBar thumbHeight >= 100 ifTrue:[
- hScrollBar thumbOrigin:(100 - hScrollBar thumbHeight).
- scrolledView scrollHorizontalToPercent:hScrollBar thumbOrigin.
- ].
-
- "Modified: 8.9.1995 / 12:46:36 / claus"
-! !
--- a/ObjView.st Mon Nov 27 21:32:45 1995 +0100
+++ b/ObjView.st Mon Nov 27 23:28:58 1995 +0100
@@ -10,15 +10,13 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
-
View subclass:#ObjectView
- instanceVariableNames:'contents sorted lastButt pressAction
- releaseAction shiftPressAction doublePressAction motionAction
- keyPressAction selection gridShown gridPixmap scaleMetric
- dragObject leftHandCursor oldCursor movedObject
- moveStartPoint moveDelta documentFormat canDragOutOfView
- rootMotion rootView aligning gridAlign aligningMove'
+ instanceVariableNames:'contents sorted lastButt pressAction releaseAction
+ shiftPressAction doublePressAction motionAction keyPressAction
+ selection gridShown gridPixmap scaleMetric dragObject
+ leftHandCursor oldCursor movedObject moveStartPoint moveDelta
+ documentFormat canDragOutOfView rootMotion rootView aligning
+ gridAlign aligningMove'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
@@ -40,10 +38,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.28 1995-11-27 20:32:45 cg Exp $'
-!
-
documentation
"
a View which can hold DisplayObjects, can make selections, move them around etc.
@@ -232,428 +226,389 @@
^ 0
! !
-!ObjectView methodsFor:'scrolling'!
-
-verticalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device verticalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device verticalPixelPerMillimeter * 20) asInteger
-!
-
-horizontalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device horizontalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device horizontalPixelPerMillimeter * 20) asInteger
-! !
-
-!ObjectView methodsFor:'misc'!
-
-hitDelta
- "when clicking an object, allow for hitDelta pixels around object.
- We compensate for any scaling here, to get a constant physical
- hitDelta (i.e. the value returned here is inverse scaled)."
-
- |delta|
-
- delta := self class hitDelta.
- transformation notNil ifTrue:[
- delta := delta / transformation scale x
- ].
- ^ delta
+!ObjectView methodsFor:'adding / removing'!
+
+add:something
+ "add something, anObject or a collection of objects to the contents
+ with redraw"
+
+ self forEach:something do:[:anObject |
+ self addObject:anObject
+ ]
!
-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 }"|
-
- nObjects := contents size.
- (nObjects == 0) ifTrue:[^ self].
-
- sorted ifFalse:[
- "
- have to check every object
- "
- contents do:[:theObject |
- (theObject frame intersects:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
- ].
- ^ self
- ].
-
- "
- contents is sorted by y; can do a fast (binary) search for the first
- object which intersects aRectangle and
- break from the draw loop, when the 1st object below aRectangle is reached.
- "
- bot := aRectangle bottom.
- top := aRectangle top.
-
- "
- binary search for 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]
+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
]
]
!
-forEach:aCollection do:aBlock
- "apply block to every object in a collectioni;
- (adds a check for non-collection)"
-
- aCollection isNil ifTrue:[^self].
- aCollection isCollection ifTrue:[
- aCollection do:[:object |
- object notNil ifTrue:[
- aBlock value:object
- ]
- ]
- ] ifFalse: [
- aBlock value:aCollection
+addObjectWithoutRedraw:anObject
+ "add the argument, anObject to the contents - no redraw"
+
+ anObject notNil ifTrue:[
+ contents addLast:anObject
+ ]
+!
+
+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
]
!
-objectsIntersectingVisible:aRectangle do:aBlock
- "do something to every object which intersects a visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:do:, since this will vanish."
-
- self objectsIntersecting:aRectangle do:aBlock
-!
-
-setDefaultActions
- motionAction := [:movePoint | nil].
- releaseAction := [nil]
-!
-
-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
-!
-
-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]
- ]
+remove:something
+ "remove something, anObject or a collection of objects from the contents
+ do redraw"
+
+ something size > (contents size / 4) ifTrue:[
+ "
+ better to remove first, then redraw rest
+ "
+ self forEach:something do:[:anObject |
+ self removeFromSelection:anObject.
+ contents remove:anObject.
].
+ self redraw.
^ self
].
- contents do:[:theObject |
- (theObject isContainedIn:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
+ self forEach:something do:[:anObject |
+ self removeObject:anObject
]
!
-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
+removeAll
+ "remove all - redraw"
+
+ self removeAllWithoutRedraw.
+ self redraw
+!
+
+removeAllWithoutRedraw
+ "remove all - no redraw"
+
+ selection := nil.
+ contents := OrderedCollection new
+!
+
+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)
]
]
!
-objectsInVisible:aRectangle do:aBlock
- "do something to every object which is completely in a
- visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIn:do:, since this will vanish."
-
- self objectsIn:aRectangle do:aBlock
-!
-
-visibleObjectsDo:aBlock
- "do something to every visible object"
-
- |absRect|
-
- absRect := Rectangle left:0 top:0 width:width height:height.
- self objectsIntersecting:absRect do:aBlock
-!
-
-numberOfObjectsIntersectingVisible:aRectangle
- "answer the number of objects intersecting the argument, aRectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use numberOfObjectsIntersecting:, since this will vanish."
-
- ^ 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:, since this will vanish."
-
- ^ self objectsIntersecting:aRectangle
-!
-
-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
- ]
+removeObjectWithoutRedraw:anObject
+ "remove the argument, anObject from the contents - no redraw"
+
+ anObject notNil ifTrue:[
+ self removeFromSelection:anObject.
+ contents remove:anObject
]
!
-rectangleForScroll
- "find the area occupied by visible objects"
-
- |left right top bottom frame oLeft oRight oTop oBottom|
-
- left := 9999.
- right := 0.
- top := 9999.
- bottom := 0.
- self visibleObjectsDo:[:anObject |
- frame := anObject frame.
- oLeft := frame left.
- oRight := frame right.
- oTop := frame top.
- oBottom := frame bottom.
- (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
+removeWithoutRedraw:something
+ "remove something, anObject or a collection of objects from the contents
+ do not redraw"
+
+ self forEach:something do:[:anObject |
+ self removeObjectWithoutRedraw:anObject
+ ]
! !
-!ObjectView methodsFor:'event handling'!
-
-redrawX:x y:y width:w height:h
- |redrawFrame |
-
- ((contents size ~~ 0) or:[gridShown]) ifTrue:[
- redrawFrame := Rectangle left:x top:y
- width:w height:h.
- self redrawObjectsInVisible:redrawFrame
- ]
+!ObjectView methodsFor:'cut & paste '!
+
+convertForPaste:anObject
+ "return a converted version of anObject to be pasted, or nil if
+ the object is not compatible with me.
+ Return nil here; concrete subclasses should try to convert.
+ Notice: anObject may be a collection of to-be-pasted objects."
+
+ "in concrete subclasses, you can use:"
+"
+ |s|
+
+ (anObject respondsTo:#asDisplayObject) ifTrue:[
+ ^ anObject asDisplayObject
+ ].
+ (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
+ ].
+ anObject size > 0 ifTrue:[
+ (anObject inject:true into:[:okSoFar :element |
+ okSoFar and:[element respondsTo:#asDisplayObject]
+ ]) ifFalse:[
+ self warn:'selection not convertable to DisplayObject'.
+ ^ nil
+ ].
+ ^ anObject collect:[:element | element asDisplayObject].
+ ].
+"
+ ^ nil.
+!
+
+copySelection
+ "copy the selection into the cut&paste-buffer"
+
+ |tmp|
+
+ tmp := OrderedCollection new.
+ self selectionDo:[:object |
+ tmp add:(object copy)
+ ].
+"/ self forEach:tmp do:[:anObject |
+"/ anObject moveTo:(anObject origin + (8 @ 8))
+"/ ].
+ self setSelection:tmp
!
-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
+deleteSelection
+ "delete the selection into the cut&paste buffer"
+
+ |tmp|
+
+ tmp := selection.
+ self unselect.
+ self remove:tmp.
+ self setSelection:tmp
+!
+
+paste:something
+ "add the objects in the cut&paste-buffer"
+
+ |s|
+
+ self unselect.
+ s := self convertForPaste:something .
+ s isNil ifTrue:[
+ self warn:'selection not convertable'.
+ ^ self
+ ].
+ self addSelected:s
+!
+
+pasteBuffer
+ "add the objects in the paste-buffer"
+
+ |sel|
+
+ sel := self getSelection.
+ (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
+ ifTrue:[
+ "
+ a local selection - paste with some offset
+ "
+ sel size > 0 ifTrue:[
+ sel := sel collect:[:element |
+ element copy moveTo:(element origin + (8 @ 8))
+ ]
+ ] ifFalse:[
+ sel := sel copy moveTo:(sel origin + (8 @ 8))
]
- ] 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
- ]
-!
-
-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]
- ]
+ self paste:sel
+! !
+
+!ObjectView methodsFor:'dragging line'!
+
+doLineDrag:aPoint
+ "do drag a line"
+
+ 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."
+
+ |rootPoint viewId offs
+ lastViewId destinationId destinationView destinationPoint inMySelf|
+
+ self invertDragLine.
+
+ self cursor:oldCursor.
+
+ "check if line drag is into another view"
+ rootMotion ifTrue:[
+ rootPoint := lastButt.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. rootPoint printNL.
+ transformation notNil ifTrue:[
+ rootPoint := transformation applyTo:rootPoint.
+"/ 'device ' print. rootPoint printNL.
].
- movePoint := xpos @ ypos.
-
- (xpos == (lastButt x)) ifTrue:[
- (ypos == (lastButt y)) ifTrue:[
- ^ self "no move"
- ]
- ].
-
- motionAction notNil ifTrue:[
- motionAction value:movePoint
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ rootPoint := rootPoint + offs.
+"/ 'screen ' print. rootPoint printNL.
+
+"/ 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
].
- lastButt := movePoint
- ]
-!
-
-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)
- ]
+ 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:[
- super buttonMultiPress:button x:x y:y
- ]
+ "into another one"
+ destinationView notNil ifTrue:[
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
+ destinationView transformation notNil ifTrue:[
+ destinationPoint := destinationView transformation applyInverseTo:destinationPoint
+ ].
+ "
+ 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
!
-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
- ]
+invertDragLine
+ "helper for line dragging - invert the dragged line.
+ Extracted for easier redefinition in subclasses
+ (different line width etc.)"
+
+ |dragger offs p1 p2|
+
+ p1 := dragObject origin.
+ p2 := dragObject corner.
+ rootMotion ifTrue:[
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
+ transformation notNil ifTrue:[
+ p1 := transformation applyTo:p1.
+ p2 := transformation applyTo:p2.
+"/ 'device ' print. p1 print. ' ' print. p2 printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p1 := p1 + offs.
+ p2 := p2 + offs.
+"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
] ifFalse:[
- super buttonShiftPress:button x:x y:y
- ]
+ dragger := self.
+ ].
+
+ dragger xoring:[
+ dragger lineWidth:0.
+ dragger displayLineFrom:p1 to:p2.
+ dragger device flush
+ ].
+!
+
+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'
!
-keyPress:key x:x y:y
- keyPressAction notNil ifTrue:[
- selection notNil ifTrue:[
- self selectionDo: [:obj |
- obj keyInput:key
- ]
- ]
- ]
+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'
+!
+
+setLineDragActions
+ "setup to drag a line. Call this (for example) from your buttonPress
+ method, to make the view start to drag a line.
+ See startLineDrag and startRootLineDrag."
+
+ motionAction := [:movePoint | self doLineDrag:movePoint].
+ releaseAction := [self endLineDrag]
+!
+
+startLineDrag:startPoint
+ "start a line drag within the view"
+
+ 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
! !
!ObjectView methodsFor:'dragging object move'!
@@ -770,43 +725,6 @@
]
!
-startObjectMove:something at:aPoint
- "start an object move"
-
- self startObjectMove:something at:aPoint inRoot:canDragOutOfView
-!
-
-startRootObjectMove:something at:aPoint
- "start an object move, possibly crossing view boundaries"
-
- self startObjectMove:something at:aPoint inRoot:true
-!
-
-startObjectMove:something at:aPoint inRoot:inRoot
- "start an object move; if inRoot is true, view
- boundaries may be crossed."
-
- something notNil ifTrue:[
- self select:something.
- (self canMove:something) ifTrue:[
- self setMoveActions.
- moveStartPoint := aPoint.
- rootMotion := inRoot.
- ] ifFalse:[
- self setDefaultActions
- ]
- ]
-!
-
-setMoveActions
- "setup to drag an object. Call this (for example) from your buttonPress
- method, to make the view start to drag some object.
- See startObjectMove and startRootObjectMove."
-
- motionAction := [:movePoint | self doObjectMove:movePoint].
- releaseAction := [self endObjectMove]
-!
-
invertDragObject:movedObject delta:moveDelta
"draw inverting for an object move"
@@ -858,69 +776,92 @@
].
self device flush
].
+!
+
+setMoveActions
+ "setup to drag an object. Call this (for example) from your buttonPress
+ method, to make the view start to drag some object.
+ See startObjectMove and startRootObjectMove."
+
+ motionAction := [:movePoint | self doObjectMove:movePoint].
+ releaseAction := [self endObjectMove]
+!
+
+startObjectMove:something at:aPoint
+ "start an object move"
+
+ self startObjectMove:something at:aPoint inRoot:canDragOutOfView
+!
+
+startObjectMove:something at:aPoint inRoot:inRoot
+ "start an object move; if inRoot is true, view
+ boundaries may be crossed."
+
+ something notNil ifTrue:[
+ self select:something.
+ (self canMove:something) ifTrue:[
+ self setMoveActions.
+ moveStartPoint := aPoint.
+ rootMotion := inRoot.
+ ] ifFalse:[
+ self setDefaultActions
+ ]
+ ]
+!
+
+startRootObjectMove:something at:aPoint
+ "start an object move, possibly crossing view boundaries"
+
+ self startObjectMove:something at:aPoint inRoot:true
+! !
+
+!ObjectView methodsFor:'dragging rectangle'!
+
+doRectangleDrag:aPoint
+ "do drag a rectangle"
+
+ self invertDragRectangle.
+ dragObject corner:aPoint.
+ self invertDragRectangle.
+!
+
+endRectangleDrag
+ "cleanup after rectangle drag; select them"
+
+ self invertDragRectangle.
+ self cursor:oldCursor.
+ self selectAllIn:dragObject
+!
+
+invertDragRectangle
+ "helper for rectangle drag - invert the dragRectangle.
+ Extracted into a separate method to allow easier redefinition
+ (different lineWidth etc)"
+
+ self xoring:[self lineWidth:0. self displayRectangle:dragObject].
+!
+
+setRectangleDragActions
+ "setup to drag a rectangle. Call this (for example) from your buttonPress
+ method, to make the view start the drag.
+ See startRectangleDrag:."
+
+ motionAction := [:movePoint | self doRectangleDrag:movePoint].
+ releaseAction := [self endRectangleDrag]
+!
+
+startRectangleDrag:startPoint
+ "start a rectangle drag"
+
+ self setRectangleDragActions.
+ dragObject := Rectangle origin:startPoint corner:startPoint.
+ self invertDragRectangle.
+ oldCursor := cursor.
+ self cursor:leftHandCursor
! !
!ObjectView methodsFor:'drawing'!
-showDragging:something offset:anOffset
- "show an object while dragging"
-
- |drawer|
-
- rootMotion ifTrue:[
- "drag in root-window"
-
- drawer := rootView
- ] ifFalse:[
- drawer := self
- ].
- self forEach:something do:[:anObject |
- anObject drawDragIn:drawer offset:anOffset
- ]
-!
-
-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
- This is a leftOver from times when scrolling was not transparent.
- Please use redrawObjectsIntersecting:, since this will vanish."
-
- 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"
-
- |vis|
-
- shown ifTrue:[
- vis := visRect.
- clipRect notNil ifTrue:[
- vis := vis intersect:clipRect
- ].
-
- transformation notNil ifTrue:[
-"/ transformation scale ~~ 1 ifTrue:[
- vis := vis origin truncated
- corner:(vis corner + (1@1)) truncated.
-"/ ]
- ].
-
- self clippedTo:vis do:[
- self clearRectangle:vis.
- self redrawObjectsIntersecting:vis
- ]
- ]
-!
-
redraw
"redraw complete View"
@@ -930,106 +871,12 @@
]
!
-redrawObjectsOn:aGC
- "redraw all objects on a graphic context"
-
- |vFrame|
-
- (aGC == self) ifTrue:[
- shown ifFalse:[^ self].
- vFrame := Rectangle origin:0@0 corner:(width @ height).
-
- transformation notNil ifTrue:[
- vFrame := transformation applyInverseTo:vFrame.
- ].
- self redrawObjectsIntersecting:vFrame
- ] ifFalse:[
- "should loop over pages"
-
- vFrame := Rectangle origin:(0@0) corner:(9999 @ 9999).
-
- self objectsIntersecting:vFrame do:[:theObject |
- theObject drawIn:aGC
- ]
- ]
-!
-
redrawObjects
"redraw all objects"
self redrawObjectsOn:self
!
-show:anObject
- "show the object, either selected or not"
-
- (self isSelected:anObject) ifTrue:[
- self showSelected:anObject
- ] ifFalse:[
- self showUnselected:anObject
- ]
-!
-
-showUnselected:anObject
- "show an object as unselected"
-
- anObject drawIn:self
-!
-
-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)
- extent:(aRectangle extent).
-"/ transformation notNil ifTrue:[
- visRect := visRect origin truncated
- corner:(visRect corner + (1@1)) truncated.
-"/ ].
- clipRect notNil ifTrue:[
- visRect := visRect intersect:clipRect
- ].
- self clippedTo:visRect do:[
- self clearRectangle:visRect.
- self redrawObjectsIntersecting:visRect
- ]
- ]
-!
-
-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
- ]
-!
-
-showSelected:anObject
- "show an object as selected"
-
- anObject drawSelectedIn:self
-!
-
redrawObjectsAbove:anObject in:aRectangle
"redraw all objects which have part of themselfes in aRectangle
and are above (in front of) anObject.
@@ -1064,1184 +911,293 @@
self redrawObjectsAbove:anObject intersectingVisible:vis
]
]
-! !
-
-!ObjectView methodsFor:'queries'!
-
-heightOfContents
- "answer the height of the document in pixels"
-
- |h|
-
- h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
- ^ h rounded
-!
-
-widthOfContents
- "answer the width of the document in pixels"
-
- |w|
-
- w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
- ^ w rounded
-!
-
-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
!
-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
-! !
-
-!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
+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
+ ]
!
-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 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:, since this will vanish."
-
- ^ self findObjectAt:aPoint
+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
+ ]
!
-isSelected:anObject
- "return true, if the argument, anObject is in the selection"
-
- selection isNil ifTrue:[^ false].
- (selection == anObject) ifTrue:[^ true].
- selection isCollection ifTrue:[
- ^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
- ].
- ^ false
-!
-
-canMove:something
- "return true, if the argument, anObject or a collection can be moved"
-
- something isCollection ifTrue:[
- self forEach:something do:[:theObject |
- (theObject canBeMoved) ifFalse:[^ false]
+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)
+ extent:(aRectangle extent).
+"/ transformation notNil ifTrue:[
+ visRect := visRect origin truncated
+ corner:(visRect corner + (1@1)) truncated.
+"/ ].
+ clipRect notNil ifTrue:[
+ visRect := visRect intersect:clipRect
].
- ^ true
- ].
- ^ something canBeMoved
-!
-
-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
-!
-
-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 hitDelta.
- contents reverseDo:[:object |
- (object isHitBy:aPoint withDelta:hdelta) ifTrue:[
- (aBlock value:object) ifTrue:[^ object]
+ self clippedTo:visRect do:[
+ self clearRectangle:visRect.
+ self redrawObjectsIntersecting:visRect
]
- ].
- ^ 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:suchThat:, since this will vanish."
-
- ^ self findObjectAt:aPoint suchThat:aBlock
-! !
-
-!ObjectView methodsFor:'user interface'!
-
-alignToGrid:aPoint
- "round aPoint to the next nearest point on the grid"
-
- aligning ifFalse:[
- ^ aPoint
- ].
-
- ^ (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 findObjectAt: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 findObjectAt: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 findObjectAt: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:'selections'!
-
-unselect
- "unselect - hide selection; clear selection"
-
- self hideSelection.
- selection := nil
-!
-
-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.
- sel notNil ifTrue:[self unselect].
- aBlock value.
- sel notNil ifTrue:[self select:sel]
-!
-
-select:something
- "select something - hide previouse selection, set to something and hilight"
-
- (selection == something) ifFalse:[
- self hideSelection.
- selection := something.
- self showSelection
]
!
-selectionDo:aBlock
- "apply block to every object in selection"
-
- self forEach:selection do:aBlock
-!
-
-hideSelection
- "hide the selection - undraw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showUnselected:object
- ]
-!
-
-showSelection
- "show the selection - draw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showSelected:object
+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:[
+"/ transformation scale ~~ 1 ifTrue:[
+ vis := vis origin truncated
+ corner:(vis corner + (1@1)) truncated.
+"/ ]
+ ].
+
+ self clippedTo:vis do:[
+ self clearRectangle:vis.
+ self redrawObjectsIntersecting:vis
+ ]
]
!
-selectAll
- "select all objects"
-
- self hideSelection.
- selection := contents copy.
- self showSelection
-!
-
-addToSelection:anObject
- "add anObject to the selection"
-
- selection isCollection ifFalse:[
- selection := OrderedCollection with:selection
- ].
- selection add:anObject.
- self showSelected:anObject
-!
-
-removeFromSelection:anObject
- "remove anObject from the selection"
-
- selection isCollection 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.
+redrawObjectsIntersecting:aRectangle
+ "redraw all objects which have part of themself in aRectangle"
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:'initialization'!
-
-setInitialDocumentFormat
- (Smalltalk language == #english) ifTrue:[
- documentFormat := 'letter'.
- scaleMetric := #inch
- ] ifFalse:[
- documentFormat := 'a4'.
- scaleMetric := #mm
- ].
-!
-
-initEvents
-"/ self backingStore:true.
-!
-
-initialize
- super initialize.
-
- viewBackground := White.
-
- bitGravity := #NorthWest.
- contents := OrderedCollection new.
- gridShown := false.
-
- canDragOutOfView := false.
- rootView := DisplayRootView new.
- rootView noClipByChildren.
- rootMotion := false.
- self setInitialDocumentFormat.
-
- leftHandCursor := Cursor leftHand.
- sorted := false.
- aligning := false
-! !
-
-!ObjectView methodsFor:'cut & paste '!
-
-deleteSelection
- "delete the selection into the cut&paste buffer"
-
- |tmp|
-
- tmp := selection.
- self unselect.
- self remove:tmp.
- self setSelection:tmp
-!
-
-pasteBuffer
- "add the objects in the paste-buffer"
-
- |sel|
-
- sel := self getSelection.
- (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
- ifTrue:[
- "
- a local selection - paste with some offset
- "
- sel size > 0 ifTrue:[
- sel := sel collect:[:element |
- element copy moveTo:(element origin + (8 @ 8))
- ]
- ] ifFalse:[
- sel := sel copy moveTo:(sel origin + (8 @ 8))
- ]
- ].
- self paste:sel
-!
-
-convertForPaste:anObject
- "return a converted version of anObject to be pasted, or nil if
- the object is not compatible with me.
- Return nil here; concrete subclasses should try to convert.
- Notice: anObject may be a collection of to-be-pasted objects."
-
- "in concrete subclasses, you can use:"
-"
- |s|
-
- (anObject respondsTo:#asDisplayObject) ifTrue:[
- ^ anObject asDisplayObject
- ].
- (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
- ].
- anObject size > 0 ifTrue:[
- (anObject inject:true into:[:okSoFar :element |
- okSoFar and:[element respondsTo:#asDisplayObject]
- ]) ifFalse:[
- self warn:'selection not convertable to DisplayObject'.
- ^ nil
- ].
- ^ anObject collect:[:element | element asDisplayObject].
- ].
-"
- ^ nil.
-!
-
-paste:something
- "add the objects in the cut&paste-buffer"
-
- |s|
-
- self unselect.
- s := self convertForPaste:something .
- s isNil ifTrue:[
- self warn:'selection not convertable'.
- ^ self
- ].
- self addSelected:s
-!
-
-copySelection
- "copy the selection into the cut&paste-buffer"
-
- |tmp|
-
- tmp := OrderedCollection new.
- self selectionDo:[:object |
- tmp add:(object copy)
- ].
-"/ self forEach:tmp do:[:anObject |
-"/ anObject moveTo:(anObject origin + (8 @ 8))
-"/ ].
- self setSelection:tmp
-! !
-
-!ObjectView methodsFor:'adding / removing'!
-
-addWithoutRedraw:something
- "add something, anObject or a collection of objects to the contents
- do not redraw"
-
- self forEach:something do:[:anObject |
- self addObjectWithoutRedraw:anObject
+ self show:theObject
]
!
-addObjectWithoutRedraw:anObject
- "add the argument, anObject to the contents - no redraw"
-
- anObject notNil ifTrue:[
- contents addLast:anObject
- ]
-!
-
-addSelected:something
- "add something, anObject or a collection of objects to the contents
- and select it"
-
- self add:something.
- self select:something
+redrawObjectsIntersectingVisible:aRectangle
+ "redraw all objects which have part of themself in a vis rectangle
+ This is a leftOver from times when scrolling was not transparent.
+ Please use redrawObjectsIntersecting:, since this will vanish."
+
+ self redrawObjectsIntersecting:aRectangle
!
-remove:something
- "remove something, anObject or a collection of objects from the contents
- do redraw"
-
- something size > (contents size / 4) ifTrue:[
- "
- better to remove first, then redraw rest
- "
- self forEach:something do:[:anObject |
- self removeFromSelection:anObject.
- contents remove:anObject.
+redrawObjectsOn:aGC
+ "redraw all objects on a graphic context"
+
+ |vFrame|
+
+ (aGC == self) ifTrue:[
+ shown ifFalse:[^ self].
+ vFrame := Rectangle origin:0@0 corner:(width @ height).
+
+ transformation notNil ifTrue:[
+ vFrame := transformation applyInverseTo:vFrame.
].
- self redraw.
- ^ self
- ].
-
- 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)
+ self redrawObjectsIntersecting:vFrame
+ ] ifFalse:[
+ "should loop over pages"
+
+ vFrame := Rectangle origin:(0@0) corner:(9999 @ 9999).
+
+ self objectsIntersecting:vFrame do:[:theObject |
+ theObject drawIn:aGC
]
]
!
-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
- ]
+redrawScale
+ "redraw the scales"
+
+ self redrawHorizontalScale.
+ self redrawVerticalScale
+!
+
+show:anObject
+ "show the object, either selected or not"
+
+ (self isSelected:anObject) ifTrue:[
+ self showSelected:anObject
+ ] ifFalse:[
+ self showUnselected:anObject
]
!
-add:something
- "add something, anObject or a collection of objects to the contents
- with redraw"
-
+showDragging:something offset:anOffset
+ "show an object while dragging"
+
+ |drawer|
+
+ rootMotion ifTrue:[
+ "drag in root-window"
+
+ drawer := rootView
+ ] ifFalse:[
+ drawer := self
+ ].
self forEach:something do:[:anObject |
- self addObject:anObject
- ]
-!
-
-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
+ anObject drawDragIn:drawer offset:anOffset
]
!
-removeAllWithoutRedraw
- "remove all - no redraw"
-
- selection := nil.
- contents := OrderedCollection new
+showSelected:anObject
+ "show an object as selected"
+
+ anObject drawSelectedIn:self
!
-removeAll
- "remove all - redraw"
-
- self removeAllWithoutRedraw.
- self redraw
+showUnselected:anObject
+ "show an object as unselected"
+
+ anObject drawIn:self
! !
-!ObjectView methodsFor:'layout manipulation'!
-
-moveObject:anObject to:newOrigin
- "move anObject to newOrigin, aPoint"
-
- |oldOrigin oldFrame newFrame
- objectsIntersectingOldFrame objectsIntersectingNewFrame
- wasObscured isObscured intersects
- 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:[
- oldLeft := oldFrame left.
- oldTop := oldFrame top.
- newLeft := newFrame left.
- newTop := newFrame top.
- w := oldFrame width.
- h := oldFrame height.
- ((newLeft < width) and:[newTop < height]) ifTrue:[
- ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
- self catchExpose.
- 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
- ]
- ]
- ]
+!ObjectView methodsFor:'event handling'!
+
+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]
]
- ]
- ].
- isObscured := self isObscured:anObject.
- (oldFrame intersects:newFrame) ifTrue:[
- isObscured ifFalse:[
- self redrawObjectsIn:oldFrame.
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:(oldFrame merge:newFrame)
+ ].
+ movePoint := xpos @ ypos.
+
+ (xpos == (lastButt x)) ifTrue:[
+ (ypos == (lastButt y)) ifTrue:[
+ ^ self "no move"
+ ]
+ ].
+
+ motionAction notNil ifTrue:[
+ motionAction value:movePoint
+ ].
+ lastButt := movePoint
+ ]
+!
+
+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:[
- self redrawObjectsIn:oldFrame.
- isObscured ifFalse:[
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:newFrame
- ]
+ super buttonMultiPress:button x:x y:y
]
!
-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
+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
]
!
-moveObject:anObject by:delta
- "change the position of anObject by delta, aPoint"
-
- self moveObject:anObject to:(anObject origin + delta)
-!
-
-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'
+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
+ ]
!
-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'
+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
+ ]
!
-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
+keyPress:key x:x y:y
+ keyPressAction notNil ifTrue:[
+ selection notNil ifTrue:[
+ self selectionDo: [:obj |
+ obj keyInput:key
+ ]
]
]
!
-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:'dragging rectangle'!
-
-setRectangleDragActions
- "setup to drag a rectangle. Call this (for example) from your buttonPress
- method, to make the view start the drag.
- See startRectangleDrag:."
-
- motionAction := [:movePoint | self doRectangleDrag:movePoint].
- releaseAction := [self endRectangleDrag]
-!
-
-endRectangleDrag
- "cleanup after rectangle drag; select them"
-
- self invertDragRectangle.
- self cursor:oldCursor.
- self selectAllIn:dragObject
-!
-
-invertDragRectangle
- "helper for rectangle drag - invert the dragRectangle.
- Extracted into a separate method to allow easier redefinition
- (different lineWidth etc)"
-
- self xoring:[self lineWidth:0. self displayRectangle:dragObject].
-!
-
-startRectangleDrag:startPoint
- "start a rectangle drag"
-
- self setRectangleDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragRectangle.
- oldCursor := cursor.
- self cursor:leftHandCursor
-!
-
-doRectangleDrag:aPoint
- "do drag a rectangle"
-
- self invertDragRectangle.
- dragObject corner:aPoint.
- self invertDragRectangle.
-! !
-
-!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"
-
- |current|
-
- transformation isNil ifTrue:[
- current := 1@1
- ] ifFalse:[
- current := transformation scale
- ].
- factor asPoint = current asPoint ifTrue:[
- ^ self
- ].
- current := factor.
- current isNil ifTrue:[
- current := 1
- ].
-
- (current = 1) ifTrue:[
- transformation := nil
- ] ifFalse:[
- transformation := WindowingTransformation scale:current translation:0.
- ].
- self contentsChanged.
- self setInnerClip.
- gridShown ifTrue:[
- self newGrid
- ].
- shown ifTrue:[
- self clear.
- self redraw
- ].
-!
-
-zoomIn
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation scale:(transformation scale / 2)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self redraw.
-!
-
-zoomOut
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation scale:(transformation scale * 2)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self redraw
-!
-
-millimeterMetric
- (scaleMetric ~~ #mm) ifTrue:[
- scaleMetric := #mm.
- self newGrid
- ]
-!
-
-inchMetric
- (scaleMetric ~~ #inch) ifTrue:[
- scaleMetric := #inch.
- self newGrid
+redrawX:x y:y width:w height:h
+ |redrawFrame |
+
+ ((contents size ~~ 0) or:[gridShown]) ifTrue:[
+ redrawFrame := Rectangle left:x top:y
+ width:w height:h.
+ self redrawObjectsInVisible:redrawFrame
]
! !
!ObjectView methodsFor:'grid manipulation'!
-newGrid
- "define a new grid - this is a private helper which has to be
- called after any change in the grid. It (re)creates the gridPixmap,
- clears the view and redraws all visible objects."
-
- gridPixmap := nil.
- shown ifTrue:[
- self viewBackground:White.
- self clear.
- ].
-
- gridShown ifTrue:[
- self defineGrid.
- self viewBackground:gridPixmap.
- ].
- shown ifTrue:[
- self redraw
- ].
+alignOff
+ "do no align point to grid"
+
+ aligning := false
!
-gridParameters
- "used by defineGrid, and in a separate method for
- easier redefinition in subclasses.
- Returns the grid parameters in an array of 7 elements,
- which control the appearance of the grid-pattern.
- the elements are:
-
- 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 (pointer snap)
- gridAlignV number of pixels for vertical grid align (pointer snap)
- docBounds true, if document boundary should be shown
-
- if littleStepH/V are nil, only bigSteps are drawn.
- "
-
- |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.
-
- "
- metric grid: small steps every millimeter, big step every
- centimeter. If the transformation is shrinking, turn off little
- steps.
- "
- (scaleMetric == #mm) ifTrue:[
- "dots every mm; lines every cm"
- bigStepH := mmH * 10.0.
- bigStepV := mmV * 10.0.
- (transformation notNil
- and:[transformation scale <= 0.5]) ifFalse:[
- littleStepH := mmH.
- littleStepV := mmV
- ]
- ].
- "
- inch grid: small steps every 1/8th inch, big step every half inch
- If the transformation is shrinking, change little steps to 1/th inch
- or even turn them off completely.
- "
- (scaleMetric == #inch) ifTrue:[
- "dots every eights inch; lines every half inch"
- bigStepH := mmH * (25.4 / 2).
- bigStepV := mmV * (25.4 / 2).
- (transformation notNil
- and:[transformation scale <= 0.5]) ifTrue:[
- transformation scale > 0.2 ifTrue:[
- littleStepH := mmH * (25.4 / 4).
- littleStepV := mmV * (25.4 / 4)
- ]
- ] ifFalse:[
- 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
+alignOn
+ "align points to grid"
+
+ aligning := true.
+ self getAlignParameters
!
defineGrid
@@ -2380,12 +1336,91 @@
]
!
-showGrid
- "show the grid. The grid is defined by the return value of
- gridParameters, which can be redefined in concrete subclasses."
-
- gridShown := true.
- self newGrid
+getAlignParameters
+ |params|
+
+ params := self gridParameters.
+ gridAlign := (params at:5) @ (params at:6)
+!
+
+gridParameters
+ "used by defineGrid, and in a separate method for
+ easier redefinition in subclasses.
+ Returns the grid parameters in an array of 7 elements,
+ which control the appearance of the grid-pattern.
+ the elements are:
+
+ 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 (pointer snap)
+ gridAlignV number of pixels for vertical grid align (pointer snap)
+ docBounds true, if document boundary should be shown
+
+ if littleStepH/V are nil, only bigSteps are drawn.
+ "
+
+ |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.
+
+ "
+ metric grid: small steps every millimeter, big step every
+ centimeter. If the transformation is shrinking, turn off little
+ steps.
+ "
+ (scaleMetric == #mm) ifTrue:[
+ "dots every mm; lines every cm"
+ bigStepH := mmH * 10.0.
+ bigStepV := mmV * 10.0.
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifFalse:[
+ littleStepH := mmH.
+ littleStepV := mmV
+ ]
+ ].
+ "
+ inch grid: small steps every 1/8th inch, big step every half inch
+ If the transformation is shrinking, change little steps to 1/th inch
+ or even turn them off completely.
+ "
+ (scaleMetric == #inch) ifTrue:[
+ "dots every eights inch; lines every half inch"
+ bigStepH := mmH * (25.4 / 2).
+ bigStepV := mmV * (25.4 / 2).
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifTrue:[
+ transformation scale > 0.2 ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ]
+ ] ifFalse:[
+ 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
!
hideGrid
@@ -2395,252 +1430,742 @@
self newGrid
!
-getAlignParameters
- |params|
-
- params := self gridParameters.
- gridAlign := (params at:5) @ (params at:6)
+newGrid
+ "define a new grid - this is a private helper which has to be
+ called after any change in the grid. It (re)creates the gridPixmap,
+ clears the view and redraws all visible objects."
+
+ gridPixmap := nil.
+ shown ifTrue:[
+ self viewBackground:White.
+ self clear.
+ ].
+
+ gridShown ifTrue:[
+ self defineGrid.
+ self viewBackground:gridPixmap.
+ ].
+ shown ifTrue:[
+ self redraw
+ ].
!
-alignOn
- "align points to grid"
-
- aligning := true.
- self getAlignParameters
+showGrid
+ "show the grid. The grid is defined by the return value of
+ gridParameters, which can be redefined in concrete subclasses."
+
+ gridShown := true.
+ self newGrid
+! !
+
+!ObjectView methodsFor:'initialization'!
+
+initEvents
+"/ self backingStore:true.
!
-alignOff
- "do no align point to grid"
-
+initialize
+ super initialize.
+
+ viewBackground := White.
+
+ bitGravity := #NorthWest.
+ contents := OrderedCollection new.
+ gridShown := false.
+
+ canDragOutOfView := false.
+ rootView := DisplayRootView new.
+ rootView noClipByChildren.
+ rootMotion := false.
+ self setInitialDocumentFormat.
+
+ leftHandCursor := Cursor leftHand.
+ sorted := false.
aligning := false
+!
+
+setInitialDocumentFormat
+ (Smalltalk language == #english) ifTrue:[
+ documentFormat := 'letter'.
+ scaleMetric := #inch
+ ] ifFalse:[
+ documentFormat := 'a4'.
+ scaleMetric := #mm
+ ].
! !
-!ObjectView methodsFor:'dragging line'!
-
-setLineDragActions
- "setup to drag a line. Call this (for example) from your buttonPress
- method, to make the view start to drag a line.
- See startLineDrag and startRootLineDrag."
-
- motionAction := [:movePoint | self doLineDrag:movePoint].
- releaseAction := [self endLineDrag]
+!ObjectView methodsFor:'layout manipulation'!
+
+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))
+ ]
+ ]
+!
+
+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)
+ ]
+ ]
+!
+
+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
+ ]
+!
+
+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'
!
-startLineDrag:startPoint
- "start a line drag within the view"
-
- self setLineDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragLine.
- oldCursor := cursor.
- self cursor:leftHandCursor
+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
+ 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:[
+ oldLeft := oldFrame left.
+ oldTop := oldFrame top.
+ newLeft := newFrame left.
+ newTop := newFrame top.
+ w := oldFrame width.
+ h := oldFrame height.
+ ((newLeft < width) and:[newTop < height]) ifTrue:[
+ ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+ self catchExpose.
+ 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
+ ]
+ ]
!
-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
+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)
+ ]
+ ]
+!
+
+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
+ ]
+ ]
+!
+
+selectionAlignBottom
+ "align selected objects at bottom"
+
+ self alignBottom:selection
+!
+
+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
!
-doLineDrag:aPoint
- "do drag a line"
-
- self invertDragLine.
- dragObject corner:aPoint.
- self invertDragLine.
+selectionToBack
+ "bring the selection to back"
+
+ self toBack:selection
+!
+
+selectionToFront
+ "bring the selection to front"
+
+ self toFront:selection
+!
+
+toBack:something
+ "bring the argument, anObject or a collection of objects to back"
+
+ self forEach:something do:[:anObject |
+ self objectToBack:anObject
+ ]
+!
+
+toFront:something
+ "bring the argument, anObject or a collection of objects to front"
+
+ self forEach:something do:[:anObject |
+ self objectToFront:anObject
+ ]
+! !
+
+!ObjectView methodsFor:'misc'!
+
+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
+ ]
+ ]
+!
+
+forEach:aCollection do:aBlock
+ "apply block to every object in a collectioni;
+ (adds a check for non-collection)"
+
+ aCollection isNil ifTrue:[^self].
+ aCollection isCollection ifTrue:[
+ aCollection do:[:object |
+ object notNil ifTrue:[
+ aBlock value:object
+ ]
+ ]
+ ] ifFalse: [
+ aBlock value:aCollection
+ ]
!
-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."
-
- |rootPoint viewId offs
- lastViewId destinationId destinationView destinationPoint inMySelf|
-
- self invertDragLine.
-
- self cursor:oldCursor.
-
- "check if line drag is into another view"
- rootMotion ifTrue:[
- rootPoint := lastButt.
- "
- get device coordinates
- "
-"/ 'logical ' print. rootPoint printNL.
- transformation notNil ifTrue:[
- rootPoint := transformation applyTo:rootPoint.
-"/ 'device ' print. rootPoint printNL.
+hitDelta
+ "when clicking an object, allow for hitDelta pixels around object.
+ We compensate for any scaling here, to get a constant physical
+ hitDelta (i.e. the value returned here is inverse scaled)."
+
+ |delta|
+
+ delta := self class hitDelta.
+ transformation notNil ifTrue:[
+ delta := delta / transformation scale x
+ ].
+ ^ delta
+!
+
+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
+!
+
+numberOfObjectsIntersectingVisible:aRectangle
+ "answer the number of objects intersecting the argument, aRectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use numberOfObjectsIntersecting:, since this will vanish."
+
+ ^ self numberOfObjectsIntersecting:aRectangle
+!
+
+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
+ ]
+ ]
+!
+
+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
+!
+
+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]
+ ]
].
- "
- translate to screen
+ ^ 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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIn:do:, since this will vanish."
+
+ self objectsIn:aRectangle 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
+!
+
+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 }"|
+
+ nObjects := contents size.
+ (nObjects == 0) ifTrue:[^ self].
+
+ sorted ifFalse:[
"
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
-"/ 'offs' print. offs printNL.
- rootPoint := rootPoint + offs.
-"/ 'screen ' print. rootPoint printNL.
-
-"/ 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
+ have to check every object
+ "
+ contents do:[:theObject |
+ (theObject frame intersects:aRectangle) ifTrue:[
+ aBlock value:theObject
+ ]
].
- destinationView := device viewFromId:lastViewId.
- destinationId := lastViewId.
- inMySelf := (destinationView == self).
- rootMotion := false
+ ^ self
+ ].
+
+ "
+ contents is sorted by y; can do a fast (binary) search for the first
+ object which intersects aRectangle and
+ break from the draw loop, when the 1st object below aRectangle is reached.
+ "
+ bot := aRectangle bottom.
+ top := aRectangle top.
+
+ "
+ binary search for 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:[
- inMySelf := true
+ [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
].
- inMySelf ifTrue:[
- "a simple line within myself"
- self lineDragFrom:dragObject origin to:dragObject corner
- ] ifFalse:[
- "into another one"
- destinationView notNil ifTrue:[
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:(destinationView id).
- destinationView transformation notNil ifTrue:[
- destinationPoint := destinationView transformation applyInverseTo:destinationPoint
- ].
- "
- move into another smalltalk view
- "
- self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
+ firstIndex to:nObjects do:[:index |
+ theObject := contents at:index.
+ f := theObject frame.
+ (f intersects:aRectangle) ifTrue:[
+ aBlock value:theObject
] ifFalse:[
- "
- not one of my views
- "
- self lineDragFrom:dragObject origin
- to:destinationPoint
- inAlienViewId:destinationId
- ]
+ (f top > bot) ifTrue:[^ self]
+ ]
+ ]
+!
+
+objectsIntersectingVisible:aRectangle
+ "answer a Collection of objects intersecting a visible aRectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIntersecting:, since this will vanish."
+
+ ^ self objectsIntersecting:aRectangle
+!
+
+objectsIntersectingVisible:aRectangle do:aBlock
+ "do something to every object which intersects a visible rectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIntersecting:do:, since this will vanish."
+
+ self objectsIntersecting:aRectangle do:aBlock
+!
+
+rectangleForScroll
+ "find the area occupied by visible objects"
+
+ |left right top bottom frame oLeft oRight oTop oBottom|
+
+ left := 9999.
+ right := 0.
+ top := 9999.
+ bottom := 0.
+ self visibleObjectsDo:[:anObject |
+ frame := anObject frame.
+ oLeft := frame left.
+ oRight := frame right.
+ oTop := frame top.
+ oBottom := frame bottom.
+ (oLeft < left) ifTrue:[left := oLeft].
+ (oRight > right) ifTrue:[right := oRight].
+ (oTop < top) ifTrue:[top := oTop].
+ (oBottom > bottom) ifTrue:[bottom := oBottom]
].
- self setDefaultActions.
- dragObject := nil
+ (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
+!
+
+setDefaultActions
+ motionAction := [:movePoint | nil].
+ releaseAction := [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'
+visibleObjectsDo:aBlock
+ "do something to every visible object"
+
+ |absRect|
+
+ absRect := Rectangle left:0 top:0 width:width height:height.
+ self objectsIntersecting:absRect do:aBlock
+! !
+
+!ObjectView methodsFor:'queries'!
+
+heightOfContents
+ "answer the height of the document in pixels"
+
+ |h|
+
+ h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
+ ^ h rounded
!
-invertDragLine
- "helper for line dragging - invert the dragged line.
- Extracted for easier redefinition in subclasses
- (different line width etc.)"
-
- |dragger offs p1 p2|
-
- p1 := dragObject origin.
- p2 := dragObject corner.
- rootMotion ifTrue:[
- dragger := rootView.
- "
- get device coordinates
- "
-"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
- transformation notNil ifTrue:[
- p1 := transformation applyTo:p1.
- p2 := transformation applyTo:p2.
-"/ 'device ' print. p1 print. ' ' print. p2 printNL.
- ].
- "
- translate to screen
- "
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
-"/ 'offs' print. offs printNL.
- p1 := p1 + offs.
- p2 := p2 + offs.
-"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
- ] ifFalse:[
- dragger := self.
+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
].
-
- dragger xoring:[
- dragger lineWidth:0.
- dragger displayLineFrom:p1 to:p2.
- dragger device flush
+ "*** 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).
+ ^ w 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
! !
!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
- ]
-!
-
-storeBinaryContentsOn:aStream
- "store the contents in binary representation on aStream."
-
- aStream binary.
- self topView withCursor:Cursor write do:[
- self forEach:contents do:[:theObject |
- theObject storeBinaryOn:aStream.
- ].
- ]
-!
-
-withoutRedrawFileInContentsFrom:aStream
- "remove all objects, load new contents from aStream without any redraw"
-
- self fileInContentsFrom:aStream redraw:false new:true binary:false
-!
-
fileInContentsFrom:aStream
"remove all objects, load new contents from aStream and redraw"
@@ -2703,4 +2228,479 @@
self redraw
]
]
+!
+
+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
+!
+
+storeBinaryContentsOn:aStream
+ "store the contents in binary representation on aStream."
+
+ aStream binary.
+ self topView withCursor:Cursor write do:[
+ self forEach:contents do:[:theObject |
+ theObject storeBinaryOn:aStream.
+ ].
+ ]
+!
+
+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
+ "remove all objects, load new contents from aStream without any redraw"
+
+ self fileInContentsFrom:aStream redraw:false new:true binary:false
! !
+
+!ObjectView methodsFor:'scrolling'!
+
+horizontalScrollStep
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
+
+ scaleMetric == #inch ifTrue:[
+ ^ (device horizontalPixelPerInch * (1/2)) asInteger
+ ].
+ ^ (device horizontalPixelPerMillimeter * 20) asInteger
+!
+
+verticalScrollStep
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
+
+ scaleMetric == #inch ifTrue:[
+ ^ (device verticalPixelPerInch * (1/2)) asInteger
+ ].
+ ^ (device verticalPixelPerMillimeter * 20) asInteger
+! !
+
+!ObjectView methodsFor:'selections'!
+
+addToSelection:anObject
+ "add anObject to the selection"
+
+ selection isCollection ifFalse:[
+ selection := OrderedCollection with:selection
+ ].
+ selection add:anObject.
+ self showSelected:anObject
+!
+
+hideSelection
+ "hide the selection - undraw hilights - whatever that is"
+
+ self selectionDo:[:object |
+ self showUnselected:object
+ ]
+!
+
+removeFromSelection:anObject
+ "remove anObject from the selection"
+
+ selection isCollection ifTrue:[
+ selection remove:anObject ifAbsent:[nil].
+ (selection size == 1) ifTrue:[
+ selection := selection first
+ ]
+ ] ifFalse:[
+ (selection == anObject) ifTrue:[
+ selection := nil
+ ]
+ ].
+ self showUnselected:anObject
+!
+
+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 copy.
+ 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
+!
+
+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
+!
+
+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
+ ]
+!
+
+unselect
+ "unselect - hide selection; clear selection"
+
+ self hideSelection.
+ selection := nil
+!
+
+withSelectionHiddenDo:aBlock
+ "evaluate aBlock while selection is hidden"
+
+ |sel|
+
+ sel := selection.
+ sel notNil ifTrue:[self unselect].
+ aBlock value.
+ sel notNil ifTrue:[self select:sel]
+! !
+
+!ObjectView methodsFor:'testing objects'!
+
+canMove:something
+ "return true, if the argument, anObject or a collection can be moved"
+
+ something isCollection ifTrue:[
+ self forEach:something do:[:theObject |
+ (theObject canBeMoved) ifFalse:[^ false]
+ ].
+ ^ true
+ ].
+ ^ something canBeMoved
+!
+
+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 hitDelta.
+ contents reverseDo:[:object |
+ (object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
+ ].
+ ^ nil
+!
+
+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 hitDelta.
+ contents reverseDo:[:object |
+ (object isHitBy:aPoint withDelta:hdelta) ifTrue:[
+ (aBlock value:object) 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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use findObjectAt:, since this will vanish."
+
+ ^ self findObjectAt:aPoint
+!
+
+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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use findObjectAt:suchThat:, since this will vanish."
+
+ ^ self findObjectAt:aPoint 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
+!
+
+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
+!
+
+isSelected:anObject
+ "return true, if the argument, anObject is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ (selection == anObject) ifTrue:[^ true].
+ selection isCollection 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:'user interface'!
+
+alignToGrid:aPoint
+ "round aPoint to the next nearest point on the grid"
+
+ aligning ifFalse:[
+ ^ aPoint
+ ].
+
+ ^ (aPoint grid:gridAlign) rounded
+!
+
+selectMore:aPoint
+ "add/remove an object from the selection"
+
+ |anObject|
+
+ anObject := self findObjectAt: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 findObjectAt: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
+!
+
+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 findObjectAt: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
+! !
+
+!ObjectView methodsFor:'view manipulation'!
+
+inchMetric
+ (scaleMetric ~~ #inch) ifTrue:[
+ scaleMetric := #inch.
+ self newGrid
+ ]
+!
+
+millimeterMetric
+ (scaleMetric ~~ #mm) ifTrue:[
+ scaleMetric := #mm.
+ self newGrid
+ ]
+!
+
+zoom:factor
+ "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
+ 0.5 is shrink by 2"
+
+ |current|
+
+ transformation isNil ifTrue:[
+ current := 1@1
+ ] ifFalse:[
+ current := transformation scale
+ ].
+ factor asPoint = current asPoint ifTrue:[
+ ^ self
+ ].
+ current := factor.
+ current isNil ifTrue:[
+ current := 1
+ ].
+
+ (current = 1) ifTrue:[
+ transformation := nil
+ ] ifFalse:[
+ transformation := WindowingTransformation scale:current translation:0.
+ ].
+ self contentsChanged.
+ self setInnerClip.
+ gridShown ifTrue:[
+ self newGrid
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ].
+!
+
+zoomIn
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale / 2)
+ translation:0.
+ self contentsChanged.
+ self setInnerClip.
+ self redraw.
+!
+
+zoomOut
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale * 2)
+ translation:0.
+ self contentsChanged.
+ self setInnerClip.
+ self redraw
+! !
+
+!ObjectView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.29 1995-11-27 22:28:58 cg Exp $'
+! !
--- a/ObjectView.st Mon Nov 27 21:32:45 1995 +0100
+++ b/ObjectView.st Mon Nov 27 23:28:58 1995 +0100
@@ -10,15 +10,13 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
-
View subclass:#ObjectView
- instanceVariableNames:'contents sorted lastButt pressAction
- releaseAction shiftPressAction doublePressAction motionAction
- keyPressAction selection gridShown gridPixmap scaleMetric
- dragObject leftHandCursor oldCursor movedObject
- moveStartPoint moveDelta documentFormat canDragOutOfView
- rootMotion rootView aligning gridAlign aligningMove'
+ instanceVariableNames:'contents sorted lastButt pressAction releaseAction
+ shiftPressAction doublePressAction motionAction keyPressAction
+ selection gridShown gridPixmap scaleMetric dragObject
+ leftHandCursor oldCursor movedObject moveStartPoint moveDelta
+ documentFormat canDragOutOfView rootMotion rootView aligning
+ gridAlign aligningMove'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
@@ -40,10 +38,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.28 1995-11-27 20:32:45 cg Exp $'
-!
-
documentation
"
a View which can hold DisplayObjects, can make selections, move them around etc.
@@ -232,428 +226,389 @@
^ 0
! !
-!ObjectView methodsFor:'scrolling'!
-
-verticalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device verticalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device verticalPixelPerMillimeter * 20) asInteger
-!
-
-horizontalScrollStep
- "return the amount to scroll when stepping left/right.
- Redefined to scroll by inches or centimeters."
-
- scaleMetric == #inch ifTrue:[
- ^ (device horizontalPixelPerInch * (1/2)) asInteger
- ].
- ^ (device horizontalPixelPerMillimeter * 20) asInteger
-! !
-
-!ObjectView methodsFor:'misc'!
-
-hitDelta
- "when clicking an object, allow for hitDelta pixels around object.
- We compensate for any scaling here, to get a constant physical
- hitDelta (i.e. the value returned here is inverse scaled)."
-
- |delta|
-
- delta := self class hitDelta.
- transformation notNil ifTrue:[
- delta := delta / transformation scale x
- ].
- ^ delta
+!ObjectView methodsFor:'adding / removing'!
+
+add:something
+ "add something, anObject or a collection of objects to the contents
+ with redraw"
+
+ self forEach:something do:[:anObject |
+ self addObject:anObject
+ ]
!
-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 }"|
-
- nObjects := contents size.
- (nObjects == 0) ifTrue:[^ self].
-
- sorted ifFalse:[
- "
- have to check every object
- "
- contents do:[:theObject |
- (theObject frame intersects:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
- ].
- ^ self
- ].
-
- "
- contents is sorted by y; can do a fast (binary) search for the first
- object which intersects aRectangle and
- break from the draw loop, when the 1st object below aRectangle is reached.
- "
- bot := aRectangle bottom.
- top := aRectangle top.
-
- "
- binary search for 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]
+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
]
]
!
-forEach:aCollection do:aBlock
- "apply block to every object in a collectioni;
- (adds a check for non-collection)"
-
- aCollection isNil ifTrue:[^self].
- aCollection isCollection ifTrue:[
- aCollection do:[:object |
- object notNil ifTrue:[
- aBlock value:object
- ]
- ]
- ] ifFalse: [
- aBlock value:aCollection
+addObjectWithoutRedraw:anObject
+ "add the argument, anObject to the contents - no redraw"
+
+ anObject notNil ifTrue:[
+ contents addLast:anObject
+ ]
+!
+
+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
]
!
-objectsIntersectingVisible:aRectangle do:aBlock
- "do something to every object which intersects a visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:do:, since this will vanish."
-
- self objectsIntersecting:aRectangle do:aBlock
-!
-
-setDefaultActions
- motionAction := [:movePoint | nil].
- releaseAction := [nil]
-!
-
-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
-!
-
-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]
- ]
+remove:something
+ "remove something, anObject or a collection of objects from the contents
+ do redraw"
+
+ something size > (contents size / 4) ifTrue:[
+ "
+ better to remove first, then redraw rest
+ "
+ self forEach:something do:[:anObject |
+ self removeFromSelection:anObject.
+ contents remove:anObject.
].
+ self redraw.
^ self
].
- contents do:[:theObject |
- (theObject isContainedIn:aRectangle) ifTrue:[
- aBlock value:theObject
- ]
+ self forEach:something do:[:anObject |
+ self removeObject:anObject
]
!
-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
+removeAll
+ "remove all - redraw"
+
+ self removeAllWithoutRedraw.
+ self redraw
+!
+
+removeAllWithoutRedraw
+ "remove all - no redraw"
+
+ selection := nil.
+ contents := OrderedCollection new
+!
+
+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)
]
]
!
-objectsInVisible:aRectangle do:aBlock
- "do something to every object which is completely in a
- visible rectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIn:do:, since this will vanish."
-
- self objectsIn:aRectangle do:aBlock
-!
-
-visibleObjectsDo:aBlock
- "do something to every visible object"
-
- |absRect|
-
- absRect := Rectangle left:0 top:0 width:width height:height.
- self objectsIntersecting:absRect do:aBlock
-!
-
-numberOfObjectsIntersectingVisible:aRectangle
- "answer the number of objects intersecting the argument, aRectangle.
- This is a leftOver from times when scrolling was not transparent.
- Please use numberOfObjectsIntersecting:, since this will vanish."
-
- ^ 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use objectsIntersecting:, since this will vanish."
-
- ^ self objectsIntersecting:aRectangle
-!
-
-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
- ]
+removeObjectWithoutRedraw:anObject
+ "remove the argument, anObject from the contents - no redraw"
+
+ anObject notNil ifTrue:[
+ self removeFromSelection:anObject.
+ contents remove:anObject
]
!
-rectangleForScroll
- "find the area occupied by visible objects"
-
- |left right top bottom frame oLeft oRight oTop oBottom|
-
- left := 9999.
- right := 0.
- top := 9999.
- bottom := 0.
- self visibleObjectsDo:[:anObject |
- frame := anObject frame.
- oLeft := frame left.
- oRight := frame right.
- oTop := frame top.
- oBottom := frame bottom.
- (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
+removeWithoutRedraw:something
+ "remove something, anObject or a collection of objects from the contents
+ do not redraw"
+
+ self forEach:something do:[:anObject |
+ self removeObjectWithoutRedraw:anObject
+ ]
! !
-!ObjectView methodsFor:'event handling'!
-
-redrawX:x y:y width:w height:h
- |redrawFrame |
-
- ((contents size ~~ 0) or:[gridShown]) ifTrue:[
- redrawFrame := Rectangle left:x top:y
- width:w height:h.
- self redrawObjectsInVisible:redrawFrame
- ]
+!ObjectView methodsFor:'cut & paste '!
+
+convertForPaste:anObject
+ "return a converted version of anObject to be pasted, or nil if
+ the object is not compatible with me.
+ Return nil here; concrete subclasses should try to convert.
+ Notice: anObject may be a collection of to-be-pasted objects."
+
+ "in concrete subclasses, you can use:"
+"
+ |s|
+
+ (anObject respondsTo:#asDisplayObject) ifTrue:[
+ ^ anObject asDisplayObject
+ ].
+ (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
+ ].
+ anObject size > 0 ifTrue:[
+ (anObject inject:true into:[:okSoFar :element |
+ okSoFar and:[element respondsTo:#asDisplayObject]
+ ]) ifFalse:[
+ self warn:'selection not convertable to DisplayObject'.
+ ^ nil
+ ].
+ ^ anObject collect:[:element | element asDisplayObject].
+ ].
+"
+ ^ nil.
+!
+
+copySelection
+ "copy the selection into the cut&paste-buffer"
+
+ |tmp|
+
+ tmp := OrderedCollection new.
+ self selectionDo:[:object |
+ tmp add:(object copy)
+ ].
+"/ self forEach:tmp do:[:anObject |
+"/ anObject moveTo:(anObject origin + (8 @ 8))
+"/ ].
+ self setSelection:tmp
!
-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
+deleteSelection
+ "delete the selection into the cut&paste buffer"
+
+ |tmp|
+
+ tmp := selection.
+ self unselect.
+ self remove:tmp.
+ self setSelection:tmp
+!
+
+paste:something
+ "add the objects in the cut&paste-buffer"
+
+ |s|
+
+ self unselect.
+ s := self convertForPaste:something .
+ s isNil ifTrue:[
+ self warn:'selection not convertable'.
+ ^ self
+ ].
+ self addSelected:s
+!
+
+pasteBuffer
+ "add the objects in the paste-buffer"
+
+ |sel|
+
+ sel := self getSelection.
+ (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
+ ifTrue:[
+ "
+ a local selection - paste with some offset
+ "
+ sel size > 0 ifTrue:[
+ sel := sel collect:[:element |
+ element copy moveTo:(element origin + (8 @ 8))
+ ]
+ ] ifFalse:[
+ sel := sel copy moveTo:(sel origin + (8 @ 8))
]
- ] 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
- ]
-!
-
-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]
- ]
+ self paste:sel
+! !
+
+!ObjectView methodsFor:'dragging line'!
+
+doLineDrag:aPoint
+ "do drag a line"
+
+ 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."
+
+ |rootPoint viewId offs
+ lastViewId destinationId destinationView destinationPoint inMySelf|
+
+ self invertDragLine.
+
+ self cursor:oldCursor.
+
+ "check if line drag is into another view"
+ rootMotion ifTrue:[
+ rootPoint := lastButt.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. rootPoint printNL.
+ transformation notNil ifTrue:[
+ rootPoint := transformation applyTo:rootPoint.
+"/ 'device ' print. rootPoint printNL.
].
- movePoint := xpos @ ypos.
-
- (xpos == (lastButt x)) ifTrue:[
- (ypos == (lastButt y)) ifTrue:[
- ^ self "no move"
- ]
- ].
-
- motionAction notNil ifTrue:[
- motionAction value:movePoint
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ rootPoint := rootPoint + offs.
+"/ 'screen ' print. rootPoint printNL.
+
+"/ 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
].
- lastButt := movePoint
- ]
-!
-
-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)
- ]
+ 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:[
- super buttonMultiPress:button x:x y:y
- ]
+ "into another one"
+ destinationView notNil ifTrue:[
+ destinationPoint := device translatePoint:rootPoint
+ from:(rootView id)
+ to:(destinationView id).
+ destinationView transformation notNil ifTrue:[
+ destinationPoint := destinationView transformation applyInverseTo:destinationPoint
+ ].
+ "
+ 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
!
-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
- ]
+invertDragLine
+ "helper for line dragging - invert the dragged line.
+ Extracted for easier redefinition in subclasses
+ (different line width etc.)"
+
+ |dragger offs p1 p2|
+
+ p1 := dragObject origin.
+ p2 := dragObject corner.
+ rootMotion ifTrue:[
+ dragger := rootView.
+ "
+ get device coordinates
+ "
+"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
+ transformation notNil ifTrue:[
+ p1 := transformation applyTo:p1.
+ p2 := transformation applyTo:p2.
+"/ 'device ' print. p1 print. ' ' print. p2 printNL.
+ ].
+ "
+ translate to screen
+ "
+ offs := device translatePoint:0@0 from:(self id) to:(rootView id).
+"/ 'offs' print. offs printNL.
+ p1 := p1 + offs.
+ p2 := p2 + offs.
+"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
] ifFalse:[
- super buttonShiftPress:button x:x y:y
- ]
+ dragger := self.
+ ].
+
+ dragger xoring:[
+ dragger lineWidth:0.
+ dragger displayLineFrom:p1 to:p2.
+ dragger device flush
+ ].
+!
+
+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'
!
-keyPress:key x:x y:y
- keyPressAction notNil ifTrue:[
- selection notNil ifTrue:[
- self selectionDo: [:obj |
- obj keyInput:key
- ]
- ]
- ]
+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'
+!
+
+setLineDragActions
+ "setup to drag a line. Call this (for example) from your buttonPress
+ method, to make the view start to drag a line.
+ See startLineDrag and startRootLineDrag."
+
+ motionAction := [:movePoint | self doLineDrag:movePoint].
+ releaseAction := [self endLineDrag]
+!
+
+startLineDrag:startPoint
+ "start a line drag within the view"
+
+ 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
! !
!ObjectView methodsFor:'dragging object move'!
@@ -770,43 +725,6 @@
]
!
-startObjectMove:something at:aPoint
- "start an object move"
-
- self startObjectMove:something at:aPoint inRoot:canDragOutOfView
-!
-
-startRootObjectMove:something at:aPoint
- "start an object move, possibly crossing view boundaries"
-
- self startObjectMove:something at:aPoint inRoot:true
-!
-
-startObjectMove:something at:aPoint inRoot:inRoot
- "start an object move; if inRoot is true, view
- boundaries may be crossed."
-
- something notNil ifTrue:[
- self select:something.
- (self canMove:something) ifTrue:[
- self setMoveActions.
- moveStartPoint := aPoint.
- rootMotion := inRoot.
- ] ifFalse:[
- self setDefaultActions
- ]
- ]
-!
-
-setMoveActions
- "setup to drag an object. Call this (for example) from your buttonPress
- method, to make the view start to drag some object.
- See startObjectMove and startRootObjectMove."
-
- motionAction := [:movePoint | self doObjectMove:movePoint].
- releaseAction := [self endObjectMove]
-!
-
invertDragObject:movedObject delta:moveDelta
"draw inverting for an object move"
@@ -858,69 +776,92 @@
].
self device flush
].
+!
+
+setMoveActions
+ "setup to drag an object. Call this (for example) from your buttonPress
+ method, to make the view start to drag some object.
+ See startObjectMove and startRootObjectMove."
+
+ motionAction := [:movePoint | self doObjectMove:movePoint].
+ releaseAction := [self endObjectMove]
+!
+
+startObjectMove:something at:aPoint
+ "start an object move"
+
+ self startObjectMove:something at:aPoint inRoot:canDragOutOfView
+!
+
+startObjectMove:something at:aPoint inRoot:inRoot
+ "start an object move; if inRoot is true, view
+ boundaries may be crossed."
+
+ something notNil ifTrue:[
+ self select:something.
+ (self canMove:something) ifTrue:[
+ self setMoveActions.
+ moveStartPoint := aPoint.
+ rootMotion := inRoot.
+ ] ifFalse:[
+ self setDefaultActions
+ ]
+ ]
+!
+
+startRootObjectMove:something at:aPoint
+ "start an object move, possibly crossing view boundaries"
+
+ self startObjectMove:something at:aPoint inRoot:true
+! !
+
+!ObjectView methodsFor:'dragging rectangle'!
+
+doRectangleDrag:aPoint
+ "do drag a rectangle"
+
+ self invertDragRectangle.
+ dragObject corner:aPoint.
+ self invertDragRectangle.
+!
+
+endRectangleDrag
+ "cleanup after rectangle drag; select them"
+
+ self invertDragRectangle.
+ self cursor:oldCursor.
+ self selectAllIn:dragObject
+!
+
+invertDragRectangle
+ "helper for rectangle drag - invert the dragRectangle.
+ Extracted into a separate method to allow easier redefinition
+ (different lineWidth etc)"
+
+ self xoring:[self lineWidth:0. self displayRectangle:dragObject].
+!
+
+setRectangleDragActions
+ "setup to drag a rectangle. Call this (for example) from your buttonPress
+ method, to make the view start the drag.
+ See startRectangleDrag:."
+
+ motionAction := [:movePoint | self doRectangleDrag:movePoint].
+ releaseAction := [self endRectangleDrag]
+!
+
+startRectangleDrag:startPoint
+ "start a rectangle drag"
+
+ self setRectangleDragActions.
+ dragObject := Rectangle origin:startPoint corner:startPoint.
+ self invertDragRectangle.
+ oldCursor := cursor.
+ self cursor:leftHandCursor
! !
!ObjectView methodsFor:'drawing'!
-showDragging:something offset:anOffset
- "show an object while dragging"
-
- |drawer|
-
- rootMotion ifTrue:[
- "drag in root-window"
-
- drawer := rootView
- ] ifFalse:[
- drawer := self
- ].
- self forEach:something do:[:anObject |
- anObject drawDragIn:drawer offset:anOffset
- ]
-!
-
-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
- This is a leftOver from times when scrolling was not transparent.
- Please use redrawObjectsIntersecting:, since this will vanish."
-
- 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"
-
- |vis|
-
- shown ifTrue:[
- vis := visRect.
- clipRect notNil ifTrue:[
- vis := vis intersect:clipRect
- ].
-
- transformation notNil ifTrue:[
-"/ transformation scale ~~ 1 ifTrue:[
- vis := vis origin truncated
- corner:(vis corner + (1@1)) truncated.
-"/ ]
- ].
-
- self clippedTo:vis do:[
- self clearRectangle:vis.
- self redrawObjectsIntersecting:vis
- ]
- ]
-!
-
redraw
"redraw complete View"
@@ -930,106 +871,12 @@
]
!
-redrawObjectsOn:aGC
- "redraw all objects on a graphic context"
-
- |vFrame|
-
- (aGC == self) ifTrue:[
- shown ifFalse:[^ self].
- vFrame := Rectangle origin:0@0 corner:(width @ height).
-
- transformation notNil ifTrue:[
- vFrame := transformation applyInverseTo:vFrame.
- ].
- self redrawObjectsIntersecting:vFrame
- ] ifFalse:[
- "should loop over pages"
-
- vFrame := Rectangle origin:(0@0) corner:(9999 @ 9999).
-
- self objectsIntersecting:vFrame do:[:theObject |
- theObject drawIn:aGC
- ]
- ]
-!
-
redrawObjects
"redraw all objects"
self redrawObjectsOn:self
!
-show:anObject
- "show the object, either selected or not"
-
- (self isSelected:anObject) ifTrue:[
- self showSelected:anObject
- ] ifFalse:[
- self showUnselected:anObject
- ]
-!
-
-showUnselected:anObject
- "show an object as unselected"
-
- anObject drawIn:self
-!
-
-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)
- extent:(aRectangle extent).
-"/ transformation notNil ifTrue:[
- visRect := visRect origin truncated
- corner:(visRect corner + (1@1)) truncated.
-"/ ].
- clipRect notNil ifTrue:[
- visRect := visRect intersect:clipRect
- ].
- self clippedTo:visRect do:[
- self clearRectangle:visRect.
- self redrawObjectsIntersecting:visRect
- ]
- ]
-!
-
-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
- ]
-!
-
-showSelected:anObject
- "show an object as selected"
-
- anObject drawSelectedIn:self
-!
-
redrawObjectsAbove:anObject in:aRectangle
"redraw all objects which have part of themselfes in aRectangle
and are above (in front of) anObject.
@@ -1064,1184 +911,293 @@
self redrawObjectsAbove:anObject intersectingVisible:vis
]
]
-! !
-
-!ObjectView methodsFor:'queries'!
-
-heightOfContents
- "answer the height of the document in pixels"
-
- |h|
-
- h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
- ^ h rounded
-!
-
-widthOfContents
- "answer the width of the document in pixels"
-
- |w|
-
- w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
- ^ w rounded
-!
-
-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
!
-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
-! !
-
-!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
+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
+ ]
!
-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 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:, since this will vanish."
-
- ^ self findObjectAt:aPoint
+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
+ ]
!
-isSelected:anObject
- "return true, if the argument, anObject is in the selection"
-
- selection isNil ifTrue:[^ false].
- (selection == anObject) ifTrue:[^ true].
- selection isCollection ifTrue:[
- ^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
- ].
- ^ false
-!
-
-canMove:something
- "return true, if the argument, anObject or a collection can be moved"
-
- something isCollection ifTrue:[
- self forEach:something do:[:theObject |
- (theObject canBeMoved) ifFalse:[^ false]
+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)
+ extent:(aRectangle extent).
+"/ transformation notNil ifTrue:[
+ visRect := visRect origin truncated
+ corner:(visRect corner + (1@1)) truncated.
+"/ ].
+ clipRect notNil ifTrue:[
+ visRect := visRect intersect:clipRect
].
- ^ true
- ].
- ^ something canBeMoved
-!
-
-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
-!
-
-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 hitDelta.
- contents reverseDo:[:object |
- (object isHitBy:aPoint withDelta:hdelta) ifTrue:[
- (aBlock value:object) ifTrue:[^ object]
+ self clippedTo:visRect do:[
+ self clearRectangle:visRect.
+ self redrawObjectsIntersecting:visRect
]
- ].
- ^ 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.
- This is a leftOver from times when scrolling was not transparent.
- Please use findObjectAt:suchThat:, since this will vanish."
-
- ^ self findObjectAt:aPoint suchThat:aBlock
-! !
-
-!ObjectView methodsFor:'user interface'!
-
-alignToGrid:aPoint
- "round aPoint to the next nearest point on the grid"
-
- aligning ifFalse:[
- ^ aPoint
- ].
-
- ^ (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 findObjectAt: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 findObjectAt: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 findObjectAt: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:'selections'!
-
-unselect
- "unselect - hide selection; clear selection"
-
- self hideSelection.
- selection := nil
-!
-
-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.
- sel notNil ifTrue:[self unselect].
- aBlock value.
- sel notNil ifTrue:[self select:sel]
-!
-
-select:something
- "select something - hide previouse selection, set to something and hilight"
-
- (selection == something) ifFalse:[
- self hideSelection.
- selection := something.
- self showSelection
]
!
-selectionDo:aBlock
- "apply block to every object in selection"
-
- self forEach:selection do:aBlock
-!
-
-hideSelection
- "hide the selection - undraw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showUnselected:object
- ]
-!
-
-showSelection
- "show the selection - draw hilights - whatever that is"
-
- self selectionDo:[:object |
- self showSelected:object
+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:[
+"/ transformation scale ~~ 1 ifTrue:[
+ vis := vis origin truncated
+ corner:(vis corner + (1@1)) truncated.
+"/ ]
+ ].
+
+ self clippedTo:vis do:[
+ self clearRectangle:vis.
+ self redrawObjectsIntersecting:vis
+ ]
]
!
-selectAll
- "select all objects"
-
- self hideSelection.
- selection := contents copy.
- self showSelection
-!
-
-addToSelection:anObject
- "add anObject to the selection"
-
- selection isCollection ifFalse:[
- selection := OrderedCollection with:selection
- ].
- selection add:anObject.
- self showSelected:anObject
-!
-
-removeFromSelection:anObject
- "remove anObject from the selection"
-
- selection isCollection 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.
+redrawObjectsIntersecting:aRectangle
+ "redraw all objects which have part of themself in aRectangle"
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:'initialization'!
-
-setInitialDocumentFormat
- (Smalltalk language == #english) ifTrue:[
- documentFormat := 'letter'.
- scaleMetric := #inch
- ] ifFalse:[
- documentFormat := 'a4'.
- scaleMetric := #mm
- ].
-!
-
-initEvents
-"/ self backingStore:true.
-!
-
-initialize
- super initialize.
-
- viewBackground := White.
-
- bitGravity := #NorthWest.
- contents := OrderedCollection new.
- gridShown := false.
-
- canDragOutOfView := false.
- rootView := DisplayRootView new.
- rootView noClipByChildren.
- rootMotion := false.
- self setInitialDocumentFormat.
-
- leftHandCursor := Cursor leftHand.
- sorted := false.
- aligning := false
-! !
-
-!ObjectView methodsFor:'cut & paste '!
-
-deleteSelection
- "delete the selection into the cut&paste buffer"
-
- |tmp|
-
- tmp := selection.
- self unselect.
- self remove:tmp.
- self setSelection:tmp
-!
-
-pasteBuffer
- "add the objects in the paste-buffer"
-
- |sel|
-
- sel := self getSelection.
- (device getSelectionOwnerOf:(device atomIDOf:'PRIMARY')) == drawableId
- ifTrue:[
- "
- a local selection - paste with some offset
- "
- sel size > 0 ifTrue:[
- sel := sel collect:[:element |
- element copy moveTo:(element origin + (8 @ 8))
- ]
- ] ifFalse:[
- sel := sel copy moveTo:(sel origin + (8 @ 8))
- ]
- ].
- self paste:sel
-!
-
-convertForPaste:anObject
- "return a converted version of anObject to be pasted, or nil if
- the object is not compatible with me.
- Return nil here; concrete subclasses should try to convert.
- Notice: anObject may be a collection of to-be-pasted objects."
-
- "in concrete subclasses, you can use:"
-"
- |s|
-
- (anObject respondsTo:#asDisplayObject) ifTrue:[
- ^ anObject asDisplayObject
- ].
- (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
- ].
- anObject size > 0 ifTrue:[
- (anObject inject:true into:[:okSoFar :element |
- okSoFar and:[element respondsTo:#asDisplayObject]
- ]) ifFalse:[
- self warn:'selection not convertable to DisplayObject'.
- ^ nil
- ].
- ^ anObject collect:[:element | element asDisplayObject].
- ].
-"
- ^ nil.
-!
-
-paste:something
- "add the objects in the cut&paste-buffer"
-
- |s|
-
- self unselect.
- s := self convertForPaste:something .
- s isNil ifTrue:[
- self warn:'selection not convertable'.
- ^ self
- ].
- self addSelected:s
-!
-
-copySelection
- "copy the selection into the cut&paste-buffer"
-
- |tmp|
-
- tmp := OrderedCollection new.
- self selectionDo:[:object |
- tmp add:(object copy)
- ].
-"/ self forEach:tmp do:[:anObject |
-"/ anObject moveTo:(anObject origin + (8 @ 8))
-"/ ].
- self setSelection:tmp
-! !
-
-!ObjectView methodsFor:'adding / removing'!
-
-addWithoutRedraw:something
- "add something, anObject or a collection of objects to the contents
- do not redraw"
-
- self forEach:something do:[:anObject |
- self addObjectWithoutRedraw:anObject
+ self show:theObject
]
!
-addObjectWithoutRedraw:anObject
- "add the argument, anObject to the contents - no redraw"
-
- anObject notNil ifTrue:[
- contents addLast:anObject
- ]
-!
-
-addSelected:something
- "add something, anObject or a collection of objects to the contents
- and select it"
-
- self add:something.
- self select:something
+redrawObjectsIntersectingVisible:aRectangle
+ "redraw all objects which have part of themself in a vis rectangle
+ This is a leftOver from times when scrolling was not transparent.
+ Please use redrawObjectsIntersecting:, since this will vanish."
+
+ self redrawObjectsIntersecting:aRectangle
!
-remove:something
- "remove something, anObject or a collection of objects from the contents
- do redraw"
-
- something size > (contents size / 4) ifTrue:[
- "
- better to remove first, then redraw rest
- "
- self forEach:something do:[:anObject |
- self removeFromSelection:anObject.
- contents remove:anObject.
+redrawObjectsOn:aGC
+ "redraw all objects on a graphic context"
+
+ |vFrame|
+
+ (aGC == self) ifTrue:[
+ shown ifFalse:[^ self].
+ vFrame := Rectangle origin:0@0 corner:(width @ height).
+
+ transformation notNil ifTrue:[
+ vFrame := transformation applyInverseTo:vFrame.
].
- self redraw.
- ^ self
- ].
-
- 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)
+ self redrawObjectsIntersecting:vFrame
+ ] ifFalse:[
+ "should loop over pages"
+
+ vFrame := Rectangle origin:(0@0) corner:(9999 @ 9999).
+
+ self objectsIntersecting:vFrame do:[:theObject |
+ theObject drawIn:aGC
]
]
!
-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
- ]
+redrawScale
+ "redraw the scales"
+
+ self redrawHorizontalScale.
+ self redrawVerticalScale
+!
+
+show:anObject
+ "show the object, either selected or not"
+
+ (self isSelected:anObject) ifTrue:[
+ self showSelected:anObject
+ ] ifFalse:[
+ self showUnselected:anObject
]
!
-add:something
- "add something, anObject or a collection of objects to the contents
- with redraw"
-
+showDragging:something offset:anOffset
+ "show an object while dragging"
+
+ |drawer|
+
+ rootMotion ifTrue:[
+ "drag in root-window"
+
+ drawer := rootView
+ ] ifFalse:[
+ drawer := self
+ ].
self forEach:something do:[:anObject |
- self addObject:anObject
- ]
-!
-
-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
+ anObject drawDragIn:drawer offset:anOffset
]
!
-removeAllWithoutRedraw
- "remove all - no redraw"
-
- selection := nil.
- contents := OrderedCollection new
+showSelected:anObject
+ "show an object as selected"
+
+ anObject drawSelectedIn:self
!
-removeAll
- "remove all - redraw"
-
- self removeAllWithoutRedraw.
- self redraw
+showUnselected:anObject
+ "show an object as unselected"
+
+ anObject drawIn:self
! !
-!ObjectView methodsFor:'layout manipulation'!
-
-moveObject:anObject to:newOrigin
- "move anObject to newOrigin, aPoint"
-
- |oldOrigin oldFrame newFrame
- objectsIntersectingOldFrame objectsIntersectingNewFrame
- wasObscured isObscured intersects
- 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:[
- oldLeft := oldFrame left.
- oldTop := oldFrame top.
- newLeft := newFrame left.
- newTop := newFrame top.
- w := oldFrame width.
- h := oldFrame height.
- ((newLeft < width) and:[newTop < height]) ifTrue:[
- ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
- self catchExpose.
- 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
- ]
- ]
- ]
+!ObjectView methodsFor:'event handling'!
+
+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]
]
- ]
- ].
- isObscured := self isObscured:anObject.
- (oldFrame intersects:newFrame) ifTrue:[
- isObscured ifFalse:[
- self redrawObjectsIn:oldFrame.
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:(oldFrame merge:newFrame)
+ ].
+ movePoint := xpos @ ypos.
+
+ (xpos == (lastButt x)) ifTrue:[
+ (ypos == (lastButt y)) ifTrue:[
+ ^ self "no move"
+ ]
+ ].
+
+ motionAction notNil ifTrue:[
+ motionAction value:movePoint
+ ].
+ lastButt := movePoint
+ ]
+!
+
+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:[
- self redrawObjectsIn:oldFrame.
- isObscured ifFalse:[
- self show: anObject
- ] ifTrue:[
- self redrawObjectsIn:newFrame
- ]
+ super buttonMultiPress:button x:x y:y
]
!
-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
+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
]
!
-moveObject:anObject by:delta
- "change the position of anObject by delta, aPoint"
-
- self moveObject:anObject to:(anObject origin + delta)
-!
-
-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'
+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
+ ]
!
-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'
+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
+ ]
!
-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
+keyPress:key x:x y:y
+ keyPressAction notNil ifTrue:[
+ selection notNil ifTrue:[
+ self selectionDo: [:obj |
+ obj keyInput:key
+ ]
]
]
!
-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:'dragging rectangle'!
-
-setRectangleDragActions
- "setup to drag a rectangle. Call this (for example) from your buttonPress
- method, to make the view start the drag.
- See startRectangleDrag:."
-
- motionAction := [:movePoint | self doRectangleDrag:movePoint].
- releaseAction := [self endRectangleDrag]
-!
-
-endRectangleDrag
- "cleanup after rectangle drag; select them"
-
- self invertDragRectangle.
- self cursor:oldCursor.
- self selectAllIn:dragObject
-!
-
-invertDragRectangle
- "helper for rectangle drag - invert the dragRectangle.
- Extracted into a separate method to allow easier redefinition
- (different lineWidth etc)"
-
- self xoring:[self lineWidth:0. self displayRectangle:dragObject].
-!
-
-startRectangleDrag:startPoint
- "start a rectangle drag"
-
- self setRectangleDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragRectangle.
- oldCursor := cursor.
- self cursor:leftHandCursor
-!
-
-doRectangleDrag:aPoint
- "do drag a rectangle"
-
- self invertDragRectangle.
- dragObject corner:aPoint.
- self invertDragRectangle.
-! !
-
-!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"
-
- |current|
-
- transformation isNil ifTrue:[
- current := 1@1
- ] ifFalse:[
- current := transformation scale
- ].
- factor asPoint = current asPoint ifTrue:[
- ^ self
- ].
- current := factor.
- current isNil ifTrue:[
- current := 1
- ].
-
- (current = 1) ifTrue:[
- transformation := nil
- ] ifFalse:[
- transformation := WindowingTransformation scale:current translation:0.
- ].
- self contentsChanged.
- self setInnerClip.
- gridShown ifTrue:[
- self newGrid
- ].
- shown ifTrue:[
- self clear.
- self redraw
- ].
-!
-
-zoomIn
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation scale:(transformation scale / 2)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self redraw.
-!
-
-zoomOut
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:0
- ].
- transformation := WindowingTransformation scale:(transformation scale * 2)
- translation:0.
- self contentsChanged.
- self setInnerClip.
- self redraw
-!
-
-millimeterMetric
- (scaleMetric ~~ #mm) ifTrue:[
- scaleMetric := #mm.
- self newGrid
- ]
-!
-
-inchMetric
- (scaleMetric ~~ #inch) ifTrue:[
- scaleMetric := #inch.
- self newGrid
+redrawX:x y:y width:w height:h
+ |redrawFrame |
+
+ ((contents size ~~ 0) or:[gridShown]) ifTrue:[
+ redrawFrame := Rectangle left:x top:y
+ width:w height:h.
+ self redrawObjectsInVisible:redrawFrame
]
! !
!ObjectView methodsFor:'grid manipulation'!
-newGrid
- "define a new grid - this is a private helper which has to be
- called after any change in the grid. It (re)creates the gridPixmap,
- clears the view and redraws all visible objects."
-
- gridPixmap := nil.
- shown ifTrue:[
- self viewBackground:White.
- self clear.
- ].
-
- gridShown ifTrue:[
- self defineGrid.
- self viewBackground:gridPixmap.
- ].
- shown ifTrue:[
- self redraw
- ].
+alignOff
+ "do no align point to grid"
+
+ aligning := false
!
-gridParameters
- "used by defineGrid, and in a separate method for
- easier redefinition in subclasses.
- Returns the grid parameters in an array of 7 elements,
- which control the appearance of the grid-pattern.
- the elements are:
-
- 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 (pointer snap)
- gridAlignV number of pixels for vertical grid align (pointer snap)
- docBounds true, if document boundary should be shown
-
- if littleStepH/V are nil, only bigSteps are drawn.
- "
-
- |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.
-
- "
- metric grid: small steps every millimeter, big step every
- centimeter. If the transformation is shrinking, turn off little
- steps.
- "
- (scaleMetric == #mm) ifTrue:[
- "dots every mm; lines every cm"
- bigStepH := mmH * 10.0.
- bigStepV := mmV * 10.0.
- (transformation notNil
- and:[transformation scale <= 0.5]) ifFalse:[
- littleStepH := mmH.
- littleStepV := mmV
- ]
- ].
- "
- inch grid: small steps every 1/8th inch, big step every half inch
- If the transformation is shrinking, change little steps to 1/th inch
- or even turn them off completely.
- "
- (scaleMetric == #inch) ifTrue:[
- "dots every eights inch; lines every half inch"
- bigStepH := mmH * (25.4 / 2).
- bigStepV := mmV * (25.4 / 2).
- (transformation notNil
- and:[transformation scale <= 0.5]) ifTrue:[
- transformation scale > 0.2 ifTrue:[
- littleStepH := mmH * (25.4 / 4).
- littleStepV := mmV * (25.4 / 4)
- ]
- ] ifFalse:[
- 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
+alignOn
+ "align points to grid"
+
+ aligning := true.
+ self getAlignParameters
!
defineGrid
@@ -2380,12 +1336,91 @@
]
!
-showGrid
- "show the grid. The grid is defined by the return value of
- gridParameters, which can be redefined in concrete subclasses."
-
- gridShown := true.
- self newGrid
+getAlignParameters
+ |params|
+
+ params := self gridParameters.
+ gridAlign := (params at:5) @ (params at:6)
+!
+
+gridParameters
+ "used by defineGrid, and in a separate method for
+ easier redefinition in subclasses.
+ Returns the grid parameters in an array of 7 elements,
+ which control the appearance of the grid-pattern.
+ the elements are:
+
+ 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 (pointer snap)
+ gridAlignV number of pixels for vertical grid align (pointer snap)
+ docBounds true, if document boundary should be shown
+
+ if littleStepH/V are nil, only bigSteps are drawn.
+ "
+
+ |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.
+
+ "
+ metric grid: small steps every millimeter, big step every
+ centimeter. If the transformation is shrinking, turn off little
+ steps.
+ "
+ (scaleMetric == #mm) ifTrue:[
+ "dots every mm; lines every cm"
+ bigStepH := mmH * 10.0.
+ bigStepV := mmV * 10.0.
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifFalse:[
+ littleStepH := mmH.
+ littleStepV := mmV
+ ]
+ ].
+ "
+ inch grid: small steps every 1/8th inch, big step every half inch
+ If the transformation is shrinking, change little steps to 1/th inch
+ or even turn them off completely.
+ "
+ (scaleMetric == #inch) ifTrue:[
+ "dots every eights inch; lines every half inch"
+ bigStepH := mmH * (25.4 / 2).
+ bigStepV := mmV * (25.4 / 2).
+ (transformation notNil
+ and:[transformation scale <= 0.5]) ifTrue:[
+ transformation scale > 0.2 ifTrue:[
+ littleStepH := mmH * (25.4 / 4).
+ littleStepV := mmV * (25.4 / 4)
+ ]
+ ] ifFalse:[
+ 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
!
hideGrid
@@ -2395,252 +1430,742 @@
self newGrid
!
-getAlignParameters
- |params|
-
- params := self gridParameters.
- gridAlign := (params at:5) @ (params at:6)
+newGrid
+ "define a new grid - this is a private helper which has to be
+ called after any change in the grid. It (re)creates the gridPixmap,
+ clears the view and redraws all visible objects."
+
+ gridPixmap := nil.
+ shown ifTrue:[
+ self viewBackground:White.
+ self clear.
+ ].
+
+ gridShown ifTrue:[
+ self defineGrid.
+ self viewBackground:gridPixmap.
+ ].
+ shown ifTrue:[
+ self redraw
+ ].
!
-alignOn
- "align points to grid"
-
- aligning := true.
- self getAlignParameters
+showGrid
+ "show the grid. The grid is defined by the return value of
+ gridParameters, which can be redefined in concrete subclasses."
+
+ gridShown := true.
+ self newGrid
+! !
+
+!ObjectView methodsFor:'initialization'!
+
+initEvents
+"/ self backingStore:true.
!
-alignOff
- "do no align point to grid"
-
+initialize
+ super initialize.
+
+ viewBackground := White.
+
+ bitGravity := #NorthWest.
+ contents := OrderedCollection new.
+ gridShown := false.
+
+ canDragOutOfView := false.
+ rootView := DisplayRootView new.
+ rootView noClipByChildren.
+ rootMotion := false.
+ self setInitialDocumentFormat.
+
+ leftHandCursor := Cursor leftHand.
+ sorted := false.
aligning := false
+!
+
+setInitialDocumentFormat
+ (Smalltalk language == #english) ifTrue:[
+ documentFormat := 'letter'.
+ scaleMetric := #inch
+ ] ifFalse:[
+ documentFormat := 'a4'.
+ scaleMetric := #mm
+ ].
! !
-!ObjectView methodsFor:'dragging line'!
-
-setLineDragActions
- "setup to drag a line. Call this (for example) from your buttonPress
- method, to make the view start to drag a line.
- See startLineDrag and startRootLineDrag."
-
- motionAction := [:movePoint | self doLineDrag:movePoint].
- releaseAction := [self endLineDrag]
+!ObjectView methodsFor:'layout manipulation'!
+
+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))
+ ]
+ ]
+!
+
+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)
+ ]
+ ]
+!
+
+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
+ ]
+!
+
+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'
!
-startLineDrag:startPoint
- "start a line drag within the view"
-
- self setLineDragActions.
- dragObject := Rectangle origin:startPoint corner:startPoint.
- self invertDragLine.
- oldCursor := cursor.
- self cursor:leftHandCursor
+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
+ 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:[
+ oldLeft := oldFrame left.
+ oldTop := oldFrame top.
+ newLeft := newFrame left.
+ newTop := newFrame top.
+ w := oldFrame width.
+ h := oldFrame height.
+ ((newLeft < width) and:[newTop < height]) ifTrue:[
+ ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+ self catchExpose.
+ 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
+ ]
+ ]
!
-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
+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)
+ ]
+ ]
+!
+
+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
+ ]
+ ]
+!
+
+selectionAlignBottom
+ "align selected objects at bottom"
+
+ self alignBottom:selection
+!
+
+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
!
-doLineDrag:aPoint
- "do drag a line"
-
- self invertDragLine.
- dragObject corner:aPoint.
- self invertDragLine.
+selectionToBack
+ "bring the selection to back"
+
+ self toBack:selection
+!
+
+selectionToFront
+ "bring the selection to front"
+
+ self toFront:selection
+!
+
+toBack:something
+ "bring the argument, anObject or a collection of objects to back"
+
+ self forEach:something do:[:anObject |
+ self objectToBack:anObject
+ ]
+!
+
+toFront:something
+ "bring the argument, anObject or a collection of objects to front"
+
+ self forEach:something do:[:anObject |
+ self objectToFront:anObject
+ ]
+! !
+
+!ObjectView methodsFor:'misc'!
+
+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
+ ]
+ ]
+!
+
+forEach:aCollection do:aBlock
+ "apply block to every object in a collectioni;
+ (adds a check for non-collection)"
+
+ aCollection isNil ifTrue:[^self].
+ aCollection isCollection ifTrue:[
+ aCollection do:[:object |
+ object notNil ifTrue:[
+ aBlock value:object
+ ]
+ ]
+ ] ifFalse: [
+ aBlock value:aCollection
+ ]
!
-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."
-
- |rootPoint viewId offs
- lastViewId destinationId destinationView destinationPoint inMySelf|
-
- self invertDragLine.
-
- self cursor:oldCursor.
-
- "check if line drag is into another view"
- rootMotion ifTrue:[
- rootPoint := lastButt.
- "
- get device coordinates
- "
-"/ 'logical ' print. rootPoint printNL.
- transformation notNil ifTrue:[
- rootPoint := transformation applyTo:rootPoint.
-"/ 'device ' print. rootPoint printNL.
+hitDelta
+ "when clicking an object, allow for hitDelta pixels around object.
+ We compensate for any scaling here, to get a constant physical
+ hitDelta (i.e. the value returned here is inverse scaled)."
+
+ |delta|
+
+ delta := self class hitDelta.
+ transformation notNil ifTrue:[
+ delta := delta / transformation scale x
+ ].
+ ^ delta
+!
+
+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
+!
+
+numberOfObjectsIntersectingVisible:aRectangle
+ "answer the number of objects intersecting the argument, aRectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use numberOfObjectsIntersecting:, since this will vanish."
+
+ ^ self numberOfObjectsIntersecting:aRectangle
+!
+
+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
+ ]
+ ]
+!
+
+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
+!
+
+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]
+ ]
].
- "
- translate to screen
+ ^ 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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIn:do:, since this will vanish."
+
+ self objectsIn:aRectangle 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
+!
+
+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 }"|
+
+ nObjects := contents size.
+ (nObjects == 0) ifTrue:[^ self].
+
+ sorted ifFalse:[
"
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
-"/ 'offs' print. offs printNL.
- rootPoint := rootPoint + offs.
-"/ 'screen ' print. rootPoint printNL.
-
-"/ 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
+ have to check every object
+ "
+ contents do:[:theObject |
+ (theObject frame intersects:aRectangle) ifTrue:[
+ aBlock value:theObject
+ ]
].
- destinationView := device viewFromId:lastViewId.
- destinationId := lastViewId.
- inMySelf := (destinationView == self).
- rootMotion := false
+ ^ self
+ ].
+
+ "
+ contents is sorted by y; can do a fast (binary) search for the first
+ object which intersects aRectangle and
+ break from the draw loop, when the 1st object below aRectangle is reached.
+ "
+ bot := aRectangle bottom.
+ top := aRectangle top.
+
+ "
+ binary search for 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:[
- inMySelf := true
+ [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
].
- inMySelf ifTrue:[
- "a simple line within myself"
- self lineDragFrom:dragObject origin to:dragObject corner
- ] ifFalse:[
- "into another one"
- destinationView notNil ifTrue:[
- destinationPoint := device translatePoint:rootPoint
- from:(rootView id)
- to:(destinationView id).
- destinationView transformation notNil ifTrue:[
- destinationPoint := destinationView transformation applyInverseTo:destinationPoint
- ].
- "
- move into another smalltalk view
- "
- self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
+ firstIndex to:nObjects do:[:index |
+ theObject := contents at:index.
+ f := theObject frame.
+ (f intersects:aRectangle) ifTrue:[
+ aBlock value:theObject
] ifFalse:[
- "
- not one of my views
- "
- self lineDragFrom:dragObject origin
- to:destinationPoint
- inAlienViewId:destinationId
- ]
+ (f top > bot) ifTrue:[^ self]
+ ]
+ ]
+!
+
+objectsIntersectingVisible:aRectangle
+ "answer a Collection of objects intersecting a visible aRectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIntersecting:, since this will vanish."
+
+ ^ self objectsIntersecting:aRectangle
+!
+
+objectsIntersectingVisible:aRectangle do:aBlock
+ "do something to every object which intersects a visible rectangle.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use objectsIntersecting:do:, since this will vanish."
+
+ self objectsIntersecting:aRectangle do:aBlock
+!
+
+rectangleForScroll
+ "find the area occupied by visible objects"
+
+ |left right top bottom frame oLeft oRight oTop oBottom|
+
+ left := 9999.
+ right := 0.
+ top := 9999.
+ bottom := 0.
+ self visibleObjectsDo:[:anObject |
+ frame := anObject frame.
+ oLeft := frame left.
+ oRight := frame right.
+ oTop := frame top.
+ oBottom := frame bottom.
+ (oLeft < left) ifTrue:[left := oLeft].
+ (oRight > right) ifTrue:[right := oRight].
+ (oTop < top) ifTrue:[top := oTop].
+ (oBottom > bottom) ifTrue:[bottom := oBottom]
].
- self setDefaultActions.
- dragObject := nil
+ (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
+!
+
+setDefaultActions
+ motionAction := [:movePoint | nil].
+ releaseAction := [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'
+visibleObjectsDo:aBlock
+ "do something to every visible object"
+
+ |absRect|
+
+ absRect := Rectangle left:0 top:0 width:width height:height.
+ self objectsIntersecting:absRect do:aBlock
+! !
+
+!ObjectView methodsFor:'queries'!
+
+heightOfContents
+ "answer the height of the document in pixels"
+
+ |h|
+
+ h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
+ ^ h rounded
!
-invertDragLine
- "helper for line dragging - invert the dragged line.
- Extracted for easier redefinition in subclasses
- (different line width etc.)"
-
- |dragger offs p1 p2|
-
- p1 := dragObject origin.
- p2 := dragObject corner.
- rootMotion ifTrue:[
- dragger := rootView.
- "
- get device coordinates
- "
-"/ 'logical ' print. p1 print. ' ' print. p2 printNL.
- transformation notNil ifTrue:[
- p1 := transformation applyTo:p1.
- p2 := transformation applyTo:p2.
-"/ 'device ' print. p1 print. ' ' print. p2 printNL.
- ].
- "
- translate to screen
- "
- offs := device translatePoint:0@0 from:(self id) to:(rootView id).
-"/ 'offs' print. offs printNL.
- p1 := p1 + offs.
- p2 := p2 + offs.
-"/ 'screen ' print. p1 print. ' ' print. p2 printNL.
- ] ifFalse:[
- dragger := self.
+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
].
-
- dragger xoring:[
- dragger lineWidth:0.
- dragger displayLineFrom:p1 to:p2.
- dragger device flush
+ "*** 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).
+ ^ w 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
! !
!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
- ]
-!
-
-storeBinaryContentsOn:aStream
- "store the contents in binary representation on aStream."
-
- aStream binary.
- self topView withCursor:Cursor write do:[
- self forEach:contents do:[:theObject |
- theObject storeBinaryOn:aStream.
- ].
- ]
-!
-
-withoutRedrawFileInContentsFrom:aStream
- "remove all objects, load new contents from aStream without any redraw"
-
- self fileInContentsFrom:aStream redraw:false new:true binary:false
-!
-
fileInContentsFrom:aStream
"remove all objects, load new contents from aStream and redraw"
@@ -2703,4 +2228,479 @@
self redraw
]
]
+!
+
+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
+!
+
+storeBinaryContentsOn:aStream
+ "store the contents in binary representation on aStream."
+
+ aStream binary.
+ self topView withCursor:Cursor write do:[
+ self forEach:contents do:[:theObject |
+ theObject storeBinaryOn:aStream.
+ ].
+ ]
+!
+
+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
+ "remove all objects, load new contents from aStream without any redraw"
+
+ self fileInContentsFrom:aStream redraw:false new:true binary:false
! !
+
+!ObjectView methodsFor:'scrolling'!
+
+horizontalScrollStep
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
+
+ scaleMetric == #inch ifTrue:[
+ ^ (device horizontalPixelPerInch * (1/2)) asInteger
+ ].
+ ^ (device horizontalPixelPerMillimeter * 20) asInteger
+!
+
+verticalScrollStep
+ "return the amount to scroll when stepping left/right.
+ Redefined to scroll by inches or centimeters."
+
+ scaleMetric == #inch ifTrue:[
+ ^ (device verticalPixelPerInch * (1/2)) asInteger
+ ].
+ ^ (device verticalPixelPerMillimeter * 20) asInteger
+! !
+
+!ObjectView methodsFor:'selections'!
+
+addToSelection:anObject
+ "add anObject to the selection"
+
+ selection isCollection ifFalse:[
+ selection := OrderedCollection with:selection
+ ].
+ selection add:anObject.
+ self showSelected:anObject
+!
+
+hideSelection
+ "hide the selection - undraw hilights - whatever that is"
+
+ self selectionDo:[:object |
+ self showUnselected:object
+ ]
+!
+
+removeFromSelection:anObject
+ "remove anObject from the selection"
+
+ selection isCollection ifTrue:[
+ selection remove:anObject ifAbsent:[nil].
+ (selection size == 1) ifTrue:[
+ selection := selection first
+ ]
+ ] ifFalse:[
+ (selection == anObject) ifTrue:[
+ selection := nil
+ ]
+ ].
+ self showUnselected:anObject
+!
+
+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 copy.
+ 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
+!
+
+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
+!
+
+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
+ ]
+!
+
+unselect
+ "unselect - hide selection; clear selection"
+
+ self hideSelection.
+ selection := nil
+!
+
+withSelectionHiddenDo:aBlock
+ "evaluate aBlock while selection is hidden"
+
+ |sel|
+
+ sel := selection.
+ sel notNil ifTrue:[self unselect].
+ aBlock value.
+ sel notNil ifTrue:[self select:sel]
+! !
+
+!ObjectView methodsFor:'testing objects'!
+
+canMove:something
+ "return true, if the argument, anObject or a collection can be moved"
+
+ something isCollection ifTrue:[
+ self forEach:something do:[:theObject |
+ (theObject canBeMoved) ifFalse:[^ false]
+ ].
+ ^ true
+ ].
+ ^ something canBeMoved
+!
+
+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 hitDelta.
+ contents reverseDo:[:object |
+ (object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
+ ].
+ ^ nil
+!
+
+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 hitDelta.
+ contents reverseDo:[:object |
+ (object isHitBy:aPoint withDelta:hdelta) ifTrue:[
+ (aBlock value:object) 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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use findObjectAt:, since this will vanish."
+
+ ^ self findObjectAt:aPoint
+!
+
+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.
+ This is a leftOver from times when scrolling was not transparent.
+ Please use findObjectAt:suchThat:, since this will vanish."
+
+ ^ self findObjectAt:aPoint 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
+!
+
+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
+!
+
+isSelected:anObject
+ "return true, if the argument, anObject is in the selection"
+
+ selection isNil ifTrue:[^ false].
+ (selection == anObject) ifTrue:[^ true].
+ selection isCollection 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:'user interface'!
+
+alignToGrid:aPoint
+ "round aPoint to the next nearest point on the grid"
+
+ aligning ifFalse:[
+ ^ aPoint
+ ].
+
+ ^ (aPoint grid:gridAlign) rounded
+!
+
+selectMore:aPoint
+ "add/remove an object from the selection"
+
+ |anObject|
+
+ anObject := self findObjectAt: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 findObjectAt: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
+!
+
+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 findObjectAt: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
+! !
+
+!ObjectView methodsFor:'view manipulation'!
+
+inchMetric
+ (scaleMetric ~~ #inch) ifTrue:[
+ scaleMetric := #inch.
+ self newGrid
+ ]
+!
+
+millimeterMetric
+ (scaleMetric ~~ #mm) ifTrue:[
+ scaleMetric := #mm.
+ self newGrid
+ ]
+!
+
+zoom:factor
+ "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
+ 0.5 is shrink by 2"
+
+ |current|
+
+ transformation isNil ifTrue:[
+ current := 1@1
+ ] ifFalse:[
+ current := transformation scale
+ ].
+ factor asPoint = current asPoint ifTrue:[
+ ^ self
+ ].
+ current := factor.
+ current isNil ifTrue:[
+ current := 1
+ ].
+
+ (current = 1) ifTrue:[
+ transformation := nil
+ ] ifFalse:[
+ transformation := WindowingTransformation scale:current translation:0.
+ ].
+ self contentsChanged.
+ self setInnerClip.
+ gridShown ifTrue:[
+ self newGrid
+ ].
+ shown ifTrue:[
+ self clear.
+ self redraw
+ ].
+!
+
+zoomIn
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale / 2)
+ translation:0.
+ self contentsChanged.
+ self setInnerClip.
+ self redraw.
+!
+
+zoomOut
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:0
+ ].
+ transformation := WindowingTransformation scale:(transformation scale * 2)
+ translation:0.
+ self contentsChanged.
+ self setInnerClip.
+ self redraw
+! !
+
+!ObjectView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.29 1995-11-27 22:28:58 cg Exp $'
+! !