module Wumpus.Drawing.Connectors.BoxConnectors
(
ConnectorBox
, ConnectorBoxSpec(..)
, renderConnectorBoxSpec
, conn_box
, conn_tube
, conn_chamf_box
) where
import Wumpus.Drawing.Basis.InclineTrails
import Wumpus.Drawing.Connectors.ConnectorProps
import Wumpus.Basic.Kernel
import Wumpus.Core
import Data.VectorSpace
type ConnectorBox u = ConnectorGraphic u
newtype ConnectorBoxSpec u = ConnectorBoxSpec {
getConnectorBoxSpec :: ConnectorProps -> ConnectorBox u }
renderConnectorBoxSpec :: (Real u, Floating u, InterpretUnit u)
=> ConnectorProps
-> ConnectorBoxSpec u
-> ConnectorBox u
renderConnectorBoxSpec props spec =
getConnectorBoxSpec spec props
boxConnector :: (Floating u, Ord u, InterpretUnit u)
=> (ConnectorProps -> Point2 u -> Point2 u -> Image u a)
-> ConnectorBoxSpec u
boxConnector mf = ConnectorBoxSpec $ \props ->
promoteConn $ \p0 p1 -> ignoreAns $ mf props p0 p1
adaptAnaTrail :: (Real u, Floating u, Ord u, InterpretUnit u)
=> (u -> Vec2 u -> AnaTrail u)
-> ConnectorBoxSpec u
adaptAnaTrail fn = boxConnector $ \props p0 p1 ->
connectorBoxHalfSize props >>= \sz ->
let v0 = pvec p0 p1
v1 = v0 ^+^ avec (vdirection v0) (2*sz)
vinit = avec (vdirection v0) (sz)
in applyLoc (renderAnaTrail CSTROKE $ fn sz v1) (displace vinit p0)
conn_box :: (Real u, Floating u, InterpretUnit u)
=> ConnectorBoxSpec u
conn_box = adaptAnaTrail (\sz -> incline_rect (2 * sz))
conn_tube :: (Real u, Floating u, InterpretUnit u)
=> ConnectorBoxSpec u
conn_tube = adaptAnaTrail (\sz -> incline_tube (2 * sz))
conn_chamf_box :: (Real u, Floating u, InterpretUnit u)
=> ConnectorBoxSpec u
conn_chamf_box = adaptAnaTrail (\sz -> incline_chamf_rect (2 * sz))