"

 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 class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

    ^ '$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.27 1995-11-11 16:21:48 cg 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