module Wumpus.Basic.Paths.Connectors
(
ConnectorPath
, DConnectorPath
, connLine
, connRightVH
, connRightHV
, connRightVHV
, connRightHVH
, connIsosceles
, connIsosceles2
, connLightningBolt
, connIsoscelesCurve
, connSquareCurve
, connUSquareCurve
, connTrapezoidCurve
, connZSquareCurve
, connUZSquareCurve
) where
import Wumpus.Basic.Paths.Base
import Wumpus.Basic.Paths.ControlPoints
import Wumpus.Core
import Data.AffineSpace
import Prelude hiding ( length )
type ConnectorPath u = Point2 u -> Point2 u -> Path u
type DConnectorPath = ConnectorPath Double
connLine :: Floating u => ConnectorPath u
connLine = line
connRightVH :: Floating u => ConnectorPath u
connRightVH p1@(P2 x1 _) p2@(P2 _ y2) =
let mid = P2 x1 y2 in traceLinePoints [p1, mid, p2]
connRightHV :: Floating u => ConnectorPath u
connRightHV p1@(P2 _ y1) p2@(P2 x2 _) =
let mid = P2 x2 y1 in traceLinePoints [p1, mid, p2]
connRightVHV :: Floating u => u -> ConnectorPath u
connRightVHV v p1@(P2 x1 _) p2@(P2 x2 _) = traceLinePoints [p1, a1, a2, p2]
where
a1 = p1 .+^ vvec v
a2 = a1 .+^ hvec (x2 x1)
connRightHVH :: Floating u => u -> ConnectorPath u
connRightHVH h p1@(P2 _ y1) p2@(P2 _ y2) = traceLinePoints [p1,a1,a2,p2]
where
a1 = p1 .+^ hvec h
a2 = a1 .+^ vvec (y2 y1)
connIsosceles :: (Real u, Floating u) => u -> ConnectorPath u
connIsosceles dy p1 p2 = traceLinePoints [p1, mid_pt, p2]
where
mid_pt = midpointIsosceles dy p1 p2
connIsosceles2 :: (Real u, Floating u) => u -> ConnectorPath u
connIsosceles2 u p1 p2 = traceLinePoints [ p1, cp1, cp2, p2 ]
where
(cp1,cp2) = dblpointIsosceles u p1 p2
connLightningBolt :: (Real u, Floating u) => u -> ConnectorPath u
connLightningBolt u p1 p2 = traceLinePoints [ p1, cp1, cp2, p2 ]
where
cp1 = midpointIsosceles u p1 p2
cp2 = midpointIsosceles (u) p1 p2
connIsoscelesCurve :: (Real u, Floating u) => u -> ConnectorPath u
connIsoscelesCurve u p1 p2 = traceCurvePoints [p1, control_pt, control_pt, p2]
where
control_pt = midpointIsosceles u p1 p2
connSquareCurve :: (Real u, Floating u) => ConnectorPath u
connSquareCurve p1 p2 = traceCurvePoints [p1, cp1, cp2, p2]
where
(cp1,cp2) = squareFromBasePoints p1 p2
connUSquareCurve :: (Real u, Floating u) => ConnectorPath u
connUSquareCurve p1 p2 = traceCurvePoints [p1, cp1, cp2, p2]
where
(cp1,cp2) = usquareFromBasePoints p1 p2
connTrapezoidCurve :: (Real u, Floating u) => u -> u -> ConnectorPath u
connTrapezoidCurve u ratio_to_base p1 p2 = traceCurvePoints [p1, cp1, cp2, p2]
where
(cp1,cp2) = trapezoidFromBasePoints u ratio_to_base p1 p2
connZSquareCurve :: (Real u, Floating u) => ConnectorPath u
connZSquareCurve p1 p2 = traceCurvePoints [p1,cp1,cp2,p2]
where
(cp1,cp2) = squareFromCornerPoints p1 p2
connUZSquareCurve :: (Real u, Floating u) => ConnectorPath u
connUZSquareCurve p1 p2 = traceCurvePoints [p1,cp2,cp1,p2]
where
(cp1,cp2) = squareFromCornerPoints p1 p2