1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
module Graphics.Rendering.Rect.Backgrounds(Backgrounds(..), renderBackgrounds) where
import Graphics.Rendering.Rect.CSS.Backgrounds
import Graphics.Rendering.Rect.Types
import qualified Data.ByteString.Char8 as B8
import Linear (M44)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromMaybe, listToMaybe)
baseFragmentShader = B8.pack $ unlines [
"#version 330 core",
"out vec4 fcolour;",
"uniform vec4 colour;",
"void main() { fcolour = colour; }"
]
renderBackgrounds :: (MonadIO m, MonadIO n) =>
n (Backgrounds -> Rects -> M44 Float -> m ())
renderBackgrounds = do
base <- renderRectWith baseFragmentShader ["colour"]
return $ \self -> base [c $ background self] $ headDef borderBox $ clip self
headDef def = fromMaybe def . listToMaybe