module Wumpus.Drawing.Geometry.Paths
(
LocCoordPath
, coordinatePrimPath
, rectangleCoordPath
, diamondCoordPath
, polygonCoordPath
, isoscelesTriangleCoordPath
, isoscelesTrianglePoints
, equilateralTriangleCoordPath
, equilateralTrianglePoints
)
where
import Wumpus.Core
import Data.AffineSpace
import Data.List ( unfoldr )
type LocCoordPath u = Point2 u -> [Point2 u]
coordinatePrimPath :: Num u => Point2 u -> LocCoordPath u -> PrimPath u
coordinatePrimPath pt fn = go (fn pt)
where
go ps@(_:_) = vertexPath ps
go [] = emptyPath pt
rectangleCoordPath :: Num u => u -> u -> LocCoordPath u
rectangleCoordPath w h bl = [ bl, br, tr, tl ]
where
br = bl .+^ hvec w
tr = br .+^ vvec h
tl = bl .+^ vvec h
diamondCoordPath :: Num u => u -> u -> LocCoordPath u
diamondCoordPath hw hh ctr = [ s,e,n,w ]
where
s = ctr .+^ vvec (hh)
e = ctr .+^ hvec hw
n = ctr .+^ vvec hh
w = ctr .+^ hvec (hw)
polygonCoordPath :: Floating u => Int -> u -> LocCoordPath u
polygonCoordPath n radius ctr = unfoldr phi (0,(pi*0.5))
where
theta = (pi*2) / fromIntegral n
phi (i,ang) | i < n = Just (ctr .+^ avec ang radius, (i+1,ang+theta))
| otherwise = Nothing
isoscelesTriangleCoordPath :: Floating u => u -> u -> LocCoordPath u
isoscelesTriangleCoordPath bw h ctr = [bl,br,top]
where
(bl,br,top) = isoscelesTrianglePoints bw h ctr
isoscelesTrianglePoints :: Floating u
=> u -> u -> Point2 u -> (Point2 u, Point2 u, Point2 u)
isoscelesTrianglePoints bw h ctr = (bl, br, top)
where
hw = 0.5*bw
theta = atan $ h / hw
centroid_h = hw * tan (0.5*theta)
top = ctr .+^ vvec (h centroid_h)
br = ctr .+^ V2 hw (centroid_h)
bl = ctr .+^ V2 (hw) (centroid_h)
equilateralTriangleCoordPath :: Floating u => u -> LocCoordPath u
equilateralTriangleCoordPath sl ctr = [bl, br, top]
where
(bl,br,top) = equilateralTrianglePoints sl ctr
equilateralTrianglePoints :: Floating u
=> u -> Point2 u -> (Point2 u, Point2 u, Point2 u)
equilateralTrianglePoints sl = isoscelesTrianglePoints sl h
where
h = sl * sin (pi/3)