"

 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.

"

"{ Package: 'stx:libwidg' }"

"{ NameSpace: Smalltalk }"

View subclass:#ObjectView

	instanceVariableNames:'contents sorted lastButt pressAction releaseAction

		shiftPressAction ctrlPressAction doublePressAction motionAction

		keyPressAction selection gridShown gridPixmap scaleMetric

		dragObject leftHandCursor oldCursor movedObject moveStartPoint

		moveDelta documentFormat canDragOutOfView rootMotion rootView

		aligning gridAlign aligningMove inMotion buttonPressTime'

	classVariableNames:'MIN_DELTA_FOR_MOVE TIME_DELTA_FOR_MOVE'

	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.

    ObjectView is an abstract class providing common mechanisms 

    (i.e. a whiteBox framework, to be used by concrete subclasses).

    Actual instances are DrawView, DirectoryView, LogicView or DocumentView.

    If you want to use this class, have a special look at the pluggable behavior, especially,

    pressAction, releaseAction etc.:

    [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

    [author:]

        Claus Gittinger

    [see also:]

        DrawTool LogicTool

        DrawObject

        DisplayObject

"

!

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:

                                                                        [exBegin]

        |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

                                                                        [exEnd]

    add scrolling:

                                                                        [exBegin]

        |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

                                                                        [exEnd]

    or, using miniscrollers:

                                                                        [exBegin]

        |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

                                                                        [exEnd]

    mix views and displayObjects:

                                                                        [exBegin]

        |v top o|

        top := HVScrollableView for:ObjectView.

        top extent:200@200.

        v := top scrolledView.

        o := DrawLine new.

        o origin:10@10 corner:50@50.

        v add:o.

        o := ClockView in:top.

        o origin:50@50 corner:100@100.

        v add:o.

        top open

                                                                        [exEnd]

    grid:

                                                                        [exBegin]

        |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

                                                                        [exEnd]

    zoom:

                                                                        [exBegin]

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

        Delay waitForSeconds:5.

        v zoom:2.

        Delay waitForSeconds:5.

        v zoom:0.35.

        Delay waitForSeconds:5.

        v zoom:1.

                                                                        [exEnd]

   private benchmark: display 10000 objects ...

                                                                        [exBegin]

        |v top o rnd|

        top := HVScrollableView for:ObjectView 

                                miniScrollerH:true miniScrollerV:true.

        top extent:200@200.

        v := top scrolledView.

        rnd := Random new.

        10000 timesRepeat:[

            o := DrawLine new.

            o origin:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700)

              corner:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700).

            v add:o.

        ].

        top openAndWait.

        Transcript showCR:(

            Time millisecondsToRun:[

                v redraw              

            ])

                                                                        [exEnd]

"

! !

!ObjectView class methodsFor:'defaults'!

handleSize

    "size of blob drawn for handles"

    ^ (Screen current horizontalPixelPerMillimeter * 1.2) rounded asInteger

!

hitDelta

    "when clicking an object, allow for hitDelta pixels around object;

     0 is exact; 1*pixelPerMillimeter is good for draw programs"

    ^ 0

!

mouseMotionDeltaForMove

    ^ MIN_DELTA_FOR_MOVE ? 10

!

mouseMotionTimeDeltaForMove

    ^ TIME_DELTA_FOR_MOVE ? 500

! !

!ObjectView methodsFor:'accessing'!

aligning

    ^ aligning

!

aligningMove

    ^ aligningMove

!

aligningMove:aBoolean

    aligningMove == aBoolean ifTrue:[ ^ self ].

    aBoolean ifTrue:[

        aligning == true ifFalse:[ ^ self ].

        gridAlign isNil ifTrue:[ ^ self ].

    ].

    aligningMove := aBoolean

!

contents

    ^ contents

    "Created: / 4.7.1999 / 15:15:15 / cg"

!

gridShown

    ^ gridShown

! !

!ObjectView methodsFor:'accessing-behavior'!

ctrlPressAction:aBlock

    ctrlPressAction := aBlock

    "Created: / 27-10-2006 / 14:06:41 / cg"

!

doublePressAction:aBlock

    doublePressAction := aBlock

    "Created: / 27-10-2006 / 14:06:49 / cg"

!

keyPressAction:aBlock

    keyPressAction := aBlock

!

motionAction:aBlock

    motionAction := aBlock

!

pressAction:aBlock

    pressAction := aBlock

    "Modified: / 27-10-2006 / 14:06:34 / cg"

!

releaseAction:aBlock

    releaseAction := aBlock

!

setDefaultActions

    "setup actions for default behavior (do - nothing)"

    movedObject := nil.

    inMotion := false.

    motionAction := [:movePoint | nil].

    releaseAction := [nil]

    "Modified: / 4.7.1999 / 18:55:01 / cg"

!

shiftPressAction:aBlock

    shiftPressAction := aBlock

    "Created: / 27-10-2006 / 14:06:30 / cg"

! !

!ObjectView methodsFor:'adding & removing'!

add:something

    "add something, anObject or a collection of objects to the contents

     with redraw"

    something doIfNotNil:[:anObject |

        self addObject:anObject

    ]

    "Modified: / 11-04-2018 / 18:09:37 / stefan"

!

addObject:anObject

    "add the argument, anObject to the contents - with redraw"

    anObject notNil ifTrue:[

        contents addLast:anObject.

        self changed:#addObject with:anObject.

        "its on top - only draw this one"

        shown "realized" ifTrue:[

            self showUnselected:anObject

        ]

    ]

    "Modified: / 4.7.1999 / 16:50:24 / cg"

!

addObjectFirst:anObject

    "add the argument, anObject to the beginning of the contents - with redraw"

    anObject notNil ifTrue:[

        contents addFirst:anObject.

        self changed:#addObject.

        "its on top - only draw this one"

        shown "realized" ifTrue:[

            self showUnselected:anObject

        ]

    ]

    "Modified: / 4.7.1999 / 16:50:22 / cg"

!

addObjectFirstWithoutRedraw:anObject

    "add the argument, anObject to the start of the contents - no redraw"

    anObject notNil ifTrue:[

        contents addFirst:anObject.

        self changed:#addObject.

    ]

    "Modified: / 4.7.1999 / 16:50:19 / cg"

!

addObjectWithoutRedraw:anObject

    "add the argument, anObject to the contents - no redraw"

    anObject notNil ifTrue:[

        contents addLast:anObject.

        self changed:#addObject.

    ]

    "Modified: / 4.7.1999 / 16:50:16 / cg"

!

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