From 350eab7679c9d341cb1d26d260318ac0a59405d0 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 4 Jul 2023 12:34:52 +1200 Subject: [PATCH] Add solid border rendering! --- Mondrian.cabal | 1 + lib/Graphics/Rendering/Rect.hs | 6 +++++- lib/Graphics/Rendering/Rect/CSS.hs | 2 +- lib/Graphics/Rendering/Rect/CSS/Border.hs | 24 +++++++++++------------ lib/Graphics/Rendering/Rect/Types.hs | 2 ++ 5 files changed, 21 insertions(+), 14 deletions(-) diff --git a/Mondrian.cabal b/Mondrian.cabal index 5aa7c01..0d5817b 100644 --- a/Mondrian.cabal +++ b/Mondrian.cabal @@ -20,6 +20,7 @@ extra-source-files: CHANGELOG.md library exposed-modules: Graphics.Rendering.Rect, Graphics.Rendering.Rect.Backgrounds, + Graphics.Rendering.Rect.Border, Graphics.Rendering.Rect.Image, Graphics.Rendering.Rect.CSS, Graphics.Rendering.Rect.CSS.Colour, diff --git a/lib/Graphics/Rendering/Rect.hs b/lib/Graphics/Rendering/Rect.hs index 42f16df..f57d080 100644 --- a/lib/Graphics/Rendering/Rect.hs +++ b/lib/Graphics/Rendering/Rect.hs @@ -1,12 +1,14 @@ module Graphics.Rendering.Rect(Rect(..), Rects(..), shrink, shrink1, renderRects, - RectStyle(..), colour, + 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) @@ -26,8 +28,10 @@ renderRects :: (MonadIO m, MonadIO n) => n (RectStyle Texture -> Rects -> M44 Float -> m ()) renderRects = do bg <- renderBackgrounds + frame <- renderBorder return $ \style rects mat -> do bg (backgrounds style) rects mat + frame (border style) rects mat styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture styleResolveImages atlas self = diff --git a/lib/Graphics/Rendering/Rect/CSS.hs b/lib/Graphics/Rendering/Rect/CSS.hs index 279cf62..cb3017f 100644 --- a/lib/Graphics/Rendering/Rect/CSS.hs +++ b/lib/Graphics/Rendering/Rect/CSS.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} -module Graphics.Rendering.Rect.CSS(RectStyle(..), colour) where +module Graphics.Rendering.Rect.CSS(RectStyle(..), colour, border) where import Stylist (PropertyParser(..)) import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground)) diff --git a/lib/Graphics/Rendering/Rect/CSS/Border.hs b/lib/Graphics/Rendering/Rect/CSS/Border.hs index d2a28c3..19c3e61 100644 --- a/lib/Graphics/Rendering/Rect/CSS/Border.hs +++ b/lib/Graphics/Rendering/Rect/CSS/Border.hs @@ -29,13 +29,13 @@ rightColour self = resolveColour self $ rightColour' self bottomColour self = resolveColour self $ bottomColour' self leftColour self = resolveColour self $ leftColour' self -data BorderStyle = None | Solid | Dashed | Dotted | Double +data BorderStyle = NoBorder | Solid | Dashed | Dotted | Double | Groove | Ridge | Inset | Outset deriving (Eq, Show, Read, Enum) style :: Token -> Maybe BorderStyle -style (Ident "initial") = Just None -style (Ident "none") = Just None -style (Ident "hidden") = Just None +style (Ident "initial") = Just NoBorder +style (Ident "none") = Just NoBorder +style (Ident "hidden") = Just NoBorder style (Ident "solid") = Just Solid style (Ident "dashed") = Just Dashed style (Ident "dotted") = Just Dotted @@ -49,13 +49,13 @@ style _ = Nothing instance PropertyParser Border where temp = Border { borderPallet = temp, - topStyle = None, + topStyle = NoBorder, topColour' = Nothing, - rightStyle = None, + rightStyle = NoBorder, rightColour' = Nothing, - bottomStyle = None, + bottomStyle = NoBorder, bottomColour' = Nothing, - leftStyle = None, + leftStyle = NoBorder, leftColour' = Nothing } inherit = const temp @@ -65,13 +65,13 @@ instance PropertyParser Border where longhand _ s "border-right-style" [t] | Just v<-style t=Just s {rightStyle=v} longhand _ s "border-bottom-style" [t]|Just v<-style t=Just s {bottomStyle=v} longhand _ s "border-left-style" [t] | Just v<-style t = Just s {leftStyle=v} - longhand _ self@Border { borderPallet = cc } "border-top-colour" ts + longhand _ self@Border { borderPallet = cc } "border-top-color" ts | Just ([], v) <- parseColour cc ts = Just self { topColour' = Just v } - longhand _ self@Border { borderPallet = cc } "border-right-colour" ts + longhand _ self@Border { borderPallet = cc } "border-right-color" ts | Just ([], v) <- parseColour cc ts = Just self { rightColour' = Just v } - longhand _ self@Border { borderPallet = cc } "border-bottom-colour" ts + longhand _ self@Border { borderPallet = cc } "border-bottom-color" ts | Just ([], v) <- parseColour cc ts = Just self { bottomColour' = Just v } - longhand _ self@Border { borderPallet = cc } "border-left-colour" ts + longhand _ self@Border { borderPallet = cc } "border-left-color" ts | Just ([], v) <- parseColour cc ts = Just self { bottomColour' = Just v } -- Should be handled by caller, but for the sake of shorthands... diff --git a/lib/Graphics/Rendering/Rect/Types.hs b/lib/Graphics/Rendering/Rect/Types.hs index aa7c024..5566a58 100644 --- a/lib/Graphics/Rendering/Rect/Types.hs +++ b/lib/Graphics/Rendering/Rect/Types.hs @@ -106,6 +106,7 @@ renderRectWith fragmentShader uniformNames = do uniformIDs <- forM uniformNames $ getUniformLocation prog matID <- getUniformLocation prog "transform" originID <- getUniformLocation prog "origin" + szID <- getUniformLocation prog "boxSize" glUseProgram prog glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA @@ -118,6 +119,7 @@ renderRectWith fragmentShader uniformNames = do liftIO $ updateUniform prog matID $ mflip mat let r = origin' rects liftIO $ updateUniform prog originID $ V2 (left r) (top r) + liftIO $ updateUniform prog szID $ V2 (right r - left r) (bottom r - top r) _ <- forM (zip uniformIDs uniforms) $ \(slot, cb) -> cb prog slot withBoundTextures (map unTexture textures) $ do -- 2.30.2