.
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
'From Smalltalk/X, Version:2.10.4 on 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'
classVariableNames:''
poolDictionaries:''
category:'Views-Basic'
!
ObjectView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
'!
!ObjectView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.25 1995-05-06 14:17:35 claus Exp $
"
!
documentation
"
a View which can hold DisplayObjects, can make selections, move them around etc.
this is an abstract class providing common mechanisms - actual instances are
DrawView, DirectoryView, LogicView or DocumentView.
Instance variables:
contents <Collection> the objects. The order in which
these are in that collection defines
their appearance in the z-plane:
an object located after another one
here will be drawn ABOVE the other.
sorted <Boolean> if set, redraw and picking methods
assume that the objects are sorted by
>= y-coordinates. These operations are
a bit faster then, since a binary search
can be done. (use with care).
lastButt <Point> last pointer press position
(internal)
pressAction <Block> action to perform when mouse pointer
is pressed. Can be set to something like
[self startCreate], [self startSelectOrMove]
etc.
releaseAction <Block> action to perform when mouse pointer is
released. Typically set in one of the
startXXX methods.
shiftPressAction <Block> like pressAction, if shift key is
pressed.
doublePressAction <Block> same for double-clicks
motionAction <Block> action to perform on mouse-pointer
motion.
keyPressAction <Block> action for keyboard events
selection <any> the current selection; either a single
object or a collection of objects.
gridShown <Boolean> internal
gridPixmap <Form> internal
scaleMetric <Symbol> either #mm or #inch; used to
decide how the grid is defined
dragObject internal
leftHandCursor cursor shown while dragging a rectangle
oldCursor saved original cursor while dragging a rectangle
movedObject internal
moveStartPoint internal
moveDelta internal
documentFormat <Symbol> defines the size and layout of the
document. Can be any of
#letter, #a4, #a3 etc.
canDragOutOfView <Boolean> if true, objects can be dragged out of the
view. If false, dragging is restricted to within
this view.
rootMotion internal
rootView internal
aligning <Boolean> if true, pointer positions are
aligned (snapped) to the point
specified in gridAlign
gridAlign <Point> if aligning is true, this point
defines the snapping. For example,
12@12 defines snap to the nearest
12-point grid.
written spring/summer 89 by claus
"
!
examples
"
typically, ObjectViews are not used on their own, but instead
subclassed and thereby provide the common functionality for
views which show (possibly overlapping) objects.
The methods here provide all mechanisms to handle redraws, picking
(i.e. finding an object by position), gridding, moving objects with
minimum redraw etc.
Also, zooming and scrolling is handled.
All objects which respond to the DisplayObject protocol can be handled
by ObjectView - therefore, you can add almost any object and have it
displayed and handled here. (as an example, try to copy a LogicGate
from a LogicView and paste it into a DrawTool - it will work).
Reminder: ObjectViews are not to be used as below, but instead to be
subclassed. Therefore, the examples below are somewhat untypical.
simple example:
|v o|
v := ObjectView new.
v extent:200@200.
o := DrawRectangle new.
o origin:10@10 corner:100@100.
v add:o.
o := DrawText new.
o text:'hello there'; origin:50@50; foreground:Color red.
v add:o.
v open
add scrolling:
|v top o|
top := HVScrollableView for:ObjectView.
top extent:200@200.
v := top scrolledView.
o := DrawRectangle new.
o origin:10@10 corner:100@100.
v add:o.
o := DrawText new.
o text:'hello there'; origin:50@50; foreground:Color red.
v add:o.
top open
or, using miniscrollers:
|v top o|
top := HVScrollableView for:ObjectView
miniScrollerH:true miniScrollerV:true.
top extent:200@200.
v := top scrolledView.
o := DrawRectangle new.
o origin:10@10 corner:100@100.
v add:o.
o := DrawText new.
o text:'hello there'; origin:50@50; foreground:Color red.
v add:o.
top open
grid:
|v top o|
top := HVScrollableView for:ObjectView
miniScrollerH:true miniScrollerV:true.
top extent:200@200.
v := top scrolledView.
v showGrid.
o := DrawRectangle new.
o origin:10@10 corner:100@100.
v add:o.
o := DrawText new.
o text:'hello there'; origin:50@50; foreground:Color red.
v add:o.
top open
"
! !
!ObjectView class methodsFor:'defaults'!
hitDelta
"when clicking an object, allow for hitDelta pixels around object;
0 is exact; 1*pixelPerMillimeter is good for draw programs"
^ 0
! !
!ObjectView methodsFor:'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
!
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]
]
]
!
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
]
!
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]
]
].
^ self
].
contents do:[:theObject |
(theObject isContainedIn:aRectangle) ifTrue:[
aBlock value:theObject
]
]
!
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
]
]
!
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
]
]
!
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
! !
!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
]
!
buttonPress:button x:x y:y
"user pressed left button"
((button == 1) or:[button == #select]) ifTrue:[
pressAction notNil ifTrue:[
lastButt := x @ y.
pressAction value:lastButt
]
] ifFalse:[
super buttonPress:button x:x y:y
]
!
buttonRelease:button x:x y:y
((button == 1) or:[button == #select]) ifTrue:[
releaseAction notNil ifTrue:[releaseAction value]
] ifFalse:[
super buttonRelease:button x:x y:y
]
!
buttonMotion:buttonMask x:buttX y:buttY
"user moved mouse while button pressed"
|xpos ypos movePoint limitW limitH|
"is it the select or 1-button ?"
(device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
(device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
^ self
].
].
lastButt notNil ifTrue:[
xpos := buttX.
ypos := buttY.
"check against visible limits if move outside is not allowed"
rootMotion ifFalse:[
limitW := width.
limitH := height.
transformation notNil ifTrue:[
limitW := transformation applyInverseToX:width.
limitH := transformation applyInverseToY:height.
].
(xpos < 0) ifTrue:[
xpos := 0
] ifFalse: [
(xpos > limitW) ifTrue:[xpos := limitW]
].
(ypos < 0) ifTrue:[
ypos := 0
] ifFalse: [
(ypos > limitH) ifTrue:[ypos := limitH]
]
].
movePoint := xpos @ ypos.
(xpos == (lastButt x)) ifTrue:[
(ypos == (lastButt y)) ifTrue:[
^ self "no move"
]
].
motionAction notNil ifTrue:[
motionAction value:movePoint
].
lastButt := movePoint
]
!
buttonMultiPress:button x:x y:y
"user pressed left button twice (or more)"
((button == 1) or:[button == #select]) ifTrue:[
doublePressAction notNil ifTrue:[
doublePressAction value:(x @ y)
]
] ifFalse:[
super buttonMultiPress:button x:x y:y
]
!
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
]
!
keyPress:key x:x y:y
keyPressAction notNil ifTrue:[
selection notNil ifTrue:[
self selectionDo: [:obj |
obj keyInput:key
]
]
]
! !
!ObjectView methodsFor:'dragging object move'!
doObjectMove:aPoint
"do an object move - this is called for every motion
when moving objects."
|d org nOrg|
movedObject isNil ifTrue:[
movedObject := selection.
"
draw first outline
"
movedObject notNil ifTrue:[
moveDelta := 0@0.
"tricky, the moved object may not currently be aligned.
if so, simulate a frame move of the delta"
aligningMove ifTrue:[
org := movedObject origin.
d := org - (self alignToGrid:(org)).
moveDelta := d negated.
].
self invertDragObject:movedObject delta:moveDelta
]
].
movedObject notNil ifTrue:[
d := aPoint - moveStartPoint.
aligningMove ifTrue:[
org := movedObject origin.
nOrg := org + d.
d := (self alignToGrid:(nOrg)) - org.
].
d ~= moveDelta ifTrue:[
"
clear prev outline,
draw new outline
"
self invertDragObject:movedObject delta:moveDelta.
moveDelta := d.
self invertDragObject:movedObject delta:moveDelta
]
]
!
endObjectMove
"cleanup after object move - called when the object move ends.
Find the destination view and position and dispatch to
one of the moveObjectXXX-methods which should do the real move.
These can be redefined in subclasses."
|inMySelf rootPoint destinationPoint p
viewId destinationView destinationId lastViewId|
movedObject notNil ifTrue:[
self invertDragObject:movedObject delta:moveDelta.
"check if object is to be put into another view"
rootMotion ifTrue:[
p := lastButt.
"
get device coordinates
"
transformation notNil ifTrue:[
p := transformation applyTo:p.
].
"
translate to screen
"
rootPoint := p + (device translatePoint:0@0 from:(self id) to:(rootView id)).
"search view the drop is in"
viewId := rootView id.
[viewId notNil] whileTrue:[
destinationId := device viewIdFromPoint:rootPoint in:viewId.
lastViewId := viewId.
viewId := destinationId
].
destinationView := device viewFromId:lastViewId.
destinationId := lastViewId.
inMySelf := (destinationView == self).
rootMotion := false
] ifFalse:[
inMySelf := true
].
inMySelf ifTrue:[
"simple move"
self move:movedObject by:moveDelta
] ifFalse:[
destinationPoint := device translatePoint:rootPoint
from:(rootView id)
to:destinationId.
destinationView notNil ifTrue:[
destinationView transformation notNil ifTrue:[
destinationPoint := destinationView transformation applyInverseTo:destinationPoint
].
"
move into another smalltalk view
"
self move:movedObject to:destinationPoint in:destinationView
] ifFalse:[
"
not one of my views
"
self move:movedObject to:destinationPoint inAlienViewId:destinationId
]
].
self setDefaultActions.
movedObject := nil
]
!
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"
|dragger offs p d scale oldTrans|
rootMotion ifTrue:[
p := movedObject origin + moveDelta.
dragger := rootView.
"
get device coordinates
"
"/ 'logical ' print. p printNL.
transformation notNil ifTrue:[
scale := transformation scale.
p := transformation applyTo:p.
"/ 'device ' print. p printNL.
].
"
translate to screen
"
offs := device translatePoint:0@0 from:(self id) to:(rootView id).
"/ 'offs' print. offs printNL.
p := p + offs.
"/ 'screen ' print. p printNL.
"
p is where we want it ...
have to adust slightly, since showDragging shows the object
at its origin plus some offset; here we want it to be drawn
at absolute p.
To do so, we set the draggers translation to p and
draw the object scaled at 0@0 (by setting offset to its negative org)
"
oldTrans := dragger transformation.
dragger transformation:(WindowingTransformation
scale:scale
translation:p).
d := movedObject origin negated.
dragger xoring:[
self showDragging:movedObject offset:d.
].
dragger transformation:oldTrans.
dragger device synchronizeOutput.
] ifFalse:[
self xoring:[
self showDragging:movedObject offset:moveDelta.
].
self device synchronizeOutput
].
! !
!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"
shown ifTrue:[
self clear.
self redrawObjects
]
!
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:(width @ height).
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.
draw only in (i.e. clip output to) aRectangle"
|vis|
shown ifTrue:[
vis := aRectangle.
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
self clippedTo:vis do:[
self redrawObjectsAbove:anObject intersecting:vis
]
]
!
redrawObjectsAbove:anObject inVisible:aRectangle
"redraw all objects which have part of themselfes in a vis rectangle
and are above (in front of) anObject.
draw only in (i.e. clip output to) aRectangle"
|vis|
shown ifTrue:[
vis := aRectangle.
clipRect notNil ifTrue:[
vis := vis intersect:clipRect
].
self clippedTo:vis do:[
self redrawObjectsAbove:anObject intersectingVisible:vis
]
]
! !
!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
!
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
!
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]
].
^ 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]
]
].
^ 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.
self unselect.
aBlock value.
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
]
!
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.
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
]
!
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
!
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
].
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)
]
]
!
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
]
]
!
add:something
"add something, anObject or a collection of objects to the contents
with redraw"
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
]
!
removeAllWithoutRedraw
"remove all - no redraw"
selection := nil.
contents := OrderedCollection new
!
removeAll
"remove all - redraw"
self removeAllWithoutRedraw.
self redraw
! !
!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
]
]
]
]
]
].
isObscured := self isObscured:anObject.
(oldFrame intersects:newFrame) ifTrue:[
isObscured ifFalse:[
self redrawObjectsIn:oldFrame.
self show: anObject
] ifTrue:[
self redrawObjectsIn:(oldFrame merge:newFrame)
]
] ifFalse:[
self redrawObjectsIn:oldFrame.
isObscured ifFalse:[
self show: anObject
] ifTrue:[
self redrawObjectsIn:newFrame
]
]
!
move:something by:delta
"change the position of something, an Object or Collection
by delta, aPoint"
(delta x == 0) ifTrue:[
(delta y == 0) ifTrue:[^ self]
].
self forEach:something do:[:anObject |
self moveObject:anObject by:delta
]
!
moveObject:anObject by:delta
"change the position of anObject by delta, aPoint"
self moveObject:anObject to:(anObject origin + delta)
!
move:something to:aPoint in:aView
"can only happen when dragOutOfView is true
- should be redefined in subclasses"
self notify:'cannot move object(s) out of view'
!
move:something to:aPoint inAlienViewId:aViewId
"can only happen when dragOutOfView is true
- should be redefined in subclasses"
self notify:'cannot move object(s) to alien views'
!
objectToFront:anObject
"bring the argument, anObject to front"
|wasObscured|
anObject notNil ifTrue:[
wasObscured := self isObscured:anObject.
contents remove:anObject.
contents addLast:anObject.
wasObscured ifTrue:[
"old:
self redrawObjectsIn:(anObject frame)
"
self hideSelection.
self show:anObject.
self showSelection
]
]
!
toFront:something
"bring the argument, anObject or a collection of objects to front"
self forEach:something do:[:anObject |
self objectToFront:anObject
]
!
selectionToFront
"bring the selection to front"
self toFront:selection
!
objectToBack:anObject
"bring the argument, anObject to back"
anObject notNil ifTrue:[
contents remove:anObject.
contents addFirst:anObject.
(self isObscured:anObject) ifTrue:[
self redrawObjectsIn:(anObject frame)
]
]
!
toBack:something
"bring the argument, anObject or a collection of objects to back"
self forEach:something do:[:anObject |
self objectToBack:anObject
]
!
selectionToBack
"bring the selection to back"
self toBack:selection
!
alignLeft:something
|leftMost|
leftMost := 999999.
self forEach:something do:[:anObject |
leftMost := leftMost min:(anObject frame left)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(leftMost @ (anObject frame top))
]
]
!
alignRight:something
|rightMost|
rightMost := -999999.
self forEach:something do:[:anObject |
rightMost := rightMost max:(anObject frame right)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(rightMost - (anObject frame width))
@ (anObject frame top)
]
]
!
alignTop:something
|topMost|
topMost := 999999.
self forEach:something do:[:anObject |
topMost := topMost min:(anObject frame top)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:((anObject frame left) @ topMost)
]
]
!
alignBottom:something
|botMost|
botMost := -999999.
self forEach:something do:[:anObject |
botMost := botMost max:(anObject frame bottom)
].
self withSelectionHiddenDo:[
self forEach:something do:[:anObject |
self moveObject:anObject to:(anObject frame left)
@
(botMost - (anObject frame height))
]
]
!
selectionAlignLeft
"align selected objects left"
self alignLeft:selection
!
selectionAlignRight
"align selected objects right"
self alignRight:selection
!
selectionAlignTop
"align selected objects at top"
self alignTop:selection
!
selectionAlignBottom
"align selected objects at bottom"
self alignBottom:selection
! !
!ObjectView methodsFor:'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
]
! !
!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
].
!
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
!
defineGrid
"define the grid pattern - this creates the gridPixmap, which is
used as viewBackground when a grid is to be shown.
The grid is specified by the value returned from gridParameters,
which can be redefined in subclasses. See the comment there on how
the numbers are interpreted."
|mmH mmV params showDocumentBoundary gridW gridH
bigStepH bigStepV littleStepH littleStepV hires|
mmH := self horizontalPixelPerMillimeter.
mmV := self verticalPixelPerMillimeter.
hires := self horizontalPixelPerInch > 120.
gridW := (self widthOfContentsInMM * mmH).
gridH := (self heightOfContentsInMM * mmV).
params := self gridParameters.
bigStepH := params at:1.
bigStepV := params at:2.
littleStepH := params at:3.
littleStepV := params at:4.
showDocumentBoundary := params at:7.
transformation notNil ifTrue:[
mmH := mmH * transformation scale x.
mmV := mmV * transformation scale y.
bigStepH := bigStepH * transformation scale x.
bigStepV := bigStepV * transformation scale y.
littleStepH notNil ifTrue:[
littleStepH := littleStepH * transformation scale x.
].
littleStepV notNil ifTrue:[
littleStepV := littleStepV * transformation scale y.
].
].
bigStepH isNil ifTrue:[^ self].
self withCursor:(Cursor wait) do:[
|xp yp y x|
"
up to next full unit
"
gridW := ((gridW // bigStepH) + 1 * bigStepH) asInteger.
gridH := ((gridH // bigStepV) + 1 * bigStepV) asInteger.
gridPixmap := Form width:gridW height:gridH depth:1.
gridPixmap colorMap:(Array with:White with:Black).
gridPixmap clear.
gridPixmap paint:(Color colorId:1).
"draw first row point-by-point"
yp := 0.0.
xp := 0.0.
y := yp asInteger.
[xp <= gridW] whileTrue:[
x := xp rounded.
hires ifTrue:[
gridPixmap displayPointX:(x + 1) y:y.
gridPixmap displayPointX:(x + 2) y:y
].
gridPixmap displayPointX:x y:y.
littleStepH notNil ifTrue:[
xp := xp + littleStepH
] ifFalse:[
xp := xp + bigStepH
]
].
"copy rest from what has been drawn already"
yp := yp + bigStepV.
[yp <= gridH] whileTrue:[
y := yp rounded.
hires ifTrue:[
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:(y + 1)
width:gridW height:1.
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:(y + 2)
width:gridW height:1
].
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:0 y:y
width:gridW height:1.
yp := yp + bigStepV
].
"draw first col point-by-point"
xp := 0.0.
yp := 0.0.
x := xp asInteger.
[yp <= gridH] whileTrue:[
y := yp rounded.
hires ifTrue:[
gridPixmap displayPointX:x y:(y + 1).
gridPixmap displayPointX:x y:(y + 2)
].
gridPixmap displayPointX:x y:y.
littleStepV notNil ifTrue:[
yp := yp + littleStepV
] ifFalse:[
yp := yp + bigStepV
]
].
"copy rest from what has been drawn already"
xp := xp + bigStepH.
[xp <= gridW] whileTrue:[
x := xp rounded.
hires ifTrue:[
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:(x + 1) y:0
width:1 height:gridH.
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:(x + 2) y:0
width:1 height:gridH
].
gridPixmap copyFrom:gridPixmap x:0 y:0
toX:x y:0
width:1 height:gridH.
xp := xp + bigStepH
].
showDocumentBoundary ifTrue:[
"
mark the right-end and bottom of the document
"
gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
].
]
!
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
!
hideGrid
"hide the grid"
gridShown := false.
self newGrid
!
getAlignParameters
|params|
params := self gridParameters.
gridAlign := (params at:5) @ (params at:6)
!
alignOn
"align points to grid"
aligning := true.
self getAlignParameters
!
alignOff
"do no align point to grid"
aligning := false
! !
!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]
!
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
!
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.
].
"
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
].
destinationView := device viewFromId:lastViewId.
destinationId := lastViewId.
inMySelf := (destinationView == self).
rootMotion := false
] ifFalse:[
inMySelf := true
].
inMySelf ifTrue:[
"a simple line within myself"
self lineDragFrom:dragObject origin to:dragObject corner
] ifFalse:[
"into another one"
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
!
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
"this is called after a line-drag with rootmotion set
to true, IFF the endpoint is in an alien view
- should be redefined in subclasses"
self notify:'cannot connect object in alien view'
!
lineDragFrom:startPoint to:endPoint
"this is called after a line-drag. Nothing is done here.
- should be redefined in subclasses"
^ self
!
lineDragFrom:startPoint to:endPoint in:destinationView
"this is called after a line-drag crossing view boundaries.
- should be redefined in subclasses"
^ self notify:'dont know how to connect to external views'
!
invertDragLine
"helper for line dragging - invert the dragged line.
Extracted for easier redefinition in subclasses
(different line width etc.)"
|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.
].
dragger xoring:[
dragger lineWidth:0.
dragger displayLineFrom:p1 to:p2.
dragger device synchronizeOutput
].
! !
!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"
self fileInContentsFrom:aStream redraw:true new:true binary:false
!
fileInContentsFrom:aStream redraw:redraw
"remove all objects, load new contents from aStream
and redraw if the redraw argument is true"
self fileInContentsFrom:aStream redraw:redraw new:true binary:false
!
fileInContentsFrom:aStream redraw:redraw new:new
"remove all objects, load new contents from aStream
and redraw if the redraw argument is true"
self fileInContentsFrom:aStream redraw:redraw new:new binary:false
!
fileInContentsFrom:aStream redraw:redraw new:new binary:binary
"if the new argument is true, remove all objects.
Then load objects from aStream. If redraw is false, no redraw
is done
(allows fileIn of multiple files doing a single redraw at the end)."
binary ifTrue:[
aStream binary
].
self topView withCursor:(Cursor read) do:[
|newObject chunk individualRedraw|
self unselect.
individualRedraw := redraw.
new ifTrue:[
self removeAll.
individualRedraw := false.
].
[aStream atEnd] whileFalse:[
binary ifTrue:[
newObject := Object readBinaryFrom:aStream
] ifFalse:[
chunk := aStream nextChunk.
(chunk notNil and:[chunk isEmpty not]) ifTrue:[
newObject := Compiler evaluate:chunk.
] ifFalse:[
newObject := nil
]
].
newObject notNil ifTrue:[
self initializeFileInObject:newObject.
individualRedraw ifFalse:[
self addObjectWithoutRedraw:newObject
] ifTrue:[
self addObject:newObject
]
]
].
(new and:[redraw]) ifTrue:[
self redraw
]
]
! !