"

 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.

"

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.

"

!

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:'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

    ]

!

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

	]

    ]

!

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

    ]

!

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

    ]

!

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)

	]

    ]

!

removeObjectWithoutRedraw:anObject

    "remove the argument, anObject from the contents - no redraw"

    anObject notNil ifTrue:[

	self removeFromSelection:anObject.

	contents remove: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

    ]

! !

!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

!

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))

	]

    ].

    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.

	].

	"

	 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:[