ArrowedSpline.st
author Claus Gittinger <cg@exept.de>
Sat, 02 May 2020 21:40:13 +0200
changeset 5476 7355a4b11cb6
parent 2154 0c5cc2edf99c
permissions -rw-r--r--
#FEATURE by cg class: Socket class added: #newTCPclientToHost:port:domain:domainOrder:withTimeout: changed: #newTCPclientToHost:port:domain:withTimeout:

"
 COPYRIGHT (c) 1996 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:libbasic2' }"

Spline subclass:#ArrowedSpline
	instanceVariableNames:'arrowHeadPositions arrowHeadLength arrowHeadAngle'
	classVariableNames:''
	poolDictionaries:''
	category:'Graphics-Geometry-Objects'
!

!ArrowedSpline class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1996 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
"
    ArrowedSplines are like infilled splines, with arrowHeads.

    [see also:]
        Polygon LineSegment Circle EllipticalArc 
        Rectangle Curve Arrow Spline
        GraphicsContext
        StrokingWrapper FillingWrapper

    [author:]
        Claus Gittinger
"
!

examples
"
  arrowedspline:
                                                                        [exBegin]
    |v a|

    v := View extent:100@100.

    a := ArrowedSpline controlPoints:
                (Array with:(20@20)
                       with:(80@80)
                       with:(20@80)).

    v addComponent:((StrokingWrapper on:a) foregroundColor:Color red).
    v open.
                                                                        [exEnd]

  filled arrow:
                                                                        [exBegin]
    |v a|

    v := View extent:100@100.

    a := ArrowedSpline controlPoints:
                (Array with:(20@20)
                       with:(80@80)
                       with:(20@50)
                       with:(90@10)).

    v addComponent:((FillingWrapper on:a) foregroundColor:Color red).
    v open.
                                                                        [exEnd]

  more arrowHeads:
                                                                        [exBegin]
    |v a|

    v := View extent:100@100.

    a := ArrowedSpline controlPoints:
                (Array with:(20@20)
                       with:(80@80)
                       with:(20@50)
                       with:(90@10)).
    a arrowHeadPositions:#(1 4).
    v addComponent:((FillingWrapper on:a) foregroundColor:Color red).
    v open.
                                                                        [exEnd]
  interactive:
                                                                        [exBegin]
    |v points eventCatcher|

    v := StandardSystemView extent:(450 @ 450).
    v label:'ArrowedSpline Example - (click left/middle)'.

    points := OrderedCollection new.
    v openAndWait.

    eventCatcher := Plug new.
    eventCatcher respondTo:#handlesButtonPress:inView:
                      with:[:butt :view | true].
    eventCatcher respondTo:#buttonPress:x:y:view:
                      with:[:butt :x :y :view | 
                            v paint:(Color white).
                            v fillCircle:(x @ y) radius:3.
                            points add:(x @ y).

                            (butt == 1 or:[butt == #select]) ifFalse:[
                                v paint:(Color white).
                                v fillCircle:(x @ y) radius:3.

                                ((ArrowedSpline controlPoints:points)
                                        arrowHeadPositions:(1 to:points size);
                                        arrowHeadLength:15)
                                        displayStrokedOn:v.

                                points := OrderedCollection new.
                            ]
                           ].

    v delegate:(eventCatcher)
                                                                        [exEnd]
"
! !

!ArrowedSpline methodsFor:'accessing'!

arrowHeadAngle
    "return the arrowHeads angle, in degrees.
     The default is defined in Arrow (150 degrees)"

    arrowHeadAngle isNil ifTrue:[^ Arrow defaultAngle].
    ^ arrowHeadAngle

    "Created: 12.5.1996 / 23:13:27 / cg"
    "Modified: 12.5.1996 / 23:14:15 / cg"
!

arrowHeadAngle:angleInDegrees
    "set the arrowHeads angle, in degrees.
     The default is defined in Arrow (150 degrees)"

    arrowHeadAngle := angleInDegrees

    "Created: 12.5.1996 / 23:13:34 / cg"
    "Modified: 12.5.1996 / 23:14:24 / cg"
!

arrowHeadLength
    "return the arrowHeads length, in pixels.
     The default is define in Arrow (8 pixels)"

    arrowHeadLength isNil ifTrue:[^ Arrow defaultLength].
    ^ arrowHeadLength

    "Modified: 13.5.1996 / 00:44:30 / cg"
!

arrowHeadLength:pixels
    "set the arrowHeads length, in pixels.
     The default is defined in Arrow (8 pixels)"

    arrowHeadLength := pixels

    "Created: 12.5.1996 / 23:15:34 / cg"
!

arrowHeadPositions:collectionOfPositions
    "set the arrowHeads positions. Each collections element gives
     theindex of a controlPoint, on which an arrowHead is drawn.
     The default is #(<controlPoints size>) i.e. a single arrowHead
     on the last controlPoint.
     To have arrowHeads on all controlPoints, define arrowHeadPositions
     as (1 to:controlPoints size)"

    arrowHeadPositions := collectionOfPositions

    "Modified: 12.5.1996 / 23:14:24 / cg"
    "Created: 13.5.1996 / 00:47:23 / cg"
! !

!ArrowedSpline methodsFor:'displaying'!

arrowPoints
    "helper: return a collection of arrow-points"

    |arrowHeadPoint len pos positions angle point grad xDis yDis
     savedLineStyle atn x1 x2 y1 y2 p1 p2 points i|

    firstDerivative isNil ifTrue:[
        self computeLineSegments
    ].

    positions := arrowHeadPositions.
    positions isNil ifTrue:[
        positions := Array with:(controlPoints size).
    ].

    len := arrowHeadLength.
    len isNil ifTrue:[
        len := Arrow defaultLength
    ].

    angle := arrowHeadAngle.
    angle isNil ifTrue:[
        angle := Arrow defaultAngle
    ].
    angle := angle degreesToRadians.

    points := Array new:(positions size * 3).
    i := 1.
    positions do:[:index |
        | p deriv|

        p := controlPoints at:index.
        deriv := (firstDerivative at:index).
        deriv isNil ifTrue:[
            deriv := (controlPoints at:index) - (controlPoints at:index-1).
        ].

        deriv x = 0
                    ifTrue: [grad := 9999999]
                    ifFalse: [grad := deriv y / deriv x].

        atn := grad arcTan.

        x1 := len * (angle - atn) cos.
        y1 := len * (angle - atn) sin.

        x2 := len * (angle + atn) cos.
        y2 := len * (angle + atn) sin.

        deriv x = 0 ifTrue: [
            deriv y > 0 ifTrue: [
                p1 := x1 @ (0 - y1).
                p2 := x2 @ (y2).
            ] ifFalse: [
                p1 := 0 - x1 @ (y1).
                p2 := 0 - x2 @ (0 - y2).
            ]
        ] ifFalse: [
            deriv x > 0 ifTrue:[
                p1 := x1 @ (0 - y1).
                p2 := x2 @ (y2).
            ] ifFalse: [
                p1 := 0 - x1 @ (y1).
                p2 := 0 - x2 @ (0 - y2)
            ]
        ].

        points at:i   put:p+p1.
        points at:i+1 put:p.
        points at:i+2 put:p+p2.
        i := i + 3
    ].

    ^ points

    "Created: 13.5.1996 / 00:50:49 / cg"
    "Modified: 5.6.1996 / 20:29:17 / cg"
!

displayArrowsOn:aGC filled:filled
    "display the receiver in the graphicsContext, aGC"

    |arrowPoints savedLineStyle nP "{Class: SmallInteger }"
     p1 p p2|

    savedLineStyle := aGC lineStyle.
    aGC lineStyle:#solid.

    arrowPoints := self arrowPoints.
    nP := arrowPoints size.
    1 to:nP by:3 do:[:i |
        p1 := arrowPoints at:i.
        p := arrowPoints at:i+1.
        p2 := arrowPoints at:i+2.

        filled ifTrue:[
            aGC fillPolygon:(Array with:p1 with:p with:p2).
        ] ifFalse:[
            aGC displayLineFrom:p to:p1.
            aGC displayLineFrom:p to:p2.
        ].
    ].

    aGC lineStyle:savedLineStyle.

    "Created: 13.5.1996 / 00:50:49 / cg"
    "Modified: 13.5.1996 / 00:52:17 / cg"
!

displayFilledOn:aGC
    "display the receiver in the graphicsContext, aGC"

    super displayStrokedOn:aGC.
    self displayArrowsOn:aGC filled:true

    "Created: 13.5.1996 / 00:51:14 / cg"
!

displayStrokedOn:aGC
    "display the receiver in the graphicsContext, aGC"

    super displayStrokedOn:aGC.
    self displayArrowsOn:aGC filled:false

    "Created: 13.5.1996 / 00:51:14 / cg"
    "Modified: 13.5.1996 / 00:52:34 / cg"
! !

!ArrowedSpline methodsFor:'queries'!

computeBounds
    "return the smallest enclosing rectangle"

    |minX maxX minY maxY|

    minX := maxX := 0.
    minY := maxY := 0.

    self arrowPoints do:[:p |
        |x y|

        x := p x.
        y := p y.
        minX := minX min:x.
        maxX := maxX max:x.
        minY := minY min:y.
        maxY := maxY max:y.
    ].    
    ^ Rectangle left:minX right:maxX top:minY bottom:maxY

    "Modified: 26.5.1996 / 13:08:48 / cg"
    "Created: 12.2.1997 / 11:42:41 / cg"
! !

!ArrowedSpline methodsFor:'testing'!

canBeFilled
    "return true, if the receiver can be drawn as a filled geometric.
     Always true here. Notice, that only the arrowHeads are filled."

    ^ true

! !

!ArrowedSpline class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/ArrowedSpline.st,v 1.10 2009-06-06 10:12:15 cg Exp $'
! !