module Graphics.Rendering.Rect.Border(renderBorder, Border(..), BorderStyle(..),
        topColour, rightColour, bottomColour, leftColour) where

import Graphics.Rendering.Rect.CSS.Border
import Graphics.Rendering.Rect.Types
import qualified Data.ByteString.Char8 as B8
import Control.Monad.IO.Class (MonadIO(..))
import Linear (M44)

borderFragmentShader :: B8.ByteString
borderFragmentShader :: ByteString
borderFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "uniform float widths[4];",
    "uniform vec4 colours[4];",
    "uniform int styles[5];",
    "uniform vec2 boxSize;",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "",
    "const int TOP = 0;",
    "const int RIGHT = 1;",
    "const int BOTTOM = 2;",
    "const int LEFT = 3;",
    "const int NONE = 4;",
    "",
    "const int NOBORDER = 0;",
    "const int SOLID = 1;",
    "const int DASHED = 2;",
    "const int DOTTED = 3;",
    "const int DOUBLE = 4;",
    "const int GROOVE = 5;",
    "const int RIDGE = 6;",
    "const int INSET = 7;",
    "const int OUTSET = 8;",
    "",
    "bool inTrap(float x, float y, float width, int height, int left, int right) {",
    "   float a = y/widths[height];",
    "   return a*widths[left] <= x && x <= width - widths[right]*a;",
    "}",
    "",
    "void main() {",
    "   int side = NONE;",
    "   if (coord.y < abs(widths[TOP]) &&",
    "           inTrap(coord.x, coord.y, boxSize.x, TOP, LEFT, RIGHT))",
    "       side = TOP;",
    "   else if (coord.x < abs(widths[LEFT]) &&",
    "           inTrap(coord.y, coord.x, boxSize.y, LEFT, TOP, BOTTOM))",
    "       side = LEFT;",
    "   else if (boxSize.x - coord.x < abs(widths[RIGHT]) &&",
    "           inTrap(coord.y, boxSize.x-coord.x, boxSize.y, RIGHT,TOP,BOTTOM))",
    "       side = RIGHT;",
    "   else if (boxSize.y - coord.y < abs(widths[BOTTOM])) side = BOTTOM;",
    "",
    "   vec2 pos = coord;",
    "   if (side == RIGHT || side == BOTTOM) pos = boxSize - coord;",
    "   if (side == LEFT || side == RIGHT) pos = pos.yx;",
    "",
    "   int segment = int(floor(pos.x/widths[side]/2));",
    "   float width = widths[side];",
    "   vec2 dotCenter = vec2(segment*width*2 + width, width/2);",
    "   int stroke3 = int(floor(3*pos.y/widths[side]));",
    "   int stroke = int(floor(2*pos.y/widths[side]));",
    "   bool topleft = side == TOP || side == LEFT;",
    "   if (!topleft) stroke = abs(1 - stroke);",
    "   if (styles[side] == SOLID) fcolour = colours[side];",
    "   else if (styles[side] == DASHED)",
    "       fcolour = segment % 2 == 0 ? colours[side] : vec4(0);",
    "   else if (styles[side] == DOTTED)",
    "       fcolour = distance(pos, dotCenter) < widths[side]/2 ?",
    "               colours[side] : vec4(0);",
    "   else if (styles[side] == DOUBLE && stroke3 != 1) fcolour = colours[side];",
    "   else if (styles[side] == GROOVE)",
    "       fcolour = colours[side] + vec4(stroke == 0 ? -0.1 : +0.1);",
    "   else if (styles[side] == RIDGE)",
    "       fcolour = colours[side] + vec4(stroke == 0 ? +0.1 : -0.1);",
    "   else if (styles[side] == INSET)",
    "       fcolour = colours[side] + vec4(topleft ? -0.2 : +0.2);",
    "   else if (styles[side] == OUTSET)",
    "       fcolour = colours[side] + vec4(topleft ? +0.2 : -0.2);",
    "   else fcolour = vec4(0.0);",
    "}"
  ]

renderBorder :: (MonadIO m, MonadIO n) => n (Border -> Rects -> M44 Float -> m ())
renderBorder :: n (Border -> Rects -> M44 Float -> m ())
renderBorder = do
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
inner <- ByteString
-> [String]
-> n ([Texture]
      -> [Uniform m]
      -> (Rects -> Rect)
      -> (Rects -> Rect)
      -> Rects
      -> M44 Float
      -> m ())
forall (m :: * -> *) (n :: * -> *) a.
(MonadIO m, MonadIO n) =>
ByteString
-> [String]
-> n ([Texture]
      -> [Uniform m]
      -> (a -> Rect)
      -> (a -> Rect)
      -> a
      -> M44 Float
      -> m ())
renderRectWith ByteString
borderFragmentShader [
            "widths[0]", "widths[1]", "widths[2]", "widths[3]",
            "colours[0]", "colours[1]", "colours[2]", "colours[3]",
            "styles[0]", "styles[1]", "styles[2]", "styles[3]", "styles[4]"]
    (Border -> Rects -> M44 Float -> m ())
-> n (Border -> Rects -> M44 Float -> m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Border -> Rects -> M44 Float -> m ())
 -> n (Border -> Rects -> M44 Float -> m ()))
-> (Border -> Rects -> M44 Float -> m ())
-> n (Border -> Rects -> M44 Float -> m ())
forall a b. (a -> b) -> a -> b
$ \self :: Border
self rects :: Rects
rects -> let (b :: Rect
b, p :: Rect
p) = (Rects -> Rect
borderBox Rects
rects, Rects -> Rect
paddingBox Rects
rects)
        in [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
inner [] [
            Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Float -> Uniform m) -> Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Rect -> Float
top Rect
p Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
top Rect
b, Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Float -> Uniform m) -> Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Rect -> Float
right Rect
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
right Rect
p,
            Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Float -> Uniform m) -> Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Rect -> Float
bottom Rect
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
bottom Rect
p, Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Float -> Uniform m) -> Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Rect -> Float
left Rect
p Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
left Rect
b,
            AlphaColour Float -> Uniform m
forall (m :: * -> *). MonadIO m => AlphaColour Float -> Uniform m
c (AlphaColour Float -> Uniform m) -> AlphaColour Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Border -> AlphaColour Float
topColour Border
self, AlphaColour Float -> Uniform m
forall (m :: * -> *). MonadIO m => AlphaColour Float -> Uniform m
c (AlphaColour Float -> Uniform m) -> AlphaColour Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Border -> AlphaColour Float
rightColour Border
self,
            AlphaColour Float -> Uniform m
forall (m :: * -> *). MonadIO m => AlphaColour Float -> Uniform m
c (AlphaColour Float -> Uniform m) -> AlphaColour Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Border -> AlphaColour Float
bottomColour Border
self, AlphaColour Float -> Uniform m
forall (m :: * -> *). MonadIO m => AlphaColour Float -> Uniform m
c (AlphaColour Float -> Uniform m) -> AlphaColour Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ Border -> AlphaColour Float
leftColour Border
self,
            Int -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Int -> Uniform m) -> Int -> Uniform m
forall a b. (a -> b) -> a -> b
$ BorderStyle -> Int
forall a. Enum a => a -> Int
fromEnum (BorderStyle -> Int) -> BorderStyle -> Int
forall a b. (a -> b) -> a -> b
$ Border -> BorderStyle
topStyle Border
self, Int -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Int -> Uniform m) -> Int -> Uniform m
forall a b. (a -> b) -> a -> b
$ BorderStyle -> Int
forall a. Enum a => a -> Int
fromEnum (BorderStyle -> Int) -> BorderStyle -> Int
forall a b. (a -> b) -> a -> b
$ Border -> BorderStyle
rightStyle Border
self,
            Int -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Int -> Uniform m) -> Int -> Uniform m
forall a b. (a -> b) -> a -> b
$ BorderStyle -> Int
forall a. Enum a => a -> Int
fromEnum (BorderStyle -> Int) -> BorderStyle -> Int
forall a b. (a -> b) -> a -> b
$ Border -> BorderStyle
bottomStyle Border
self, Int -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (Int -> Uniform m) -> Int -> Uniform m
forall a b. (a -> b) -> a -> b
$ BorderStyle -> Int
forall a. Enum a => a -> Int
fromEnum (BorderStyle -> Int) -> BorderStyle -> Int
forall a b. (a -> b) -> a -> b
$ Border -> BorderStyle
leftStyle Border
self,
            Int -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (0 :: Int)
        ] Rects -> Rect
borderBox Rects -> Rect
borderBox Rects
rects