module Gelatin.Core.Rendering.Polylines where
import Gelatin.Core.Rendering.Types
import Gelatin.Core.Triangulation.Common (triangleArea)
import Linear hiding (trace)
import Debug.Trace
polygonExpand :: Float -> [V2 Float] -> [V2 Float]
polygonExpand t ps = trace (show (length ps, length vs, length poly)) poly
where poly = zipWith f ps vs
f p v = p + (v ^* t)
bows = zip3 ps' (tail ps') (tail $ tail ps')
vs = map (\(a,b,c) -> perp $ tangentOf a b c) bows
ps' = start ++ ps ++ end
start = case ps of
x:_ -> [x]
_ -> []
end = case reverse ps of
x:_ -> [x]
_ -> []
outlinePolyline :: EndCap -> LineJoin -> Float -> [V2 Float] -> [V2 Float]
outlinePolyline c j t ps = scap ++ ptans ++ ecap ++ reverse ntans ++ h
where js = joints c j t ps
(ptans,ntans) = both concat $ unzip $ map tangentPoints js
both f (a,b) = (f a, f b)
scap = case js of
(Cap _ xs:_) -> reverse xs
_ -> []
ecap = case reverse js of
(Cap _ xs:_) -> reverse xs
_ -> []
h = case scap of
h':_ -> [h']
_ -> []
polyline :: EndCap -> LineJoin -> Float -> [V2 Float] -> [Triangle (V2 Float)]
polyline c j t ps = triangulate $ joints c j t ps
triangulate :: [Joint] -> [Triangle (V2 Float)]
triangulate (j@Cap{}:j':js) = cap ++ arm ++ (triangulate $ j':js)
where cap = triangulateCap j
arm = triangulateArm j j'
triangulate [j, j'@Cap{}] = arm ++ bow ++ cap
where arm = triangulateArm j j'
bow = triangulateElbow j
cap = triangulateCap j'
triangulate (j:j':js) = arm ++ bow ++ (triangulate $ j':js)
where arm = triangulateArm j j'
bow = triangulateElbow j
triangulate _ = []
tangentPoints :: Joint -> ([V2 Float], [V2 Float])
tangentPoints (Cap _ _) = ([], [])
tangentPoints (Elbow _ (p,n) []) = ([p],[n])
tangentPoints (Elbow Clockwise (p,_) ps) = ([p],ps)
tangentPoints (Elbow CounterCW (_,n) ps) = (ps,[n])
exitLine :: Joint -> (V2 Float, V2 Float)
exitLine (Cap _ ps) = (head ps, head $ reverse ps)
exitLine (Elbow _ l []) = l
exitLine (Elbow Clockwise (p,_) ps) = (p, head $ reverse ps)
exitLine (Elbow CounterCW (_,n) ps) = (head $ reverse ps, n)
entryLine :: Joint -> (V2 Float, V2 Float)
entryLine (Cap _ ps) = (head $ reverse ps, head ps)
entryLine (Elbow _ l []) = l
entryLine (Elbow Clockwise (p,_) ps) = (p, head ps)
entryLine (Elbow CounterCW (_,n) ps) = (head ps, n)
triangulateElbow :: Joint -> [Triangle (V2 Float)]
triangulateElbow (Elbow Clockwise (p,_) ps) = map (uncurry $ Triangle p) $ zip ps $ tail ps
triangulateElbow (Elbow CounterCW (_,n) ps) = map (uncurry $ Triangle n) $ zip ps $ tail ps
triangulateElbow _ = []
triangulateArm :: Joint -> Joint -> [Triangle (V2 Float)]
triangulateArm j j' = [Triangle a b c, Triangle b c d]
where (a,b) = exitLine j
(c,d) = entryLine j'
triangulateCap :: Joint -> [Triangle (V2 Float)]
triangulateCap (Cap p ps) = map (uncurry $ Triangle p) $ zip ps $ tail ps
triangulateCap _ = []
joints :: EndCap -> LineJoin -> Float -> [V2 Float] -> [Joint]
joints _ _ _ [] = []
joints _ _ _ [_] = []
joints c j t ps@(a:b:_) = start : mid ++ [end]
where start = capFunc c t a b
end = capFunc c t z y
mid = miters j t ps
[z,y] = take 2 $ reverse ps
capFunc :: EndCap -> Float -> V2 Float -> V2 Float -> Joint
capFunc EndCapButt t a b = Cap a [lp,hp]
where (lp,hp) = miterLine (capJoin t a b) a
capFunc EndCapBevel t a b = Cap a [lp,p,hp]
where (lp,hp) = miterLine (capJoin t a b) a
p = a + (signorm $ a - b) ^* t
capFunc EndCapSquare t a b = Cap a [lp,p'',p',hp]
where (lp,hp) = miterLine (capJoin t a b) a
p = a + (signorm $ a - b) ^* t
p' = p + ((signorm $ hp - a) ^* t)
p'' = p + ((signorm $ lp - a) ^* t)
capFunc EndCapRound t a b = Cap a ps
where ps = map f [(pi/2) + r + (d * pi/180) | d <- [0..180]]
V2 x y = signorm $ b - a
r = atan2 y x
f th = a + (V2 (cos th) (sin th) ^* t)
miters :: LineJoin -> Float -> [V2 Float] -> [Joint]
miters j t (a:b:c:ps) = miterFunc j t a b c : (miters j t $ b:c:ps)
miters _ _ _ = []
miterFunc :: LineJoin -> Float -> V2 Float -> V2 Float -> V2 Float -> Joint
miterFunc LineJoinMiter = miterJoint
miterFunc LineJoinBevel = bevelJoint
bevelJoint :: Float -> V2 Float -> V2 Float -> V2 Float -> Joint
bevelJoint t a b c =
if triangleArea a b c >= 0
then Elbow Clockwise (p,n) [b - v', b - v'']
else Elbow CounterCW (p,n) [b + v', b + v'']
where j = join t a b c
(p,n) = miterLine j b
v' = t *^ (perp ab)
v'' = t *^ (perp bc)
ab = signorm $ b - a
bc = signorm $ c - b
miterJoint :: Float -> V2 Float -> V2 Float -> V2 Float -> Joint
miterJoint t a b c =
if triangleArea a b c >= 0
then Elbow Clockwise (ptan,ntan) []
else Elbow CounterCW (ptan,ntan) []
where j = join t a b c
(ptan,ntan) = miterLine j b
miterLine :: Join -> V2 Float -> (V2 Float, V2 Float)
miterLine (Join v l) p = (ptan,ntan)
where ptan = p + v'
ntan = p - v'
v' = (v ^* l)
join :: Float -> V2 Float -> V2 Float -> V2 Float -> Join
join t a b c = Join v ln
where tgnt = tangentOf a b c
v = perp tgnt
ln = min d $ t / (v `dot` n)
n = signorm $ perp $ b - a
d = min (distance (c - b) zero) (distance (b - a) zero)
capJoin :: Float -> V2 Float -> V2 Float -> Join
capJoin t a b = Join v t
where v = signorm $ perp $ b - a
tangentOf :: V2 Float -> V2 Float -> V2 Float -> V2 Float
tangentOf a b c = signorm $ (signorm l2) + (signorm l1)
where l1 = b - a
l2 = c - b
angleBetween :: V2 Float -> V2 Float -> Float
angleBetween v1 v2 = a - b
where V2 x1 y1 = signorm v1
V2 x2 y2 = signorm v2
a = atan2 y1 x1
b = atan2 y2 x2
data Join = Join { joinVector :: V2 Float
, joinLength :: Float
} deriving (Show, Eq)