```{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Drawing.Extras.Loop
-- Copyright   :  (c) Stephen Tetley 2011
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Open loop for a circle (useful for automata diagrams).
--
--------------------------------------------------------------------------------

module Wumpus.Drawing.Extras.Loop
(
loop
, loopPoints
) where

import Wumpus.Drawing.Paths.Absolute

import Wumpus.Basic.Geometry.Base               -- package: wumpus-basic
import Wumpus.Basic.Kernel
import Wumpus.Core                              -- package: wumpus-core

import Data.AffineSpace                         -- package: vector-space

-- TODO - Loop is a decoration not a connector.
-- It should probably have the same signature as wedge / arc.

-- | Generate a loop - suitable for decorating a circle.
--
-- The radius and the (implicit) start point are the center and
-- radius of the initial circle not the loop itself.
--
loop :: (Real u, Floating u, InterpretUnit u, Tolerance u)
=> u -> Point2 u -> Radian -> Query u (AbsPath u)
loop zradius zctr ang = return \$ curvePath \$ loopPoints zradius zctr ang

-- Should be able to use trig to get a loop suitable for
-- decorating rectangles (provided the start-to-end arc is smaller
-- than the side length

-- | Note - intermediate names and quadrants represent a loop
-- drawn upwards.
--
loopPoints :: (Real u, Floating u) => u -> Point2 u -> Radian -> [Point2 u]
[ startl, cp1, cp2, kitel, cp3, cp4, top, cp5, cp6, kiter, cp7, cp8, startr ]
where
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
top_right   = negate \$ 0.8 * circ_radius

top         = dispParallel height incl circ_ctr
kiter       = dispOrtho (V2 hminor (-hw)) incl circ_ctr
kitel       = dispOrtho (V2 hminor (hw) ) incl circ_ctr

startr      = circ_ctr .+^ avec (circularModulo \$ incl - theta) circ_radius
startl      = circ_ctr .+^ avec (circularModulo \$ incl + theta) circ_radius

cp1         = startl .+^ end_vec
cp2         = dispParallel minor_down incl kitel