-- | 2D Point computation library
--
-- TODO
--
-- * delete/select targets in specific cone
--

{-# LANGUAGE
	GADTs
      , MultiParamTypeClasses
  #-}


module Satter.TwoD
       (
         -- * Two Dimension Data
         TwoD
       , near2
       , akin
       , akin2
       , directionTo
       , repulse
       , asDirection
       , distance
       , (<->)
       , inRegion
       , dropLength
       , covered
       )
       where

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

type TwoD = (Double, Double)

near2 :: Double -> TwoD -> TwoD -> Bool
near2 threshold (x1, y1) (x2, y2) = sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2) <= threshold

near :: Double -> Double -> Double -> Bool
near threshold a b = abs (a - b) < threshold

akin v a b d
  | 0 < sign * (v * d) = 1.1 * v * sign
  | otherwise = 0.5 * v * sign
  where sign = signum (b - a)

akin2 v a b = v * signum (b - a)

directionTo :: TwoD -> TwoD -> TwoD
directionTo (x, y) (gx, gy)
 | len == 0 = (0, 0)            -- error "called directionTo with the same points"
 | otherwise = ((gx - x) / len, (gy - y) / len)
  where
    len = sqrt $ (gx - x) ** 2 + (gy - y) ** 2

repulse :: Double -> Double
repulse 0 = 1
repulse p = if abs p < 0.3 then signum p * 1 else p

asDirection :: Double -> TwoD
asDirection rad = (cos th, negate (sin th))
  where th = pi * rad / 180

newtype RadSystem = RadSystem (Double, Double)
                    deriving (Eq, Ord, Read, Show)

toRad :: TwoD -> TwoD -> RadSystem
toRad (x0, y0) (x', y')
  | 0 < x && 0 <= y  = RadSystem (atan th, r)              -- 1st region
  | x == 0 && 0 <= y = RadSystem (pi / 2, r)               -- on x = 0
  | x < 0 && 0 <= y  = RadSystem (pi / 2 + atan th, r)     -- 2nd region
  | x < 0 && y < 0   = RadSystem (pi + atan th, r)         -- 3rd region
  | x == 0 && y <= 0 = RadSystem (3 * pi / 2, r)           --  no x = 0
  | 0 < x && y < 0   = RadSystem (3 * pi / 2 + atan th, r) -- 3th region
  where
    x = x' - x0
    y = y' - y0
    th = abs $ y / x
    r = sqrt $ x ** 2 + y ** 2

-- | return True if A `cover` B within tolerance @t@
-- >>> cover 0 (RadSystem (1, 0)) (RadSystem (1, 0.001)
-- True
--
-- >>> cover 0.1 (RadSystem (1, 0)) (RadSystem (1, 0.1)
-- True    
--
-- >>> cover 0 (RadSystem (1, 0)) (RadSystem (2, 0)
-- True
--
cover :: Double -> RadSystem -> RadSystem -> Bool
cover tor (RadSystem (th1, r1)) (RadSystem (th2, r2)) = nearTheta tor th1 th2 && r1 <= r2
  where
    nearTheta r th1 th2
      | 2 * pi < th1 + r && th2 < r = nearTheta r th1 (th2 + 2 * pi)
      | otherwise = abs (th1 - th2) < r

distance :: TwoD -> TwoD -> Double
distance (x, y) (x1, y1) = sqrt $ (x1 -x) ** 2 + (y1 - y) ** 2

(<->) = distance
--------------------------------------------------------------------------------

inRegion :: (TwoD, TwoD) -> TwoD -> Bool
inRegion ((x1, y1), (x2, y2)) (x, y) = (x1 <= x) && (x <= x2) && (y1 <= y) && (y <= y2)

-- | /tolerance/ shold be in [-1, 1] to compare with the cosine similarity
coveredBy :: Double -> TwoD -> TwoD -> TwoD -> Bool
coveredBy tolerance me eneny target = tolerance < x1 * x2 + y1 * y2
  where
    (x1, y1) = directionTo me eneny
    (x2, y2) = directionTo me target

-- | 直線に対する垂線の長さ。これはPlayer.hsとは定義が違うので注意
dropLength :: TwoD -> TwoD -> TwoD -> Double
dropLength (x1, y1) (x2, y2) (x, y)
  | x1 == x2 = abs $ x - x1
  | y1 == y2 = abs $ y - y1
  | (x1 - x) * (x2 - x) <= 0 = abs (a * x + b * y + c) / sqrt (a ** 2 + b ** 2)
  | otherwise = 0
  where
    a = y2 - y1
    b = x1 - x2
    c = (x2 - x1) * y1 - x1 * (y2 - y1)

-- | return True if @cand@ is `covered` by @obs@ within tolerance @tor@ from the view point of @at@
covered :: Double -> TwoD -> [TwoD] -> TwoD -> Bool
covered tor at obs cand = any (flip (cover tor) (toRad at cand)) $ map (toRad at) obs
