~alcinnz/Mondrian

ref: 7e76e9b602f200654a046b7c8c64e37d1309f62f Mondrian/lib/Graphics/Rendering/Rect.hs -rw-r--r-- 1.4 KiB
7e76e9b6 — Adrian Cochrane Test whether colour conversion is giving me the issues on certain JPGs, nope! 1 year, 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
module Graphics.Rendering.Rect(Rect(..), Rects(..), shrink, shrink1, renderRects,
    RectStyle(..), colour, Backgrounds(..),
    Atlas, buildAtlas, atlasFromStyles, Texture, styleResolveImages) where

import Graphics.Rendering.Rect.CSS
import Graphics.Rendering.Rect.Backgrounds
import Graphics.Rendering.Rect.Types
import Graphics.Rendering.Rect.Image

import Linear (M44)
import Control.Monad.IO.Class (MonadIO)

import Codec.Picture (DynamicImage)
import Data.Text (Text)
import Data.List (nub)

shrink :: Rect -> Float -> Float -> Float -> Float -> Rect
shrink self dLeft dTop dRight dBottom =
    Rect (left self + dLeft) (top self + dTop)
         (right self - dRight) (bottom self - dBottom)
shrink1 :: Rect -> Float -> Rect
shrink1 self d = shrink self d d d d

renderRects :: (MonadIO m, MonadIO n) =>
        n (RectStyle Texture -> Rects -> M44 Float -> m ())
renderRects = do
    bg <- renderBackgrounds
    return $ \style rects mat -> do
        bg (backgrounds style) rects mat

styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture
styleResolveImages atlas self =
    let textures = map (flip atlasLookup atlas) $ image $ backgrounds self
    in self { backgrounds = (backgrounds self) { image = textures } }

atlasFromStyles :: MonadIO m =>
        (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas
atlasFromStyles cb styles =
    buildAtlas cb $ nub $ concat $ map (image . backgrounds) styles