module View
  ( Location(..), zoom, translate, defLocation
  , Viewport(..), rotate, defViewport
  , Window(..), windowSize, defWindow
  , Colours(..), defColours, Colour(..)
  , Image(..), defImage
  , BufferSize(..), bufferSize
  , pixelLocation, delta, tileSize
  , visibleQuads, originQuad
  ) where

import Control.Monad (guard)
import Data.Bits (bit)
import Data.Ratio ((%))

import Fractal.RUFF.Types.Complex (Complex((:+)))

import QuadTree (Quad(..), Child(..), child)

data Location = Location
  { center :: !(Complex Rational)
  , radius :: !Double -- accurate enough for 1000 2x zoom levels
  }
  deriving (Read, Show, Eq)

zoom :: Double -> Location -> Location
zoom f l = l{ radius = radius l * f}

translate :: Complex Rational -> Location -> Location
translate u l = l{ center = center l + u }

data Viewport = Viewport
  { aspect :: !Double -- width / height
  , orient :: !Double -- in radians
  }
  deriving (Read, Show, Eq)

rotate :: Double -> Viewport -> Viewport
rotate a v = v{ orient = orient v + a }

data Window = Window
  { width  :: !Int
  , height :: !Int
  , supersamples :: !Double
  }
  deriving (Read, Show, Eq)

windowSize :: Window -> Int
windowSize w = ceiling . sqrt . (fromIntegral :: Int -> Double) . diagonal2 $ w

diagonal2 :: Window -> Int
diagonal2 w = width w * width w + height w * height w

resolution :: Window -> Double
resolution w = supersamples w * fromIntegral (windowSize w)

pixelLocation :: Window -> Viewport -> Location -> Double -> Double -> Complex Rational
pixelLocation w v l x y =
  let x' :+ y' = pixelLocation' w v l x y
  in  center l + (toRational x' :+ toRational y')

pixelLocation' :: Window -> Viewport -> Location -> Double -> Double -> Complex Double
pixelLocation' w v l x y =
  let p = sqrt (aspect v)
      w' = fromIntegral (width  w)
      h' = fromIntegral (height w)
      x1 = (2 * x - w') / w' * p
      y1 = (h' - 2 * y) / h' / p
      a = - orient v
      co = cos a
      si = sin a
      x2 =  co * x1 + si * y1
      y2 = -si * x1 + co * y1
      r = 2 * radius l
  in  (r * x2) :+ (r * y2)

data BufferSize = BufferSize
  { texels :: !Int -- power of two
  }
  deriving (Read, Show, Eq)

bufferSize :: Window -> BufferSize
bufferSize w = BufferSize{ texels = max tileSize . roundUp2 . ceiling . resolution $ w }

roundUp2 :: Int -> Int -- fails for too small and too large inputs
roundUp2 x = last . takeWhile (x >) . iterate (2 *) $ 1

level :: Location -> Int
level = floor . negate . logBase 2 . radius

radius' :: Location -> Double
radius' l = 0.5 ** fromIntegral (level l)

delta :: Location -> Double -- in [0,1)
delta l = logBase 2 $ radius' l / radius l

tileSize :: Int
tileSize = 256

tileLevel :: Location -> BufferSize -> Int
tileLevel l b = level l + (floor . logBase (2 :: Double) . fromIntegral) (texels b `div` tileSize)

tileOrigin :: Complex Rational
tileOrigin = negate $ 4 :+ 4

tileOriginRadius :: Complex Rational
tileOriginRadius = 8

bufferOrigin :: Location -> Quad -> Maybe (Complex Int)
bufferOrigin l Quad{ quadLevel = ql, quadWest = qw, quadNorth = qn } = do
  guard $ ql >= 0
  let qd = bit ql
      qc = (qw % qd) :+ (qn % qd)
      tx :+ ty = fromIntegral tileSize * fromIntegral qd * (qc - (center l - tileOrigin) / tileOriginRadius)
  return (floor tx :+ floor ty)

originQuad :: Location -> BufferSize -> Maybe Quad
originQuad l b =
  let cx :+ cy = center l
      ql = tileLevel l b
      qs = bit ql % 1
      qw = floor $ (cx + 4) / 8 * qs
      qn = floor $ (cy + 4) / 8 * qs
  in  if ql <= 0 then Nothing else Just Quad{ quadLevel = ql, quadWest = qw, quadNorth = qn }

bufferQuads :: Location -> BufferSize -> Maybe [(Complex Int, Quad)]
bufferQuads l b = do
  q0 <- originQuad l b
  i0 :+ j0 <- bufferOrigin l q0
  let m = texels b
      u = fromIntegral $ (m `div` 2) `div` tileSize
      v = fromIntegral $ (m `div` 2) `div` tileSize
  return
    [ (i :+ j, q0{ quadWest = w, quadNorth = n })
    | (i, w) <- takeWhile ((< m) . fst) $ [ i0, i0 + tileSize .. ] `zip` [ quadWest  q0 - u .. ]
    , (j, n) <- takeWhile ((< m) . fst) $ [ j0, j0 + tileSize .. ] `zip` [ quadNorth q0 - v .. ]
    ]

childQuads :: (Complex Int, Quad) -> [(Complex Int, Quad)]
childQuads (i :+ j, q) =
  let i0 = 2 * i
      j0 = 2 * j
      i1 = i0 + tileSize
      j1 = j0 + tileSize
  in  [ (i0 :+ j0, NorthWest `child` q)
      , (i0 :+ j1, SouthWest `child` q)
      , (i1 :+ j0, NorthEast `child` q)
      , (i1 :+ j1, SouthEast `child` q)
      ]

visibleQuads :: Window -> Viewport -> Location -> Maybe ([(Complex Int, Quad)], [(Complex Int, Quad)])
visibleQuads w v l = do
  let b = bufferSize w
      a = orient v
      co = cos a
      si = sin a
      k = 0.5 ** delta l * supersamples w
      x1 = k * fromIntegral (width  w)
      y1 = k * fromIntegral (height w)
      x0 = - x1
      y0 = - y1
      visible t (i :+ j, _) =
        let d = if t then texels b else texels b `div` 2
        in  not . and $
              [ x < x0 || y < y0 || x1 < x || y1 < y
              | di <- [0, 1], let i' = fromIntegral (i - d + di * tileSize)
              , dj <- [0, 1], let j' = fromIntegral (j - d + dj * tileSize)
              , let x =  co * i' + si * j', let y = -si * i' + co * j'
              ]
  qs0 <- bufferQuads l b
  let qs1 = concatMap childQuads qs0
  return ( filter (visible False) qs0 , filter (visible True) qs1 )

data Image = Image
  { imageWindow   :: !Window
  , imageViewport :: !Viewport
  , imageLocation :: !Location
  , imageColours  :: !Colours
  }
  deriving (Read, Show, Eq)

defImage :: Image
defImage = Image
  { imageWindow = defWindow
  , imageViewport = defViewport
  , imageLocation = defLocation
  , imageColours = defColours
  }

data Colours = Colours
  { colourInterior :: !Colour
  , colourBoundary :: !Colour
  , colourExterior :: !Colour
  }
  deriving (Read, Show, Eq)

data Colour = Colour !Double !Double !Double
  deriving (Read, Show, Eq)

defColours :: Colours
defColours = Colours
  { colourInterior = Colour 1 0 0
  , colourBoundary = Colour 0 0 0
  , colourExterior = Colour 1 1 1
  }

defLocation :: Location
defLocation = Location{ center = 0, radius = 4 }

defWindow :: Window
defWindow = Window{ width = 512, height = 288, supersamples = 1 }

defViewport :: Viewport
defViewport = Viewport{ aspect = 16/9, orient = 0 }