{-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Wumpus.Basic.Geometry.Quadrant -- Copyright : (c) Stephen Tetley 2011 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com> -- Stability : highly unstable -- Portability : GHC -- -- Quadrants and trigonometric calculations. -- -- \*\* - WARNING \*\* - in progress. -- -------------------------------------------------------------------------------- module Wumpus.Basic.Geometry.Quadrant ( Quadrant(..) , quadrant , qiModulo , rectRadialVector , rectangleQI , diamondRadialVector , triangleRadialVector , triangleQI , rightTrapezoidQI , rightTrapeziumBaseWidth ) where import Wumpus.Core -- package: wumpus-core data Quadrant = QUAD_NE | QUAD_NW | QUAD_SW | QUAD_SE deriving (Enum,Eq,Ord,Show) -- | 'quadrant' : @ ang -> Quadrant @ -- -- Get the quadrant of an angle. -- quadrant :: Radian -> Quadrant quadrant = fn . circularModulo where fn a | a < 0.5*pi = QUAD_NE | a < pi = QUAD_NW | a < 1.5*pi = QUAD_SW | otherwise = QUAD_SE -- | 'qiModulo' : @ ang -> Radian @ -- -- Modulo an angle so it lies in quadrant I (north east), -- i.e. modulo into the range @0..(pi/2)@. -- qiModulo :: Radian -> Radian 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). -- -- Internally the calculation is made in quadrant I (north east), -- 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). -- -- Internally the calculation is made in quadrant I (north east), -- 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) => u -> u -> Radian -> Radian -> Vec2 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)