DCIprogram: #MoveShape

Context subclass: #MoveShape
    instanceVariableNames: 'drawing movingShapeName delta'
    category: 'MoveShape-Context'

" System operation.
Consider a Draw progam such as the PowerPoint slide editor. A user can create and place different shapes such as ovals, polygons, lines and other shapes. A Connector is a special line that runs from one shape to another. The line will always connect the two shapes even if the shapes move. This program implements the shape:move: operation.

THIS EXAMPLE HAS LIMITED FUNCTIONALITY
A constraint of this example is that the code shall be so simple that it can be explained in a regular talk. The code is therefore limited to a single connector. Also, Context classes are sunclasses of Context, the context base class that provides general runtime mechanisms. In this case, the remap method has been overridden to make the binding mechanism easier to explain (but not as general).

A NOTE ON THE IMPLEMENTATION
There is one Context class with one system operation:
        shape: aShape move: aPoint inData: drawing

"

instanceMethods: operations

instanceMethods: role methods

shapeHasMoved
    self pointAt: MOVINGSHAPE put: MOVINGSHAPE center

instanceMethods: role methods

move
    self setOrigin: self origin + DELTA corner: self corner + DELTA.
    LINE shapeHasMoved

Object subclass: #Connector
    instanceVariableNames: 'startShape endShape line'
    category: 'MoveShape-Data'

" The line object in the Connector is not visible from outside the Connector.
No outside code can corrupt it. "

instanceMethods: initialize-release

startShape: start endShape: end
    startShape := start.
    endShape := end.
    (line := Line new) beginPoint: startShape center; endPoint: endShape center.

instanceMethods: attributes-write

pointAt: shape put: aPoint
    startShape == shape
        ifTrue: [line beginPoint: aPoint rounded].
    endShape == shape
        ifTrue: [line endPoint: aPoint rounded].

instanceMethods: operations

testLineStartPoint: start endPoint: end
    ^(line beginPoint = start) & (line endPoint = end)

Object subclass: #Test
    instanceVariableNames: ''
    category: 'MoveShape-Test'

instanceMethods: operations

test
    " Test new test. "
    "Set up test data. "
    | rect1A rect1B rect2 data delta connPt1A connPt2 connPt1B |
    rect1A := Rectangle origin: 0@5 corner: 10@15.
    rect1B := Rectangle origin: 100@115 corner: 110@125.
    rect2 := Rectangle origin: 20@25 corner: 30@35.
    (data := IdentityDictionary new)
        at: #Shape1 put: rect1A;
        at: #Shape2 put: rect2;
        at: #Connector put: (Connector new startShape: (data at: #Shape1) endShape: (data at: #Shape2)).
    delta := 100@110.
    " Check test Data. "
    connPt1A := rect1A center rounded.
    connPt2 := rect2 center rounded.
    self assert: [(
        (data at: #Shape1) = rect1A &
        (data at: #Shape2) = rect2 &
        (data at: #Connector) testLineStartPoint: connPt1A endPoint: connPt2
        ).
    ].
    " Move. "
    MoveShape new shape: #Shape1 move: delta data: data.
    " Check final Data. "
    connPt1B := rect1B center rounded.
    " Check result of move. "
    self assert: [(
        (data at: #Shape1) = rect1B&
        (data at: #Shape2) = rect2 &
        (data at: #Connector) testLineStartPoint: connPt1B endPoint: connPt2
        ).
    ].
    self inform: 'MoveShape test successful.'.

classMethods: instance creation

run
    self basicNew test