module Wumpus.Basic.Graphic.Anchors
(
CenterAnchor(..)
, CardinalAnchor(..)
, CardinalAnchor2(..)
, RadialAnchor(..)
, northwards
, southwards
, eastwards
, westwards
, northeastwards
, southeastwards
, southwestwards
, northwestwards
, radialConnectorPoints
) where
import Wumpus.Core
import Data.AffineSpace
class CenterAnchor t where
center :: DUnit t ~ u => t -> Point2 u
class CardinalAnchor t where
north :: DUnit t ~ u => t -> Point2 u
south :: DUnit t ~ u => t -> Point2 u
east :: DUnit t ~ u => t -> Point2 u
west :: DUnit t ~ u => t -> Point2 u
class CardinalAnchor2 t where
northeast :: DUnit t ~ u => t -> Point2 u
southeast :: DUnit t ~ u => t -> Point2 u
southwest :: DUnit t ~ u => t -> Point2 u
northwest :: DUnit t ~ u => t -> Point2 u
class RadialAnchor t where
radialAnchor :: DUnit t ~ u => Radian -> t -> Point2 u
extendPtDist :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> Point2 u
extendPtDist d p1 p2 = let v = pvec p1 p2
ang = direction v
len = vlength v
in p1 .+^ avec ang (len+d)
northwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor t
, u ~ DUnit t )
=> u -> t -> Point2 u
northwards u a = extendPtDist u (center a) (north a)
southwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor t
, u ~ DUnit t )
=> u -> t -> Point2 u
southwards u a = extendPtDist u (center a) (south a)
eastwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor t
, u ~ DUnit t )
=> u -> t -> Point2 u
eastwards u a = extendPtDist u (center a) (east a)
westwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor t
, u ~ DUnit t )
=> u -> t -> Point2 u
westwards u a = extendPtDist u (center a) (west a)
northeastwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor2 t
, u ~ DUnit t )
=> u -> t -> Point2 u
northeastwards u a = extendPtDist u (center a) (northeast a)
southeastwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor2 t
, u ~ DUnit t )
=> u -> t -> Point2 u
southeastwards u a = extendPtDist u (center a) (southeast a)
southwestwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor2 t
, u ~ DUnit t )
=> u -> t -> Point2 u
southwestwards u a = extendPtDist u (center a) (southwest a)
northwestwards :: ( Real u, Floating u, CenterAnchor t, CardinalAnchor2 t
, u ~ DUnit t )
=> u -> t -> Point2 u
northwestwards u a = extendPtDist u (center a) (northwest a)
radialConnectorPoints :: ( Real u, Floating u
, CenterAnchor t1, RadialAnchor t1
, CenterAnchor t2, RadialAnchor t2
, u ~ DUnit t1, DUnit t1 ~ DUnit t2 )
=> t1 -> t2 -> (Point2 u, Point2 u)
radialConnectorPoints a b = (radialAnchor theta a, radialAnchor (theta+pi) b)
where
theta = direction $ pvec (center a) (center b)
instance Fractional u => CenterAnchor (BoundingBox u) where
center (BBox (P2 xl ylo) (P2 xr yhi)) = P2 x y
where
x = xl+0.5*(xrxl)
y = ylo+0.5*(yhiylo)
instance Fractional u => CardinalAnchor (BoundingBox u) where
north (BBox (P2 xl _ ) (P2 xr yhi)) = P2 (xl+0.5*(xrxl)) yhi
south (BBox (P2 xl ylo) (P2 xr _ )) = P2 (xl+0.5*(xrxl)) ylo
east (BBox (P2 _ ylo) (P2 xr yhi)) = P2 xr (ylo+0.5*(yhiylo))
west (BBox (P2 xl ylo) (P2 _ yhi)) = P2 xl (ylo+0.5*(yhiylo))
instance Fractional u => CardinalAnchor2 (BoundingBox u) where
northeast (BBox _ ur) = ur
southeast (BBox (P2 _ ylo) (P2 xr _)) = P2 xr ylo
southwest (BBox ll _) = ll
northwest (BBox (P2 xl _) (P2 _ yhi)) = P2 xl yhi