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

--------------------------------------------------------------------------------
-- |
-- Copyright   :  (c) Stephen Tetley 2011
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
--
-- \*\* - WARNING \*\* - in progress.
--
--------------------------------------------------------------------------------

(

, qiModulo

, rectangleQI

, triangleQI
, rightTrapezoidQI

, rightTrapeziumBaseWidth

)
where

import Wumpus.Core                              -- package: wumpus-core

deriving (Enum,Eq,Ord,Show)

--
-- Get the quadrant of an angle.
--
where
fn a | a < 0.5*pi   = QUAD_NE
| a < pi       = QUAD_NW
| a < 1.5*pi   = QUAD_SW

-- | 'qiModulo' : @ ang -> Radian @
--
-- Modulo an angle so it lies in quadrant I (north east),
-- i.e. modulo into the range @0..(pi/2)@.
--
qiModulo r = d2r \$ dec + (fromIntegral \$ i `mod` 90)
where
i       :: Integer
dec     :: Double
(i,dec) = properFraction \$ r2d r

--------------------------------------------------------------------------------

negateX :: Num u => Vec2 u -> Vec2 u
negateX (V2 x y) = V2 (-x) y

negateY :: Num u => Vec2 u -> Vec2 u
negateY (V2 x y) = V2 x (-y)

negateXY :: Num u => Vec2 u -> Vec2 u
negateXY (V2 x y) = V2 (-x) (-y)

-- | 'rectRadialVector' : @ half_width * half_height * ang -> Vec @
--
-- Find where a radial line extended from (0,0) with the elevation
-- @ang@ intersects with an enclosing rectangle. The rectangle is
-- centered at (0,0).
--
-- symmetry is used to translate result to the other quadrants.
--
rectRadialVector :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u
rectRadialVector hw hh ang = fn \$ circularModulo ang
where
fn a | a < 0.5*pi   = rectangleQI hw hh a
| a < pi       = negateX  \$ rectangleQI hw hh (pi - a)
| a < 1.5*pi   = negateXY \$ rectangleQI hw hh (a - pi)
| otherwise    = negateY  \$ rectangleQI hw hh (2*pi - a)

-- | 'rectangleQI' : @ width * height * ang -> Vec @
--
-- Find where a line from (0,0) in direction @ang@ intersects the
-- top or right side of a rectangle in QI (left side is the
-- y-axis, bottom is the x-axis).
--
-- > ang must be in the @range 0 < ang <= 90 deg@.
-- >
-- > width and height must be positive.
--
rectangleQI :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u
rectangleQI w h ang
| ang < theta  = let y = w * fromRadian (tan ang) in V2 w y
| otherwise    = let x = h / fromRadian (tan ang) in V2 x h
where
theta               = toRadian \$ atan (h/w)

-- | 'diamondRadialVector' : @ half_width * half_height * ang -> Vec @
--
-- Find where a radial line extended from (0,0) with the elevation
-- @ang@ intersects with an enclosing diamond. The diamond is
-- centered at (0,0).
--
-- symmetry is used to translate result to the other quadrants.
--
diamondRadialVector :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u
diamondRadialVector hw hh ang = fn \$ circularModulo ang
where
fn a | a < 0.5*pi   = triangleQI hw hh a
| a < pi       = negateX  \$ triangleQI hw hh (pi - a)
| a < 1.5*pi   = negateXY \$ triangleQI hw hh (a - pi)
| otherwise    = negateY  \$ triangleQI hw hh (2*pi - a)

-- | 'triangleRadialVector' : @ half_base_width * height_minor *
--        height_minor * ang -> Vec @
--
-- Find where a radial line extended from (0,0) with the elevation
-- @ang@ intersects with an enclosing triangle. The triangle has
-- the centroid at (0,0), so solutions in quadrants I and II are
-- intersections with a simple line. Intersections in quadrants
-- III and IV can intersect either the respective side or the
-- base.
--
--
triangleRadialVector :: (Real u, Floating u) => u -> u -> u -> Radian -> Vec2 u
triangleRadialVector hbw hminor hmajor ang = fn \$ circularModulo ang
where
fn a | a < 0.5*pi   = triangleQI major_width hmajor a
| a < pi       = negateX  \$ triangleQI major_width hmajor (pi - a)
| a < 1.5*pi   = negateXY \$ rightTrapezoidQI hbw hminor base_rang (a - pi)
| otherwise    = negateY  \$ rightTrapezoidQI hbw hminor base_rang (2*pi - a)

height              = hmajor + hminor
base_rang           = toRadian \$ atan (height / hbw)
major_width         = hmajor / (fromRadian \$ tan base_rang)

-- | 'triangleQI' : @ width * height * ang -> Vec @
--
-- Find where a line from (0,0) with elevation @ang@ intersects
-- the hypotenuse a right triangle in QI (the legs of the triangle
-- take the x and y-axes).
--
-- > ang must be in the @range 0 < ang <= 90@.
-- >
-- > width and height must be positive.
--
triangleQI :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u
triangleQI w h ang = avec ang dist
where
base_ang = atan (h / w)
apex     = pi - (base_ang + fromRadian ang)
dist     = sin base_ang * (w / sin apex)

-- | 'rightTrapezoidQI' : @ top_width * height * top_right_ang -> Vec @
--
-- Find where a line from (0,0) with elevation @ang@ intersects
-- the either the lines A_B or B_D in a right trapezoid in QI.
--
-- The right trapezoid has a variable right side. Left side is the
-- y-axis (C_A), bottom side is the x-axis (C_D), top side is
-- parallel to the x-axis (A_B).
--
-- >  A   B
-- >  -----
-- >  |    \
-- >  |     \
-- >  -------
-- >  C      D
--
-- >  A      B
-- >  -------
-- >  |     /
-- >  |    /
-- >  -----
-- >  C   D
--
-- > ang must be in the range 0 < ang <= 90.
-- >
-- > top_width and height must be positive.
--
rightTrapezoidQI :: (Real u, Floating u)
rightTrapezoidQI tw h top_rang ang =
if w0 <= tw then dv else avec ang minor_dist
where
-- dist is hypotenuse of a right triangle1
dist         = h / (fromRadian \$ sin ang)

-- potentially this vector is *too long*.
dv@(V2 w0 _) = avec ang dist

-- this is dist *cut short* because it intersects the right
-- side rather than the top
minor_dist   = triangleLeftSide base_width ang lr_ang

lr_ang       = pi - top_rang

base_width   = rightTrapeziumBaseWidth tw h top_rang

-- Legend:
--
-- > @top_rang@ is A/B\C.
-- >
-- > @ang@ is B/C\D.
-- >
-- > w (width) is A_B.
--
-- > h (height) is C_A.
--
-- >  A     B
-- >  ------
-- >  |    / .
-- >  |   /   .
-- >  |  /     .
-- >  | /       .
-- >  |/..........
-- >  C          D
--
-- Synthetically:
--
-- > Right triangle 1 is ABC.
-- >
-- > @dist@ is C_B.
-- >
-- > @base_width@ is C_D.
-- >
-- > @lr_ang is C/D\B.
--

-- | 'traingleLeftSide' : @ base_width * left_ang * right_ang -> Length @
--
-- >
-- >        C
-- >       /\
-- >      /  \
-- >     /    \
-- >    /      \
-- >   /________\
-- >  A          B
-- >
--
-- > Calculate A_C given side A_B, angle C/A\B and angle A/B\C.
--
triangleLeftSide :: Fractional u => u -> Radian -> Radian -> u
triangleLeftSide base_width lang rang =
(fromRadian \$ sin rang) / factor
where
apex   = pi - (lang + rang)
factor = (fromRadian \$ sin apex) / base_width

-- | 'rightTrapeziumBaseWidth' : @ top_width * height * top_right_ang -> Length @
--
-- Find the length of the line C_D:
--
-- >  A   B
-- >  -----
-- >  |    \
-- >  |     \
-- >  -------
-- >  C      D
--
-- >  A      B
-- >  -------
-- >  |     /
-- >  |    /
-- >  -----
-- >  C   D
--
--
rightTrapeziumBaseWidth :: Fractional u => u -> u -> Radian -> u
rightTrapeziumBaseWidth tw h tr_ang
| tr_ang < half_pi = tw - shorten
| tr_ang > half_pi = tw + extend
| otherwise        = tw
where
half_pi  = 0.5*pi
shorten  = h / fromRadian (tan tr_ang)
extend   = let lr_ang = pi - tr_ang in h / fromRadian (tan lr_ang)
```