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

import Graphics.Rendering.Rect.CSS.Backgrounds
import Graphics.Rendering.Rect.Types
import Graphics.Rendering.Rect.Image (Texture(texSize), textureSetRepeat)
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.ByteString
baseFragmentShader :: ByteString
baseFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "out vec4 fcolour;",
    "uniform vec4 colour;",
    "void main() { fcolour = colour; }"
  ]

imageFragmentShader :: B8.ByteString
imageFragmentShader :: ByteString
imageFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 pos;",
    "uniform sampler2D image;",
    "uniform vec2 size;",
    "void main() { fcolour = texture(image, coord/size - pos/size); }"
  ]

linearFragmentShader :: B8.ByteString
linearFragmentShader :: ByteString
linearFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 size;",
    "uniform vec4 stops[10];",
    "uniform float stopPoints[10];",
    "uniform int nStops;",
    "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
    "",
    "   int i = 0;",
    -- Workaround for buggy GPU drivers on test machine.
    "   if (1 < nStops - 1 && a > stopPoints[1]) i = 1;",
    "   if (2 < nStops - 1 && a > stopPoints[2]) i = 2;",
    "   if (3 < nStops - 1 && a > stopPoints[3]) i = 3;",
    "   if (4 < nStops - 1 && a > stopPoints[4]) i = 4;",
    "   if (5 < nStops - 1 && a > stopPoints[5]) i = 5;",
    "   if (6 < nStops - 1 && a > stopPoints[6]) i = 6;",
    "   if (7 < nStops - 1 && a > stopPoints[7]) i = 7;",
    "   if (8 < nStops - 1 && a > stopPoints[8]) i = 8;",
    "",
    "   a = smoothstep(stopPoints[i], stopPoints[i+1], a);",
    "   fcolour = mix(stops[i], stops[i+1], a);",
    "}"
  ]

radialFragmentShader :: B8.ByteString
radialFragmentShader :: ByteString
radialFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 size;",
    "uniform vec2 extent;",
    "uniform vec2 center;",
    "uniform vec4 stops[10];",
    "uniform float stopPoints[10];",
    "uniform int nStops;",
    "",
    "void main() {",
    "   float a = distance(coord/extent, center/size) * 2;",
    "",
    "   int i = 0;",
    -- Workaround for buggy GPU drivers on test machine.
    "   if (1 < nStops - 1 && a > stopPoints[1]) i = 1;",
    "   if (2 < nStops - 1 && a > stopPoints[2]) i = 2;",
    "   if (3 < nStops - 1 && a > stopPoints[3]) i = 3;",
    "   if (4 < nStops - 1 && a > stopPoints[4]) i = 4;",
    "   if (5 < nStops - 1 && a > stopPoints[5]) i = 5;",
    "   if (6 < nStops - 1 && a > stopPoints[6]) i = 6;",
    "   if (7 < nStops - 1 && a > stopPoints[7]) i = 7;",
    "   if (8 < nStops - 1 && a > stopPoints[8]) i = 8;",
    "",
    "   a = smoothstep(stopPoints[i], stopPoints[i+1], a);",
    "   fcolour = mix(stops[i], stops[i+1], a);",
    "}"
  ]
circleFragmentShader :: B8.ByteString
circleFragmentShader :: ByteString
circleFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 center;",
    "uniform float radius;",
    "uniform vec4 stops[10];",
    "uniform float stopPoints[10];",
    "uniform int nStops;",
    "",
    "void main() {",
    "   float a = distance(coord, center)/radius;",
    "",
    "   int i = 0;",
    -- Workaround for buggy GPU drivers on test machine.
    "   if (1 < nStops - 1 && a > stopPoints[1]) i = 1;",
    "   if (2 < nStops - 1 && a > stopPoints[2]) i = 2;",
    "   if (3 < nStops - 1 && a > stopPoints[3]) i = 3;",
    "   if (4 < nStops - 1 && a > stopPoints[4]) i = 4;",
    "   if (5 < nStops - 1 && a > stopPoints[5]) i = 5;",
    "   if (6 < nStops - 1 && a > stopPoints[6]) i = 6;",
    "   if (7 < nStops - 1 && a > stopPoints[7]) i = 7;",
    "   if (8 < nStops - 1 && a > stopPoints[8]) i = 8;",
    "",
    "   a = smoothstep(stopPoints[i], stopPoints[i+1], a);",
    "   fcolour = mix(stops[i], stops[i+1], a);",
    "}"
  ]

conicFragmentShader :: B8.ByteString
conicFragmentShader :: ByteString
conicFragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
    "#version 330 core",
    "in vec2 coord;",
    "out vec4 fcolour;",
    "uniform vec2 center;",
    "uniform float angle;",
    "uniform vec4 stops[10];",
    "uniform float stopPoints[10];",
    "uniform int nStops;",
    "",
    "void main() {",
    "   vec2 v = coord - center;",
    "   float a = atan(v.x, -v.y) - angle;",
    "   float turn = 2*radians(180);",
    "   a = fract(a/turn);",
    "",
    "   int i = 0;",
    -- Workaround for buggy GPU drivers on test machine.
    "   if (1 < nStops - 1 && a > stopPoints[1]) i = 1;",
    "   if (2 < nStops - 1 && a > stopPoints[2]) i = 2;",
    "   if (3 < nStops - 1 && a > stopPoints[3]) i = 3;",
    "   if (4 < nStops - 1 && a > stopPoints[4]) i = 4;",
    "   if (5 < nStops - 1 && a > stopPoints[5]) i = 5;",
    "   if (6 < nStops - 1 && a > stopPoints[6]) i = 6;",
    "   if (7 < nStops - 1 && a > stopPoints[7]) i = 7;",
    "   if (8 < nStops - 1 && a > stopPoints[8]) i = 8;",
    "",
    "   a = smoothstep(stopPoints[i], stopPoints[i+1], a);",
    "   fcolour = mix(stops[i], stops[i+1], a);",
    "}"
  ]

renderBackgrounds :: (MonadIO m, MonadIO n) =>
    n (Backgrounds Texture -> Rects -> M44 Float -> m ())
renderBackgrounds :: n (Backgrounds Texture -> Rects -> M44 Float -> m ())
renderBackgrounds = do
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
base <- 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
baseFragmentShader ["colour"]
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
layer <- 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
imageFragmentShader ["size", "pos"]
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
linear <- 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
linearFragmentShader ["size", "angle",
            "stops", "stopPoints", "nStops"]
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
ellipse <- 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
radialFragmentShader ["size", "extent", "center",
            "stops", "stopPoints", "nStops"]
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
circle <- 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
circleFragmentShader ["center", "radius",
            "stops", "stopPoints", "nStops"]
    [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
conic <- 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
conicFragmentShader ["center", "angle",
            "stops", "stopPoints", "nStops"]
    (Backgrounds Texture -> Rects -> M44 Float -> m ())
-> n (Backgrounds Texture -> Rects -> M44 Float -> m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Backgrounds Texture -> Rects -> M44 Float -> m ())
 -> n (Backgrounds Texture -> Rects -> M44 Float -> m ()))
-> (Backgrounds Texture -> Rects -> M44 Float -> m ())
-> n (Backgrounds Texture -> Rects -> M44 Float -> m ())
forall a b. (a -> b) -> a -> b
$ \self :: Backgrounds Texture
self a :: Rects
a b :: M44 Float
b -> do
        [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
base [] [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
$ Backgrounds Texture -> AlphaColour Float
forall img. Backgrounds img -> AlphaColour Float
background Backgrounds Texture
self] ((Rects -> Rect) -> [Rects -> Rect] -> Rects -> Rect
forall c. c -> [c] -> c
headDef Rects -> Rect
borderBox ([Rects -> Rect] -> Rects -> Rect)
-> [Rects -> Rect] -> Rects -> Rect
forall a b. (a -> b) -> a -> b
$ Backgrounds Texture -> [Rects -> Rect]
forall img. Backgrounds img -> [Rects -> Rect]
clip Backgrounds Texture
self)
                ((Rects -> Rect) -> [Rects -> Rect] -> Rects -> Rect
forall c. c -> [c] -> c
headDef Rects -> Rect
paddingBox ([Rects -> Rect] -> Rects -> Rect)
-> [Rects -> Rect] -> Rects -> Rect
forall a b. (a -> b) -> a -> b
$ Backgrounds Texture -> [Rects -> Rect]
forall img. Backgrounds img -> [Rects -> Rect]
origin Backgrounds Texture
self) Rects
a M44 Float
b
        let layers :: [(((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
   (Length, Length)),
  (Bool, Bool))]
layers = Backgrounds Texture -> [Pattern Texture]
forall img. Backgrounds img -> [Pattern img]
image Backgrounds Texture
self [Pattern Texture]
-> [Rects -> Rect] -> [(Pattern Texture, Rects -> Rect)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Backgrounds Texture -> [Rects -> Rect]
forall img. Backgrounds img -> [Rects -> Rect]
clip Backgrounds Texture
self [Rects -> Rect] -> [Rects -> Rect] -> [Rects -> Rect]
forall a. [a] -> [a] -> [a]
++ (Rects -> Rect) -> [Rects -> Rect]
forall a. a -> [a]
repeat Rects -> Rect
borderBox)
                [(Pattern Texture, Rects -> Rect)]
-> [Resize] -> [((Pattern Texture, Rects -> Rect), Resize)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Backgrounds Texture -> [Resize]
forall img. Backgrounds img -> [Resize]
bgSize Backgrounds Texture
self [Resize] -> [Resize] -> [Resize]
forall a. [a] -> [a] -> [a]
++ Resize -> [Resize]
forall a. a -> [a]
repeat (Length -> Length -> Resize
Size Length
Auto Length
Auto))
                [((Pattern Texture, Rects -> Rect), Resize)]
-> [Rects -> Rect]
-> [(((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Backgrounds Texture -> [Rects -> Rect]
forall img. Backgrounds img -> [Rects -> Rect]
origin Backgrounds Texture
self [Rects -> Rect] -> [Rects -> Rect] -> [Rects -> Rect]
forall a. [a] -> [a] -> [a]
++ (Rects -> Rect) -> [Rects -> Rect]
forall a. a -> [a]
repeat Rects -> Rect
paddingBox)
                [(((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect)]
-> [(Length, Length)]
-> [((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
     (Length, Length))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Backgrounds Texture -> [(Length, Length)]
forall img. Backgrounds img -> [(Length, Length)]
bgPos Backgrounds Texture
self [(Length, Length)] -> [(Length, Length)] -> [(Length, Length)]
forall a. [a] -> [a] -> [a]
++ (Length, Length) -> [(Length, Length)]
forall a. a -> [a]
repeat (Float -> Length
Absolute 0, Float -> Length
Absolute 0))
                [((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
  (Length, Length))]
-> [(Bool, Bool)]
-> [(((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
      (Length, Length)),
     (Bool, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Backgrounds Texture -> [(Bool, Bool)]
forall img. Backgrounds img -> [(Bool, Bool)]
bgRepeat Backgrounds Texture
self [(Bool, Bool)] -> [(Bool, Bool)] -> [(Bool, Bool)]
forall a. [a] -> [a] -> [a]
++ (Bool, Bool) -> [(Bool, Bool)]
forall a. a -> [a]
repeat (Bool
True, Bool
True))
        [()]
_<-[(((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
   (Length, Length)),
  (Bool, Bool))]
-> ((((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
      (Length, Length)),
     (Bool, Bool))
    -> m ())
-> m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
   (Length, Length)),
  (Bool, Bool))]
layers (((((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
    (Length, Length)),
   (Bool, Bool))
  -> m ())
 -> m [()])
-> ((((((Pattern Texture, Rects -> Rect), Resize), Rects -> Rect),
      (Length, Length)),
     (Bool, Bool))
    -> m ())
-> m [()]
forall a b. (a -> b) -> a -> b
$ \(((((pat0 :: Pattern Texture
pat0, clip0 :: Rects -> Rect
clip0), size0 :: Resize
size0), origin0 :: Rects -> Rect
origin0), pos0 :: (Length, Length)
pos0), repeat0 :: (Bool, Bool)
repeat0) ->
          case Pattern Texture
pat0 of
            None -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Img img0 :: Texture
img0 -> do
                let sz :: (Float, Float)
sz = (Float, Float) -> (Float, Float) -> Resize -> (Float, Float)
resolveSize (Rect -> (Float, Float)
size (Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$ Rects -> Rect
clip0 Rects
a) (Texture -> (Float, Float)
texSize Texture
img0) Resize
size0
                let pos' :: V2 Float
pos' = ((Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2((Float, Float) -> V2 Float) -> (Float, Float) -> V2 Float
forall a b. (a -> b) -> a -> b
$(Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (Length, Length)
pos0((Float, Float) -> (Float, Float))
-> (Float, Float) -> (Float, Float)
forall a b. (a -> b) -> a -> b
$Rect -> (Float, Float)
size(Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$Rects -> Rect
clip0 Rects
a) V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
- ((Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2((Float, Float) -> V2 Float) -> (Float, Float) -> V2 Float
forall a b. (a -> b) -> a -> b
$(Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (Length, Length)
pos0 (Float, Float)
sz)
                Texture -> (Bool, Bool) -> m ()
forall (m :: * -> *). MonadIO m => Texture -> (Bool, Bool) -> m ()
textureSetRepeat Texture
img0 (Bool, Bool)
repeat0
                [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
layer [Texture
img0] [V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 (Float, Float)
sz, V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u V2 Float
pos'] Rects -> Rect
clip0 Rects -> Rect
origin0 Rects
a M44 Float
b
            Linear angle :: Float
angle stops :: [(AlphaColour Float, Length)]
stops -> let size' :: (Float, Float)
size' = Rect -> (Float, Float)
size (Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$ Rects -> Rect
clip0 Rects
a in [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
linear [] [
                    V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 ((Float, Float) -> V2 Float) -> (Float, Float) -> V2 Float
forall a b. (a -> b) -> a -> b
$ (Float, Float)
size', Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u Float
angle, Int -> [AlphaColour Float] -> Uniform m
forall (m :: * -> *).
MonadIO m =>
Int -> [AlphaColour Float] -> Uniform m
cs 10 ([AlphaColour Float] -> Uniform m)
-> [AlphaColour Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> AlphaColour Float)
-> [(AlphaColour Float, Length)] -> [AlphaColour Float]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> AlphaColour Float
forall a b. (a, b) -> a
fst [(AlphaColour Float, Length)]
stops,
                    [Float] -> Uniform m
forall (m :: * -> *). MonadIO m => [Float] -> Uniform m
us ([Float] -> Uniform m) -> [Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> [Length] -> [Float]
ls2fs (Float, Float)
size' ([Length] -> [Float]) -> [Length] -> [Float]
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> Length)
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> Length
forall a b. (a, b) -> b
snd ([(AlphaColour Float, Length)] -> [Length])
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> a -> b
$ Int
-> [(AlphaColour Float, Length)] -> [(AlphaColour Float, Length)]
forall a. Int -> [a] -> [a]
take 10 [(AlphaColour Float, Length)]
stops, 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
$ [(AlphaColour Float, Length)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(AlphaColour Float, Length)]
stops
                ] Rects -> Rect
clip0 Rects -> Rect
origin0 Rects
a M44 Float
b
            -- FIXME: Incorporate resolveEllipseExtent without messing up center
            Radial Ellipse ext :: Extent
ext org :: (Length, Length)
org stops :: [(AlphaColour Float, Length)]
stops -> let sz :: (Float, Float)
sz@(_,h :: Float
h) = Rect -> (Float, Float)
size (Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$ Rects -> Rect
clip0 Rects
a in
                let (org' :: (Float, Float)
org', ext' :: (Float, Float)
ext') = (Float, Float)
-> (Length, Length) -> Extent -> ((Float, Float), (Float, Float))
resolveEllipseExtent (Float, Float)
sz (Length, Length)
org Extent
ext in [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
ellipse [] [
                    V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 (Float, Float)
sz, V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 (Float, Float)
ext', V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 (Float, Float)
org', Int -> [AlphaColour Float] -> Uniform m
forall (m :: * -> *).
MonadIO m =>
Int -> [AlphaColour Float] -> Uniform m
cs 10 ([AlphaColour Float] -> Uniform m)
-> [AlphaColour Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> AlphaColour Float)
-> [(AlphaColour Float, Length)] -> [AlphaColour Float]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> AlphaColour Float
forall a b. (a, b) -> a
fst [(AlphaColour Float, Length)]
stops,
                    [Float] -> Uniform m
forall (m :: * -> *). MonadIO m => [Float] -> Uniform m
us ([Float] -> Uniform m) -> [Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> [Length] -> [Float]
ls2fs (0,Float
hFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/2) ([Length] -> [Float]) -> [Length] -> [Float]
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> Length)
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> Length
forall a b. (a, b) -> b
snd ([(AlphaColour Float, Length)] -> [Length])
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> a -> b
$ Int
-> [(AlphaColour Float, Length)] -> [(AlphaColour Float, Length)]
forall a. Int -> [a] -> [a]
take 10 [(AlphaColour Float, Length)]
stops, 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
$ [(AlphaColour Float, Length)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(AlphaColour Float, Length)]
stops
                ] Rects -> Rect
clip0 Rects -> Rect
origin0 Rects
a M44 Float
b
            Radial Circle ext :: Extent
ext org :: (Length, Length)
org stops :: [(AlphaColour Float, Length)]
stops -> let sz :: (Float, Float)
sz@(w :: Float
w,h :: Float
h) = Rect -> (Float, Float)
size (Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$ Rects -> Rect
clip0 Rects
a
                in let (org' :: (Float, Float)
org', r :: Float
r) = (Float, Float)
-> (Length, Length) -> Extent -> ((Float, Float), Float)
resolveCircleExtent (Float, Float)
sz (Length, Length)
org Extent
ext in [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
circle [] [
                    V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 (Float, Float)
org', Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u Float
r, Int -> [AlphaColour Float] -> Uniform m
forall (m :: * -> *).
MonadIO m =>
Int -> [AlphaColour Float] -> Uniform m
cs 10 ([AlphaColour Float] -> Uniform m)
-> [AlphaColour Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> AlphaColour Float)
-> [(AlphaColour Float, Length)] -> [AlphaColour Float]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> AlphaColour Float
forall a b. (a, b) -> a
fst [(AlphaColour Float, Length)]
stops,
                    [Float] -> Uniform m
forall (m :: * -> *). MonadIO m => [Float] -> Uniform m
us ([Float] -> Uniform m) -> [Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> [Length] -> [Float]
ls2fs (0,Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
w Float
hFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/2) ([Length] -> [Float]) -> [Length] -> [Float]
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> Length)
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> Length
forall a b. (a, b) -> b
snd ([(AlphaColour Float, Length)] -> [Length])
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> a -> b
$ Int
-> [(AlphaColour Float, Length)] -> [(AlphaColour Float, Length)]
forall a. Int -> [a] -> [a]
take 10 [(AlphaColour Float, Length)]
stops,
                    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
$ [(AlphaColour Float, Length)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(AlphaColour Float, Length)]
stops
                ] Rects -> Rect
clip0 Rects -> Rect
origin0 Rects
a M44 Float
b
            Conical angle :: Float
angle org :: (Length, Length)
org stops :: [(AlphaColour Float, Length)]
stops -> let sz :: (Float, Float)
sz = Rect -> (Float, Float)
size (Rect -> (Float, Float)) -> Rect -> (Float, Float)
forall a b. (a -> b) -> a -> b
$ Rects -> Rect
clip0 Rects
a in [Texture]
-> [Uniform m]
-> (Rects -> Rect)
-> (Rects -> Rect)
-> Rects
-> M44 Float
-> m ()
conic [] [
                    V2 Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u (V2 Float -> Uniform m) -> V2 Float -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> V2 Float
forall a. (a, a) -> V2 a
v2 ((Float, Float) -> V2 Float) -> (Float, Float) -> V2 Float
forall a b. (a -> b) -> a -> b
$ (Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (Length, Length)
org (Float, Float)
sz, Float -> Uniform m
forall (m :: * -> *) a.
(MonadIO m, UniformValue a) =>
a -> Uniform m
u Float
angle, Int -> [AlphaColour Float] -> Uniform m
forall (m :: * -> *).
MonadIO m =>
Int -> [AlphaColour Float] -> Uniform m
cs 10 ([AlphaColour Float] -> Uniform m)
-> [AlphaColour Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> AlphaColour Float)
-> [(AlphaColour Float, Length)] -> [AlphaColour Float]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> AlphaColour Float
forall a b. (a, b) -> a
fst [(AlphaColour Float, Length)]
stops,
                    [Float] -> Uniform m
forall (m :: * -> *). MonadIO m => [Float] -> Uniform m
us ([Float] -> Uniform m) -> [Float] -> Uniform m
forall a b. (a -> b) -> a -> b
$ (Float, Float) -> [Length] -> [Float]
ls2fs (0,2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
forall a. Floating a => a
pi) ([Length] -> [Float]) -> [Length] -> [Float]
forall a b. (a -> b) -> a -> b
$ ((AlphaColour Float, Length) -> Length)
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> [a] -> [b]
map (AlphaColour Float, Length) -> Length
forall a b. (a, b) -> b
snd ([(AlphaColour Float, Length)] -> [Length])
-> [(AlphaColour Float, Length)] -> [Length]
forall a b. (a -> b) -> a -> b
$ Int
-> [(AlphaColour Float, Length)] -> [(AlphaColour Float, Length)]
forall a. Int -> [a] -> [a]
take 10 [(AlphaColour Float, Length)]
stops, 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
$ [(AlphaColour Float, Length)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(AlphaColour Float, Length)]
stops
                ] Rects -> Rect
clip0 Rects -> Rect
origin0 Rects
a M44 Float
b
        () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

headDef :: c -> [c] -> c
headDef :: c -> [c] -> c
headDef def :: c
def = c -> Maybe c -> c
forall a. a -> Maybe a -> a
fromMaybe c
def (Maybe c -> c) -> ([c] -> Maybe c) -> [c] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> Maybe c
forall a. [a] -> Maybe a
listToMaybe
v2 :: (a, a) -> V2 a
v2 :: (a, a) -> V2 a
v2 = (a -> a -> V2 a) -> (a, a) -> V2 a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> V2 a
forall a. a -> a -> V2 a
V2
-- Easier to express this algorithm on CPU-side...
ls2fs :: (Float, Float) -> [Length] -> [Float]
ls2fs :: (Float, Float) -> [Length] -> [Float]
ls2fs (_,h :: Float
h) ls :: [Length]
ls = Float -> [Length] -> [Float]
resolveAutos 0 ([Length] -> [Float]) -> [Length] -> [Float]
forall a b. (a -> b) -> a -> b
$ Bool -> Float -> [Length] -> [Length]
inner Bool
True 0 [Length]
ls
  where
    -- https://drafts.csswg.org/css-images/#color-stop-fixup Step 1.
    inner :: Bool -> Float -> [Length] -> [Length]
inner True _ (Auto:ls' :: [Length]
ls') = Float -> Length
Scale 0Length -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False 0 [Length]
ls'
    inner _ _ [Auto] = [Float -> Length
Scale 1]
    -- Step 2
    inner _ prev :: Float
prev (Scale x :: Float
x:ls' :: [Length]
ls') | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
prev = Float -> Length
Scale Float
prevLength -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False Float
prev [Length]
ls'
    inner _ prev :: Float
prev (Absolute x :: Float
x:ls' :: [Length]
ls') | Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
h Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
prev = Float -> Length
Scale Float
prevLength -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False Float
prev [Length]
ls'
    inner _ _ (Scale x :: Float
x:ls' :: [Length]
ls') = Float -> Length
Scale Float
xLength -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False Float
x [Length]
ls'
    inner _ _ (Absolute x :: Float
x:ls' :: [Length]
ls') = Float -> Length
Absolute Float
xLength -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False (Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
h) [Length]
ls'
    inner _ prev :: Float
prev (Auto:ls' :: [Length]
ls') = Length
AutoLength -> [Length] -> [Length]
forall a. a -> [a] -> [a]
:Bool -> Float -> [Length] -> [Length]
inner Bool
False Float
prev [Length]
ls'
    inner _ _ [] = []
    -- Step 3
    resolveAutos :: Float -> [Length] -> [Float]
    resolveAutos :: Float -> [Length] -> [Float]
resolveAutos _ (Scale x :: Float
x:ls' :: [Length]
ls') = Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:Float -> [Length] -> [Float]
resolveAutos Float
x [Length]
ls'
    resolveAutos _ (Absolute x :: Float
x:ls' :: [Length]
ls') = (Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
h)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:Float -> [Length] -> [Float]
resolveAutos (Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
h) [Length]
ls'
    resolveAutos _ [] = []
    resolveAutos prev :: Float
prev ls0 :: [Length]
ls0 = [Float
prev Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Enum a => a -> a
succ Float
iFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
grad | Float
i <- [0..Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
- 1]] [Float] -> [Float] -> [Float]
forall a. [a] -> [a] -> [a]
++ [Float]
fs
      where
        (autos :: [Length]
autos, ls' :: [Length]
ls') = (Length -> Bool) -> [Length] -> ([Length], [Length])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Length -> Length -> Bool
forall a. Eq a => a -> a -> Bool
==Length
Auto) [Length]
ls0
        n :: Float
n = Int -> Float
forall a. Enum a => Int -> a
toEnum (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ [Length] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Length]
autos
        fs :: [Float]
fs = Float -> [Length] -> [Float]
resolveAutos 0 [Length]
ls' -- Doesn't matter if prev's in another branch...
        next :: Float
next | (x :: Float
x:_) <- [Float]
fs = Float
x
            | Bool
otherwise = 1 -- Step 1 should've taken care of this...
        grad :: Float
grad = (Float
next Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
prev)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/(Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 1)

l2f :: Length -> Float -> Float
l2f :: Length -> Float -> Float
l2f Auto x :: Float
x = Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/2
l2f (Scale x :: Float
x) y :: Float
y = Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y
l2f (Absolute x :: Float
x) _ = Float
x
l2f' :: (Length, Length) -> (Float, Float) -> (Float, Float)
l2f' :: (Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (x :: Length
x,y :: Length
y) (w :: Float
w,h :: Float
h) = (Length -> Float -> Float
l2f Length
x Float
w, Length -> Float -> Float
l2f Length
y Float
h)

resolveEllipseExtent :: (Float, Float) -> (Length, Length) -> Extent ->
    ((Float, Float), (Float, Float))
resolveEllipseExtent :: (Float, Float)
-> (Length, Length) -> Extent -> ((Float, Float), (Float, Float))
resolveEllipseExtent sz :: (Float, Float)
sz@(x' :: Float
x',y' :: Float
y') pos :: (Length, Length)
pos ext :: Extent
ext = ((Float
x, Float
y), Extent -> (Float, Float)
inner Extent
ext)
  where
    (x :: Float
x,y :: Float
y) = (Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (Length, Length)
pos (Float, Float)
sz
    horiz :: [Float]
horiz = [Float
x, Float
x' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x]
    vert :: [Float]
vert = [Float
y, Float
y' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y]
    inner :: Extent -> (Float, Float)
inner (Extent s :: Length
s t :: Length
t) = (Length -> Float -> Float
l2f Length
s Float
x, Length -> Float -> Float
l2f Length
t Float
y)
    -- FIXME: How to calculate closest/farthest-corner?
    -- Spec just says keep this aspect ratio.
    inner ClosestCorner = ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
horiz Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2, [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
vert Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2)
    inner ClosestSide = ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
horiz Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2, [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
vert Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2)
    inner FarthestCorner = ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
horiz Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2, [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
vert Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2)
    inner FarthestSide = ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
horiz Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2, [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
vert Float -> Float -> Float
forall a. Num a => a -> a -> a
* 2)
resolveCircleExtent :: (Float, Float) -> (Length, Length) -> Extent ->
    ((Float, Float), Float)
resolveCircleExtent :: (Float, Float)
-> (Length, Length) -> Extent -> ((Float, Float), Float)
resolveCircleExtent sz :: (Float, Float)
sz@(x' :: Float
x',y' :: Float
y') pos :: (Length, Length)
pos ext :: Extent
ext = ((Float
x, Float
y), Extent -> Float
inner Extent
ext)
  where
    (x :: Float
x,y :: Float
y) = (Length, Length) -> (Float, Float) -> (Float, Float)
l2f' (Length, Length)
pos (Float, Float)
sz
    sides :: [Float]
sides = [Float
x, Float
x' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x, Float
y, Float
y' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y]
    corners :: [Float]
corners = [Float -> Float -> Float
forall a. Floating a => a -> a -> a
hypot Float
x Float
y, Float -> Float -> Float
forall a. Floating a => a -> a -> a
hypot Float
x (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
y'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
y, Float -> Float -> Float
forall a. Floating a => a -> a -> a
hypot Float
y (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
x, Float -> Float -> Float
forall a. Floating a => a -> a -> a
hypot (Float
x'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
x) (Float
y'Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
y)]
    hypot :: a -> a -> a
hypot a :: a
a b :: a
b = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
b
    inner :: Extent -> Float
inner (Extent a :: Length
a _) = Length -> Float -> Float
l2f Length
a Float
y -- Should be absolute...
    inner ClosestCorner = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
corners
    inner ClosestSide = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
sides
    inner FarthestCorner = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
corners
    inner FarthestSide = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
sides