wumpus-basic-0.22.0: src/Wumpus/Basic/Kernel/Objects/Trail.hs
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module : Wumpus.Basic.Kernel.Objects.Trial
-- Copyright : (c) Stephen Tetley 2011
-- License : BSD3
--
-- Maintainer : stephen.tetley@gmail.com
-- Stability : highly unstable
-- Portability : GHC
--
-- /Trails/ - prototype paths. Less resource heavy than the Path
-- object in Wumpus-Drawing.
--
--------------------------------------------------------------------------------
module Wumpus.Basic.Kernel.Objects.Trail
(
TrailSegment(..)
, CatTrail
, PlacedTrail
, drawPlacedTrail
, drawCatTrail
, destrPlacedTrail
, destrCatTrail
, placeCatTrail
, trailIterateLocus
, placedTrailPoints
, rectangleTrail
, diamondTrail
, polygonTrail
, catline
, catcurve
, trail_up
, trail_down
, trail_left
, trail_right
, trail_north
, trail_south
, trail_east
, trail_west
, trail_north_east
, trail_north_west
, trail_south_east
, trail_south_west
, trail_up_left
, trail_up_right
, trail_down_left
, trail_down_right
, orthoCatline
, trail_theta_up
, trail_theta_down
, trail_theta_left
, trail_theta_right
, trail_theta_north
, trail_theta_south
, trail_theta_east
, trail_theta_west
, trail_theta_north_east
, trail_theta_north_west
, trail_theta_south_east
, trail_theta_south_west
, trail_theta_up_left
, trail_theta_up_right
, trail_theta_down_left
, trail_theta_down_right
, semicircleCW
, semicircleCCW
, minorCircleSweepCW
, minorCircleSweepCCW
, circleSweepCW
, circleSweepCCW
, circularArcCW
, circularArcCCW
, sineWave
, sineWave1
, squareWave
, sawtoothWave
, squiggleWave
, semicircleWave
, tricurve
, rectcurve
, trapcurveCW
, trapcurveCCW
, bowcurve
, wedgecurve
, loopcurve
) where
import Wumpus.Basic.Kernel.Base.BaseDefs
import Wumpus.Basic.Kernel.Base.QueryDC
import Wumpus.Basic.Kernel.Objects.Displacement
import Wumpus.Basic.Kernel.Objects.DrawingPrimitives
import Wumpus.Basic.Kernel.Objects.Image
import Wumpus.Basic.Kernel.Objects.LocImage
import Wumpus.Basic.Utils.HList
import Wumpus.Core -- package: wumpus-core
import Data.AffineSpace -- package: vector-space
import Data.VectorSpace
import Data.List ( unfoldr )
import Data.Monoid
data PlacedTrail u = PlacedTrail
{ pt_init_vec :: Vec2 u
, pt_segments :: [TrailSegment u]
}
deriving (Eq,Ord,Show)
type instance DUnit (PlacedTrail u) = u
newtype CatTrail u = CatTrail { getCatTrail :: H (TrailSegment u) }
type instance DUnit (CatTrail u) = u
data TrailSegment u = TLine (Vec2 u)
| TCurve (Vec2 u) (Vec2 u) (Vec2 u)
deriving (Eq,Ord,Show)
type instance DUnit (TrailSegment u) = u
instance Functor TrailSegment where
fmap f (TLine v1) = TLine $ fmap f v1
fmap f (TCurve v1 v2 v3) = TCurve (fmap f v1) (fmap f v2) (fmap f v3)
instance Monoid (CatTrail u) where
mempty = CatTrail emptyH
a `mappend` b = CatTrail $ getCatTrail a `appendH` getCatTrail b
--------------------------------------------------------------------------------
drawCatTrail :: InterpretUnit u => PathMode -> CatTrail u -> LocGraphic u
drawCatTrail mode (CatTrail ct) = promoteLoc $ \pt ->
drawTrailBody mode (toListH ct) pt
drawPlacedTrail :: InterpretUnit u => PathMode -> PlacedTrail u -> LocGraphic u
drawPlacedTrail mode (PlacedTrail v0 xs) = promoteLoc $ \pt ->
drawTrailBody mode xs (pt .+^ v0)
-- | Note - this optimizes contiguous lines that share the same
-- direction.
--
drawTrailBody :: InterpretUnit u
=> PathMode -> [TrailSegment u] -> Point2 u -> Graphic u
drawTrailBody mode ts pt =
normalizeCtxF pt >>= \dpt ->
mapM normalizeCtxF ts >>= \dxs ->
dcPath mode $ relPrimPath dpt $ stepA id dxs
where
stepA f [] = toListH f
stepA f (TLine v1:ys) = stepB f (vdirection v1) v1 ys
stepA f (TCurve v1 v2 v3:ys) = stepA (f `snocH` relCurveTo v1 v2 v3) ys
stepB f dir v0 (TLine v1:ys)
| vdirection v1 == dir = stepB f dir (v0 ^+^ v1) ys
stepB f _ v0 ys = stepA (f `snocH` relLineTo v0) ys
-- | /Destructor/ for the opaque 'PlacedTrail' type.
--
destrPlacedTrail :: PlacedTrail u -> (Vec2 u, [TrailSegment u])
destrPlacedTrail (PlacedTrail v0 ss) = (v0,ss)
-- | /Destructor/ for the opaque 'CatTrail' type.
--
destrCatTrail :: CatTrail u -> [TrailSegment u]
destrCatTrail = toListH . getCatTrail
-- | Turn a 'CatTrail' into a 'PlacedTrail'.
--
placeCatTrail :: Vec2 u -> CatTrail u -> PlacedTrail u
placeCatTrail vinit cat = PlacedTrail { pt_init_vec = vinit
, pt_segments = getCatTrail cat []
}
-- | Create a PlacedTrail from the vector list - each vector in the
-- input list iterates to the start point rather then the
-- cumulative tip.
--
-- When the PlacedTrail is run, the supplied point is the /locus/ of
-- the path and it does not form part of the path proper.
--
-- Like 'trailStartIsLocus', this constructor is typically used to
-- make /shape paths/. Some shapes are easier to express as
-- iterated displacements of the center rather than
-- /turtle drawing/.
--
trailIterateLocus :: Num u => [Vec2 u] -> PlacedTrail u
trailIterateLocus [] = PlacedTrail zeroVec []
trailIterateLocus (v0:xs) = PlacedTrail v0 (step v0 xs)
where
step v1 [] = [ TLine (v0 ^-^ v1) ]
step v1 (v2:vs) = TLine (v2 ^-^ v1) : step v2 vs
placedTrailPoints :: InterpretUnit u => PlacedTrail u -> LocQuery u [Point2 u]
placedTrailPoints (PlacedTrail v0 ts) = qpromoteLoc $ \pt ->
return $ step (pt .+^ v0) ts
where
step p1 [] = [p1]
step p1 (TLine v1:xs) = p1 : step (p1 .+^ v1) xs
step p1 (TCurve v1 v2 v3 :xs) = let p2 = p1 .+^ v1
p3 = p2 .+^ v2
p4 = p3 .+^ v3
in p1 : p2 : p3 : step p4 xs
-- | 'rectangleTrail' : @ width * height -> PlacedTrail @
--
rectangleTrail :: Fractional u => u -> u -> PlacedTrail u
rectangleTrail w h =
PlacedTrail { pt_init_vec = ctr_to_bl
, pt_segments = map TLine spec
}
where
ctr_to_bl = vec (negate $ 0.5*w) (negate $ 0.5*h)
spec = [ go_right w, go_up h, go_left w, go_down h ]
-- | 'diamondTrail' : @ half_width * half_height -> PlacedTrail @
--
diamondTrail :: Num u => u -> u -> PlacedTrail u
diamondTrail hw hh = trailIterateLocus [ vs,ve,vn,vw ]
where
vs = vvec (-hh)
ve = hvec hw
vn = vvec hh
vw = hvec (-hw)
-- | 'polygonTrail' : @ num_points * radius -> PlacedTrail @
--
polygonTrail :: Floating u => Int -> u -> PlacedTrail u
polygonTrail n radius = trailIterateLocus $ unfoldr phi (0,top)
where
top = 0.5*pi
theta = (2*pi) / fromIntegral n
phi (i,ang) | i < n = Just (avec ang radius, (i+1,ang+theta))
| otherwise = Nothing
catline :: Vec2 u -> CatTrail u
catline = CatTrail . wrapH . TLine
catcurve :: Vec2 u -> Vec2 u -> Vec2 u -> CatTrail u
catcurve v1 v2 v3 = CatTrail $ wrapH $ TCurve v1 v2 v3
trail_up :: Num u => u -> CatTrail u
trail_up = catline . go_up
trail_down :: Num u => u -> CatTrail u
trail_down = catline . go_down
trail_left :: Num u => u -> CatTrail u
trail_left = catline . go_left
trail_right :: Num u => u -> CatTrail u
trail_right = catline . go_right
trail_north :: Num u => u -> CatTrail u
trail_north = trail_up
trail_south :: Num u => u -> CatTrail u
trail_south = catline . go_down
trail_east :: Num u => u -> CatTrail u
trail_east = catline . go_right
trail_west :: Num u => u -> CatTrail u
trail_west = catline . go_left
trail_north_east :: Floating u => u -> CatTrail u
trail_north_east = catline . go_north_east
trail_north_west :: Floating u => u -> CatTrail u
trail_north_west = catline . go_north_west
trail_south_east :: Floating u => u -> CatTrail u
trail_south_east = catline . go_south_east
trail_south_west :: Floating u => u -> CatTrail u
trail_south_west = catline . go_south_west
trail_up_left :: Num u => u -> CatTrail u
trail_up_left = catline . go_up_left
trail_up_right :: Num u => u -> CatTrail u
trail_up_right = catline . go_up_right
trail_down_left :: Num u => u -> CatTrail u
trail_down_left = catline . go_down_left
trail_down_right :: Num u => u -> CatTrail u
trail_down_right = catline . go_down_right
-- | Alternative to @catline@, specifying the vector components
-- rather the vector itself.
--
orthoCatline :: Floating u => u -> u -> Radian -> CatTrail u
orthoCatline x y ang = catline (orthoVec x y ang)
trail_theta_up :: Floating u => u -> Radian -> CatTrail u
trail_theta_up u = catline . theta_up u
trail_theta_down :: Floating u => u -> Radian -> CatTrail u
trail_theta_down u = catline . theta_down u
trail_theta_left :: Floating u => u -> Radian -> CatTrail u
trail_theta_left u = catline . theta_left u
trail_theta_right :: Floating u => u -> Radian -> CatTrail u
trail_theta_right u = catline . theta_right u
trail_theta_north :: Floating u => u -> Radian -> CatTrail u
trail_theta_north = trail_theta_up
trail_theta_south :: Floating u => u -> Radian -> CatTrail u
trail_theta_south = trail_theta_down
trail_theta_east :: Floating u => u -> Radian -> CatTrail u
trail_theta_east = trail_theta_right
trail_theta_west :: Floating u => u -> Radian -> CatTrail u
trail_theta_west = trail_theta_left
trail_theta_north_east :: Floating u => u -> Radian -> CatTrail u
trail_theta_north_east u = catline . theta_north_east u
trail_theta_north_west :: Floating u => u -> Radian -> CatTrail u
trail_theta_north_west u = catline . theta_north_west u
trail_theta_south_east :: Floating u => u -> Radian -> CatTrail u
trail_theta_south_east u = catline . theta_south_east u
trail_theta_south_west :: Floating u => u -> Radian -> CatTrail u
trail_theta_south_west u = catline . theta_south_west u
trail_theta_up_left :: Floating u => u -> Radian -> CatTrail u
trail_theta_up_left u = catline . theta_up_left u
trail_theta_up_right :: Floating u => u -> Radian -> CatTrail u
trail_theta_up_right u = catline . theta_up_right u
trail_theta_down_left :: Floating u => u -> Radian -> CatTrail u
trail_theta_down_left u = catline . theta_down_left u
trail_theta_down_right :: Floating u => u -> Radian -> CatTrail u
trail_theta_down_right u = catline . theta_down_right u
--------------------------------------------------------------------------------
--
-- DESIGN NOTE
--
-- Angle, unit width and number of repetitions (plus height etc.)
-- seems the best API, although this make fitting an issue.
--
sineWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u
sineWave i unit ang =
mconcat $ replicate i $ sineWave1 (0.25 * unit) unit ang
-- | One-phase sine wave. Height is parametric.
--
sineWave1 :: (Real u, Floating u)
=> u -> u -> Radian -> CatTrail u
sineWave1 h unit ang =
catcurve v1 (vdiff v1 v2) (vdiff v2 v3)
`mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
`mappend` catcurve (vdiff v6 v7) (vdiff v7 v8) (vdiff v8 v9)
`mappend` catcurve (vdiff v9 v10) (vdiff v10 v11) (vdiff v11 v12)
where
base1 = unit / 12
h2 = h * (pi / 6)
v1 = orthoVec base1 h2 ang
v2 = orthoVec (2*base1) h ang
v3 = orthoVec (3*base1) h ang
v4 = orthoVec (4*base1) h ang
v5 = orthoVec (5*base1) h2 ang
v6 = orthoVec (6*base1) 0 ang
v7 = orthoVec (7*base1) (-h2) ang
v8 = orthoVec (8*base1) (-h) ang
v9 = orthoVec (9*base1) (-h) ang
v10 = orthoVec (10*base1) (-h) ang
v11 = orthoVec (11*base1) (-h2) ang
v12 = orthoVec (12*base1) 0 ang
kappa :: Floating u => u
kappa = 4 * ((sqrt 2 - 1) / 3)
-- DESIGN NOTE - different functions for CW and CCW or same
-- function with @ClockDirection@ as first argument?
-- | 'semicircleCW' : @ base_vector -> CatTrail @
--
-- Make a clockwise semicircle from two Bezier curves. Although
-- this function produces an approximation of a semicircle, the
-- approximation seems fine in practice.
--
semicircleCW :: (Real u, Floating u) => Vec2 u -> CatTrail u
semicircleCW base_vec =
catcurve v1 (vdiff v1 v2) (vdiff v2 v3)
`mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
where
circum = vlength base_vec
radius = 0.5 * circum
ang = vdirection base_vec
rl = radius * kappa
v1 = orthoVec 0 rl ang
v2 = orthoVec (radius - rl) radius ang
v3 = orthoVec radius radius ang
v4 = orthoVec (radius + rl) radius ang
v5 = orthoVec circum rl ang
v6 = orthoVec circum 0 ang
-- | 'semicircleCCW' : @ base_vector_vector -> CatTrail @
--
-- Make a counter-clockwise semicircle from two Bezier curves.
-- Although this function produces an approximation of a
-- semicircle, the approximation seems fine in practice.
--
semicircleCCW :: (Real u, Floating u) => Vec2 u -> CatTrail u
semicircleCCW base_vec =
catcurve v1 (vdiff v1 v2) (vdiff v2 v3)
`mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
where
circum = vlength base_vec
radius = 0.5 * circum
ang = vdirection base_vec
rl = radius * kappa
v1 = orthoVec 0 (-rl) ang
v2 = orthoVec (radius - rl) (-radius) ang
v3 = orthoVec radius (-radius) ang
v4 = orthoVec (radius + rl) (-radius) ang
v5 = orthoVec circum (-rl) ang
v6 = orthoVec circum 0 ang
-- | 'minorCircleSweepCW' : @ angle * radius * inclination -> CatTrail @
--
-- > ang should be in the range 0 < ang <= 90deg.
--
minorCircleSweepCW :: (Real u, Floating u)
=> Radian -> u -> Radian -> CatTrail u
minorCircleSweepCW ang radius theta =
catcurve (pvec p0 p1) (pvec p1 p2) (pvec p2 p3)
where
kfactor = fromRadian $ ang / (0.5*pi)
rl = kfactor * radius * kappa
totang = circularModulo $ theta + (half_pi - ang)
p0 = displace (theta_up radius theta) zeroPt
p1 = displace (theta_right rl theta) p0
p2 = displace (theta_up rl totang) p3
p3 = displace (avec totang radius) zeroPt
-- | 'minorCircleSweepCCW' : @ angle * radius * inclination -> CatTrail @
--
-- > ang should be in the range 0 < ang <= 90deg.
--
minorCircleSweepCCW :: (Real u, Floating u)
=> Radian -> u -> Radian -> CatTrail u
minorCircleSweepCCW ang radius theta =
catcurve (pvec p0 p1) (pvec p1 p2) (pvec p2 p3)
where
kfactor = fromRadian $ ang / (0.5*pi)
rl = kfactor * radius * kappa
totang = circularModulo $ theta - half_pi + ang
p0 = displace (theta_down radius theta) zeroPt
p1 = displace (theta_right rl theta) p0
p2 = displace (theta_down rl totang) p3
p3 = displace (avec totang radius) zeroPt
-- | 'circleSweepCW' : @ apex_angle * radius * inclination -> CatTrail @
--
-- > ang should be in the range 0 < ang < 360deg.
--
-- > if 0 < ang <= 90 returns 1 segment
-- > if 90 < ang <= 180 returns 2 segments
-- > if 180 < ang <= 270 returns 3 segments
-- > if 270 < ang < 360 returns 4 segmenets
--
circleSweepCW :: (Real u, Floating u)
=> Radian -> u -> Radian -> CatTrail u
circleSweepCW ang radius theta = go (circularModulo ang)
where
go a | a <= half_pi = wedge1 a
| a <= pi = wedge2 (a/2)
| a <= 1.5*pi = wedge3 (a/3)
| otherwise = wedge4 (a/4)
wedge1 a = minorCircleSweepCW a radius theta
wedge2 a = minorCircleSweepCW a radius theta
`mappend` minorCircleSweepCW a radius (theta-a)
wedge3 a = minorCircleSweepCW a radius theta
`mappend` minorCircleSweepCW a radius (theta - a)
`mappend` minorCircleSweepCW a radius (theta - 2*a)
wedge4 a = minorCircleSweepCW a radius theta
`mappend` minorCircleSweepCW a radius (theta - a)
`mappend` minorCircleSweepCW a radius (theta - 2*a)
`mappend` minorCircleSweepCW a radius (theta - 3*a)
-- | 'circleSweepCCW' : @ apex_angle * radius * inclination -> CatTrail @
--
-- > ang should be in the range 0 < ang < 360deg.
--
-- > if 0 < ang <= 90 returns 1 segment
-- > if 90 < ang <= 180 returns 2 segments
-- > if 180 < ang <= 270 returns 3 segments
-- > if 270 < ang < 360 returns 4 segmenets
--
circleSweepCCW :: (Real u, Floating u)
=> Radian -> u -> Radian -> CatTrail u
circleSweepCCW ang radius theta = go (circularModulo ang)
where
go a | a <= half_pi = wedge1 a
| a <= pi = wedge2 (a/2)
| a <= 1.5*pi = wedge3 (a/3)
| otherwise = wedge4 (a/4)
wedge1 a = minorCircleSweepCCW a radius theta
wedge2 a = minorCircleSweepCCW a radius theta
`mappend` minorCircleSweepCCW a radius (theta+a)
wedge3 a = minorCircleSweepCCW a radius theta
`mappend` minorCircleSweepCCW a radius (theta+a)
`mappend` minorCircleSweepCCW a radius (theta+a+a)
wedge4 a = minorCircleSweepCCW a radius theta
`mappend` minorCircleSweepCCW a radius (theta+a)
`mappend` minorCircleSweepCCW a radius (theta+a+a)
`mappend` minorCircleSweepCCW a radius (theta+a+a+a)
-- | inclination is the inclination of the chord.
--
circularArcCW :: (Real u, Floating u) => Radian -> u -> Radian -> CatTrail u
circularArcCW apex_ang radius inclin =
circleSweepCW apex_ang radius (inclin + 0.5 * apex_ang)
-- | inclination is the inclination of the chord.
--
circularArcCCW :: (Real u, Floating u) => Radian -> u -> Radian -> CatTrail u
circularArcCCW apex_ang radius inclin =
circleSweepCCW apex_ang radius (inclin - 0.5 * apex_ang)
-- | Proper semicircles do not make a good squiggle (it needs a
-- bit of pinch).
--
squiggleWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u
squiggleWave i unit ang = mconcat $ replicate i $ squiggle1 unit ang
squiggle1 :: (Real u, Floating u) => u -> Radian -> CatTrail u
squiggle1 unit ang =
catcurve v1 (vdiff v1 v2) (vdiff v2 v3)
`mappend` catcurve (vdiff v3 v4) (vdiff v4 v5) (vdiff v5 v6)
`mappend` catcurve (vdiff v6 v7) (vdiff v7 v8) (vdiff v8 v9)
`mappend` catcurve (vdiff v9 v10) (vdiff v10 v11) (vdiff v11 v12)
where
four_radius = unit
radius = 0.25 * four_radius
two_radius = 0.5 * four_radius
three_radius = 0.75 * four_radius
rl = radius * kappa
micro = 0.33 * rl -- seems good
v1 = orthoVec micro rl ang
v2 = orthoVec (radius - rl) radius ang
v3 = orthoVec radius radius ang
v4 = orthoVec (radius + rl) radius ang
v5 = orthoVec (two_radius - micro) rl ang
v6 = orthoVec two_radius 0 ang
v7 = orthoVec (two_radius + micro) (-rl) ang
v8 = orthoVec (three_radius - rl) (-radius) ang
v9 = orthoVec three_radius (-radius) ang
v10 = orthoVec (three_radius + rl) (-radius) ang
v11 = orthoVec (four_radius - micro) (-rl) ang
v12 = orthoVec four_radius 0 ang
squareWave :: Floating u => Int -> u -> Radian -> CatTrail u
squareWave n unit ang
| n > 0 = monPreRepeatPost up_half (n - 1,kont) fin
| otherwise = mempty
where
up_half = catline $ theta_up (0.25 * unit) ang
up_one = catline $ theta_up (0.5 * unit) ang
down_one = catline $ theta_down (0.5 * unit) ang
right_half = catline $ theta_right (0.5 * unit) ang
kont = right_half `mappend` down_one `mappend` right_half
`mappend` up_one
fin = right_half `mappend` down_one `mappend` right_half
`mappend` up_half
-- |
--
sawtoothWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u
sawtoothWave n unit ang
| n > 0 = monPreRepeatPost up_half (n - 1,kont) fin
| otherwise = mempty
where
up_half = catline $ theta_up_right (0.25 * unit) ang
up_one = catline $ theta_up_right (0.5 * unit) ang
down_one = catline $ theta_down_right (0.5 * unit) ang
kont = down_one `mappend` up_one
fin = down_one `mappend` up_half
semicircleWave :: (Real u, Floating u)
=> ClockDirection -> Int -> u -> Radian -> CatTrail u
semicircleWave cdir i unit ang =
mconcat $ replicate i $ fn cdir (avec ang unit)
where
fn CCW = semicircleCCW
fn _ = semicircleCW
--------------------------------------------------------------------------------
-- | Curve in a triangle.
--
tricurve :: Floating u => u -> u -> Radian -> CatTrail u
tricurve bw h ang = catcurve v1 zeroVec v2
where
v1 = orthoVec (0.5 * bw) h ang
v2 = orthoVec (0.5 * bw) (-h) ang
-- | Curve in a rectangle.
--
rectcurve :: Floating u => u -> u -> Radian -> CatTrail u
rectcurve bw h ang = catcurve v1 v2 v3
where
v1 = orthoVec 0 h ang
v2 = orthoVec bw 0 ang
v3 = orthoVec 0 (-h) ang
-- | Curve in a trapezium (CW).
--
trapcurveCW :: Floating u => u -> u -> Radian -> Radian -> CatTrail u
trapcurveCW bw h interior_ang ang = catcurve v1 v2 v3
where
minor_bw = h / (fromRadian $ tan interior_ang)
v1 = orthoVec minor_bw h ang
v2 = orthoVec (bw - (2 * minor_bw)) 0 ang
v3 = orthoVec minor_bw (-h) ang
-- | Curve in a trapezium (CCW).
--
trapcurveCCW :: Floating u => u -> u -> Radian -> Radian -> CatTrail u
trapcurveCCW bw h interior_ang ang = catcurve v1 v2 v3
where
minor_bw = h / (fromRadian $ tan interior_ang)
v1 = orthoVec minor_bw (-h) ang
v2 = orthoVec (bw - (2 * minor_bw)) 0 ang
v3 = orthoVec minor_bw h ang
-- | Curve in half a /bowtie/.
--
bowcurve :: Floating u => u -> u -> Radian -> CatTrail u
bowcurve bw h ang = catcurve v1 v2 v3
where
v1 = orthoVec 0 h ang
v2 = orthoVec bw (-h) ang
v3 = orthoVec 0 h ang
-- | Wedge curve formed inside a bowtie rotated by 90deg.
--
wedgecurve :: Floating u => u -> u -> Radian -> CatTrail u
wedgecurve bw h ang = catcurve v1 v2 v3
where
v1 = orthoVec bw h ang
v2 = orthoVec (-bw) 0 ang
v3 = orthoVec bw (-h) ang
-- | Variation of wedge curve that draws a loop.
--
loopcurve :: Floating u => u -> u -> Radian -> CatTrail u
loopcurve bw h ang = catcurve v1 v2 v3
where
ww = 2.0 * bw
v1 = orthoVec (1.5 * bw) h ang
v2 = orthoVec (-ww) 0 ang
v3 = orthoVec (1.5 * bw) (-h) ang