{-|
  WrapAround is a convenience module which helps you perform calculations with
  points that are supposed to exist on a 2-dimensional, finite, unbounded plane.
  (Or infinite, bounded plane, depending on who you ask.) On such a plane, space
  wraps around so that an object travelling vertically or horizontally eventually
  comes back to the place where it started. This allows you to move objects
  around on a seamless map. For example, in some video games when an object
  crosses the bottom of the screen it reappears at the top.

  WrapAround represents the points and handles the common calculations properly
  so you don't have to bother with the messy math and edge cases. This is done
  with two data structures: a 'WrapMap', which stores information about the size
  of the plane, and a 'WrapPoint', which stores information about the location of
  the point.

  A WrapPoint is represented internally as a pair of angles, like in a torus.
  The WrapMap and WrapPoint structures are kept separate because some WrapPoint
  calculations can be performed without a WrapMap context. Functions typically
  only need a WrapMap when a WrapPoint must be converted to actual x, y
  coordinates or vice versa. You can perform calculations mixing WrapPoints that
  were generated with different WrapMaps, but this generally yields meaningless
  results.

  When you need the actual x, y coordinates, use the 'toCoords' conversion
  function.

  If you are grateful for this software, I gladly accept donations!

  <https://frigidcode.com/donate/>
-}
module Data.WrapAround ( WrapMap()
                       , wrapmap
                       , WrapPoint()
                       , wrappoint
                       , addPoints
                       , addPoints'
                       , distance
                       , subtractPoints
                       , toCoords
                       , vectorRelation
                       -- , windowView
                       -- , WrapWindow(..)
                       ) where

-- |Contains the contextual information necessary to convert a WrapPoint to
-- coordinates and vice versa.
data WrapMap = WrapMap { radiusr :: Double -- radius from tube center
                       , radiusR :: Double -- radius from torus center
                       }
  deriving (Show)

-- |Generates a 'WrapMap'.
wrapmap :: Double   -- ^ Width
        -> Double   -- ^ Height
        -> WrapMap
wrapmap width height = WrapMap { radiusR = height / (2 * pi)
                               , radiusr = width / (2 * pi)
                               }

-- |A representation of a point location that allows for wrapping in the
-- vertical or horizontal direction.
data WrapPoint = WrapPoint { angler :: Double -- radians around tube center
                           , angleR :: Double -- radians around torus center
                           }
  deriving (Show)

-- |Generates a 'WrapPoint'.
wrappoint :: WrapMap           -- ^ Corresponding WrapMap structure
          -> (Double, Double)  -- ^ x, y coordinates
          -> WrapPoint
wrappoint wmap (x, y)
  = let angleR' = fixAngle (y / radiusR wmap) in 
    let angler' = fixAngle (x / radiusr wmap) in
    WrapPoint { angleR = angleR', angler = angler' }

-- |Converts a WrapPoint to x, y coordinates. Generally you will only will only
-- want to use this function for informational purposes, for example, to print
-- out the x, y coordinates or to feed the coordinates to a graphics display
-- function. If you convert a WrapPoint to x, y coordinates so that you can
-- perform calculations with the coordinates, you must handle the wrapping math
-- yourself and you are doing the work the module is supposed to do for you.
toCoords :: WrapMap          -- ^ Corresponding WrapMap structure
         -> WrapPoint        -- ^ WrapPoint to be converted
         -> (Double, Double)
toCoords WrapMap { radiusR = mRadiusR, radiusr = mRadiusr }
         WrapPoint { angleR = pAngleR, angler = pAngler }
  = (pAngler * mRadiusr, pAngleR * mRadiusR)

-- |Adds two WrapPoints together (vector style).
addPoints :: WrapPoint  -- ^ The first WrapPoint in the operation
          -> WrapPoint  -- ^ The WrapPoint to be added to the first WrapPoint
          -> WrapPoint
addPoints wp1 wp2
  = let angleR' = fixAngle (angleR wp1 + angleR wp2) in
    let angler' = fixAngle (angler wp1 + angler wp2) in
    WrapPoint { angleR = angleR', angler = angler' }

-- |Adds a WrapPoint and a pair of x, y coordinates (vector style).
addPoints' :: WrapMap           -- ^ The corresponding WrapMap structure
           -> WrapPoint         -- ^ The WrapPoint in the operation
           -> (Double, Double)  -- ^ The x, y coordinates to be added to the WrapPoint
           -> WrapPoint
addPoints' wmap wp1 (x, y)
  = let wp2 = wrappoint wmap (x, y) in
    let angleR' = fixAngle (angleR wp1 + angleR wp2) in
    let angler' = fixAngle (angler wp1 + angler wp2) in
    WrapPoint { angleR = angleR', angler = angler' }

-- |Subtracts a WrapPoint from a WrapPoint (vector style).
subtractPoints :: WrapPoint  -- ^ The first WrapPoint in the operation
               -> WrapPoint  -- ^ The WrapPoint to be subtracted from the first WrapPoint
               -> WrapPoint
subtractPoints wp1 wp2
  = let angleR' = fixAngle (angleR wp1 - angleR wp2) in
    let angler' = fixAngle (angler wp1 - angler wp2) in
    WrapPoint { angleR = angleR', angler = angler' }

-- distance :: WrapMap -> WrapPoint -> WrapPoint -> Double
-- distance WrapMap { radiusR = mRadiusR, radiusr = mRadiusr }
--          WrapPoint { angleR = p1angleR, angler = p1angler }
--          WrapPoint { angleR = p2angleR, angler = p2angler }
--   = let dXa = abs (p2angler - p1angler) in
--     let dYa = abs (p2angleR - p1angleR) in
--     let dXb = if p1angler < p2angler
--                 then abs ((p1angler + 2 * pi) - p2angler)
--                 else abs ((p1angler - 2 * pi) - p2angler) in
--     let dYb = if p1angleR < p2angleR
--                 then abs ((p1angleR + 2 * pi) - p2angleR)
--                 else abs ((p1angleR - 2 * pi) - p2angleR) in
--     let dX = min dXa dXb in
--     let dY = min dYa dYb in
--     let dX' = dX * mRadiusr in
--     let dY' = dY * mRadiusR in
--     sqrt (dX'**2 + dY'**2)


-- |Finds the distance between two WrapPoints.
distance :: WrapMap    -- ^ The corresponding WrapMap structure
         -> WrapPoint  -- ^ The first WrapPoint
         -> WrapPoint  -- ^ The second WrapPoint
         -> Double
distance wmap wp1 wp2
  = let (dX, dY) = vectorRelation wmap wp1 wp2 in
     sqrt (dX**2 + dY**2)

fixAngle :: Double -> Double
fixAngle radians
  = let q = radians / (2 * pi) in
    let angle = radians - fromIntegral (truncate q) * (2 * pi) in
    if angle < 0 then 2 * pi + angle
                 else angle

-- |Returns the relationship between two WrapPoints as a pair of x, y
-- coordinates (a vector).
vectorRelation :: WrapMap          -- ^ The corresponding WrapMap structure
               -> WrapPoint        -- ^ The first WrapPoint
               -> WrapPoint        -- ^ The second WrapPoint
               -> (Double, Double)
vectorRelation WrapMap { radiusR = mRadiusR, radiusr = mRadiusr }
               WrapPoint { angleR = p1angleR, angler = p1angler }
               WrapPoint { angleR = p2angleR, angler = p2angler }
  = let dXa = abs (p2angler - p1angler) in
    let dYa = abs (p2angleR - p1angleR) in
    let dXb = if p1angler < p2angler
                then abs ((p1angler + 2 * pi) - p2angler)
                else abs ((p1angler - 2 * pi) - p2angler) in
    let dYb = if p1angleR < p2angleR
                then abs ((p1angleR + 2 * pi) - p2angleR)
                else abs ((p1angleR - 2 * pi) - p2angleR) in
    let dX = min dXa dXb in
    let dY = min dYa dYb in
    let dX' = dX * mRadiusr in
    let dY' = dY * mRadiusR in
    (dX', dY')

-- Maybe add these someday after I find them useful

-- data WrapWindow = WrapWindow { tlCorner :: (Double, Double)
--                              , width :: Double
--                              , height :: Double
--                              , wrapMap :: WrapMap
--                              }

-- windowView :: WrapWindow -> WrapPoint -> WrapPoint -> (Double, Double)
-- windowView window centerpoint point
--   = let cornerPoint = addPoints'
--                         (wrapMap window)
--                         centerpoint
--                         ((-width window) / 2.0, height window / 2.0) in
--     let (vx, vy) = vectorRelation (wrapMap window) cornerPoint point in
--     let vx' = vx in
--     let vy' = (-vy) in
--     (vx' + fst (tlCorner window), vy' + snd (tlCorner window))