module Graphics.Rendering.Rect(Rect(..), Rects(..), shrink, shrink1, renderRects, RectStyle(..), colour, border, Backgrounds(..), Pattern(..), Resize(..), Length(..), RadialShape(..), Border(..), BorderStyle(..), topColour, rightColour, bottomColour, leftColour, 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 Graphics.Rendering.Rect.Border 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 :: Rect -> Float -> Float -> Float -> Float -> Rect shrink self :: Rect self dLeft :: Float dLeft dTop :: Float dTop dRight :: Float dRight dBottom :: Float dBottom = Float -> Float -> Float -> Float -> Rect Rect (Rect -> Float left Rect self Float -> Float -> Float forall a. Num a => a -> a -> a + Float dLeft) (Rect -> Float top Rect self Float -> Float -> Float forall a. Num a => a -> a -> a + Float dTop) (Rect -> Float right Rect self Float -> Float -> Float forall a. Num a => a -> a -> a - Float dRight) (Rect -> Float bottom Rect self Float -> Float -> Float forall a. Num a => a -> a -> a - Float dBottom) shrink1 :: Rect -> Float -> Rect shrink1 :: Rect -> Float -> Rect shrink1 self :: Rect self d :: Float d = Rect -> Float -> Float -> Float -> Float -> Rect shrink Rect self Float d Float d Float d Float d renderRects :: (MonadIO m, MonadIO n) => n (RectStyle Texture -> Rects -> M44 Float -> m ()) renderRects :: n (RectStyle Texture -> Rects -> M44 Float -> m ()) renderRects = do Backgrounds Texture -> Rects -> M44 Float -> m () bg <- n (Backgrounds Texture -> Rects -> M44 Float -> m ()) forall (m :: * -> *) (n :: * -> *). (MonadIO m, MonadIO n) => n (Backgrounds Texture -> Rects -> M44 Float -> m ()) renderBackgrounds Border -> Rects -> M44 Float -> m () frame <- n (Border -> Rects -> M44 Float -> m ()) forall (m :: * -> *) (n :: * -> *). (MonadIO m, MonadIO n) => n (Border -> Rects -> M44 Float -> m ()) renderBorder (RectStyle Texture -> Rects -> M44 Float -> m ()) -> n (RectStyle Texture -> Rects -> M44 Float -> m ()) forall (m :: * -> *) a. Monad m => a -> m a return ((RectStyle Texture -> Rects -> M44 Float -> m ()) -> n (RectStyle Texture -> Rects -> M44 Float -> m ())) -> (RectStyle Texture -> Rects -> M44 Float -> m ()) -> n (RectStyle Texture -> Rects -> M44 Float -> m ()) forall a b. (a -> b) -> a -> b $ \style :: RectStyle Texture style rects :: Rects rects mat :: M44 Float mat -> do Backgrounds Texture -> Rects -> M44 Float -> m () bg (RectStyle Texture -> Backgrounds Texture forall img. RectStyle img -> Backgrounds img backgrounds RectStyle Texture style) Rects rects M44 Float mat Border -> Rects -> M44 Float -> m () frame (RectStyle Texture -> Border forall img. RectStyle img -> Border border RectStyle Texture style) Rects rects M44 Float mat styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture styleResolveImages atlas :: Atlas atlas self :: RectStyle Text self = let textures :: [Pattern Texture] textures = (Pattern Text -> Pattern Texture) -> [Pattern Text] -> [Pattern Texture] forall a b. (a -> b) -> [a] -> [b] map Pattern Text -> Pattern Texture atlasLookup' ([Pattern Text] -> [Pattern Texture]) -> [Pattern Text] -> [Pattern Texture] forall a b. (a -> b) -> a -> b $ Backgrounds Text -> [Pattern Text] forall img. Backgrounds img -> [Pattern img] image (Backgrounds Text -> [Pattern Text]) -> Backgrounds Text -> [Pattern Text] forall a b. (a -> b) -> a -> b $ RectStyle Text -> Backgrounds Text forall img. RectStyle img -> Backgrounds img backgrounds RectStyle Text self in RectStyle Text self { backgrounds :: Backgrounds Texture backgrounds = (RectStyle Text -> Backgrounds Text forall img. RectStyle img -> Backgrounds img backgrounds RectStyle Text self) { image :: [Pattern Texture] image = [Pattern Texture] textures } } where atlasLookup' :: Pattern Text -> Pattern Texture atlasLookup' None = Pattern Texture forall img. Pattern img None atlasLookup' (Img path :: Text path) = Texture -> Pattern Texture forall img. img -> Pattern img Img (Texture -> Pattern Texture) -> Texture -> Pattern Texture forall a b. (a -> b) -> a -> b $ Text -> Atlas -> Texture atlasLookup Text path Atlas atlas atlasLookup' (Linear a :: Float a b :: [(C, Length)] b) = Float -> [(C, Length)] -> Pattern Texture forall img. Float -> [(C, Length)] -> Pattern img Linear Float a [(C, Length)] b atlasLookup' (Radial a :: RadialShape a b :: Extent b cc :: (Length, Length) cc d :: [(C, Length)] d) = RadialShape -> Extent -> (Length, Length) -> [(C, Length)] -> Pattern Texture forall img. RadialShape -> Extent -> (Length, Length) -> [(C, Length)] -> Pattern img Radial RadialShape a Extent b (Length, Length) cc [(C, Length)] d atlasLookup' (Conical a :: Float a b :: (Length, Length) b cc :: [(C, Length)] cc) = Float -> (Length, Length) -> [(C, Length)] -> Pattern Texture forall img. Float -> (Length, Length) -> [(C, Length)] -> Pattern img Conical Float a (Length, Length) b [(C, Length)] cc atlasFromStyles :: MonadIO m => (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas atlasFromStyles :: (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas atlasFromStyles cb :: Text -> IO DynamicImage cb styles :: [RectStyle Text] styles = (Text -> IO DynamicImage) -> [Text] -> m Atlas forall (m :: * -> *). MonadIO m => (Text -> IO DynamicImage) -> [Text] -> m Atlas buildAtlas Text -> IO DynamicImage cb ([Text] -> m Atlas) -> [Text] -> m Atlas forall a b. (a -> b) -> a -> b $ [Text] -> [Text] forall a. Eq a => [a] -> [a] nub [Text path | RectStyle Text s <- [RectStyle Text] styles, Img path :: Text path <- Backgrounds Text -> [Pattern Text] forall img. Backgrounds img -> [Pattern img] image (Backgrounds Text -> [Pattern Text]) -> Backgrounds Text -> [Pattern Text] forall a b. (a -> b) -> a -> b $ RectStyle Text -> Backgrounds Text forall img. RectStyle img -> Backgrounds img backgrounds RectStyle Text s]