module Graphics.Rendering.Rect.Backgrounds(Backgrounds(..), Pattern(..),
    Resize(..), Length(..), resolveSize, renderBackgrounds) where

import Graphics.Rendering.Rect.CSS.Backgrounds
import Graphics.Rendering.Rect.Types
import Graphics.Rendering.Rect.Image (Texture(texSize))
import qualified Data.ByteString.Char8 as B8
import Linear (M44, V2(..))

import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromMaybe, listToMaybe)
import Control.Monad (forM)

baseFragmentShader = B8.pack $ unlines [
    "#version 330 core",
    "out vec4 fcolour;",
    "uniform vec4 colour;",
    "void main() { fcolour = colour; }"
  ]

imageFragmentShader = B8.pack $ unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform sampler2D image;",
    "uniform vec2 size;",
    "void main() { fcolour = texture(image, coord/size); }"
  ]

linearFragmentShader = B8.pack $ unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 size;",
    "uniform vec4 start;",
    "uniform vec4 end;",
    "uniform float angle;",
    "void main() {",
    "   vec2 pos = coord/size;", -- Range 0..1
    "   pos -= 0.5; pos *= 2;", -- Range -1..1
    "   float a = pos.x*sin(angle) + pos.y*-cos(angle);", -- Range -1..1
    "   a /= 2; a += 0.5;", -- Range 0..1
    "   fcolour = mix(start, end, a);",
    "}"
  ]

renderBackgrounds :: (MonadIO m, MonadIO n) =>
    n (Backgrounds Texture -> Rects -> M44 Float -> m ())
renderBackgrounds = do
    base <- renderRectWith baseFragmentShader ["colour"]
    layer <- renderRectWith imageFragmentShader ["size"]
    linear <- renderRectWith linearFragmentShader ["size", "start", "end", "angle"]
    return $ \self a b -> do
        base [] [c $ background self] (headDef borderBox $ clip self) a b
        let layers = image self `zip` (clip self ++ repeat borderBox)
                `zip` (bgSize self ++ repeat (Size Auto Auto))
        forM layers $ \((pat0, clip0), size0) -> case pat0 of
            None -> return ()
            Img img0 -> layer [img0] [
                    u $ v2 $ resolveSize (size $ clip0 a) (texSize img0) size0
                ] clip0 a b
            Linear angle start end -> linear [] [
                    u $ v2 $ size $ clip0 a, c start, c end, u angle
                ] clip0 a b
        return ()

headDef def = fromMaybe def . listToMaybe
v2 = uncurry V2