module Wumpus.Drawing.Extras.Loop
(
loopPath
, loopTrail
) where
import Wumpus.Drawing.Paths
import Wumpus.Basic.Kernel
import Wumpus.Core
import Data.AffineSpace
import Data.Monoid
loopPath :: (Real u, Floating u, InterpretUnit u, Tolerance u)
=> u -> Point2 u -> Radian -> AbsPath u
loopPath zradius ctr incl = anaTrailPath ctr $ loopTrail zradius incl
loopTrail :: (Real u, Floating u) => u -> Radian -> AnaTrail u
loopTrail circ_radius incl =
anaCatTrail (pvec zeroPt startl) $
mconcat [ diffCurve startl cp1 cp2 kitel
, diffCurve kitel cp3 cp4 top
, diffCurve top cp5 cp6 kiter
, diffCurve kiter cp7 cp8 startr
]
where
hw = 1.25 * circ_radius
height = 3.8 * circ_radius
hminor = 2.72 * circ_radius
hbase = circ_radius / 3
theta = toRadian $ asin $ hbase / circ_radius
start_vec = avec (circularModulo $ incl quarter_pi) (0.26 * circ_radius)
end_vec = avec (circularModulo $ incl + quarter_pi) (0.26 * circ_radius)
minor_down = negate $ 0.8 * circ_radius
major_up = 0.52 * circ_radius
top_right = negate $ 0.8 * circ_radius
top_left = 0.8 * circ_radius
top = dispParallel height incl zeroPt
kiter = dispOrtho hminor (hw) incl zeroPt
kitel = dispOrtho hminor hw incl zeroPt
startr = zeroPt .+^ avec (circularModulo $ incl theta) circ_radius
startl = zeroPt .+^ avec (circularModulo $ incl + theta) circ_radius
cp1 = startl .+^ end_vec
cp2 = dispParallel minor_down incl kitel
cp3 = dispParallel major_up incl kitel
cp4 = dispPerpendicular top_left incl top
cp5 = dispPerpendicular top_right incl top
cp6 = dispParallel major_up incl kiter
cp7 = dispParallel minor_down incl kiter
cp8 = startr .+^ start_vec