brillo-rendering 1.13.3 → 2.0.0

raw patch · 12 files changed

+1419/−158 lines, 12 filesdep +GLFW-bdep +freetype2dep +textdep −vectordep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: GLFW-b, freetype2, text

Dependencies removed: vector

Dependency ranges changed: bytestring, containers

API changes (from Hackage documentation)

Files

• Brillo/Internals/Data/Color.hs +10/−10
• Brillo/Internals/Data/Picture.hs +65/−23
• Brillo/Internals/Rendering/Circle.hs +248/−48
• Brillo/Internals/Rendering/Common.hs +12/−12
• Brillo/Internals/Rendering/Picture.hs +187/−30
• Brillo/Internals/Rendering/Polygon.hs +118/−0
• Brillo/Internals/Rendering/Shader.hs +463/−0
• Brillo/Internals/Rendering/State.hs +5/−0
• Brillo/Internals/Rendering/TrueTypeFont.hs +261/−0
• Brillo/Internals/Rendering/VectorFont.hs +24/−16
• Brillo/Rendering.hs +15/−15
• brillo-rendering.cabal +11/−4

@@ -69,16 +69,16 @@   -- | Make a custom color. All components are clamped to the range  [0..1].-makeColor-  :: Float-  -- ^ Red component.-  -> Float-  -- ^ Green component.-  -> Float-  -- ^ Blue component.-  -> Float-  -- ^ Alpha component.-  -> Color+makeColor ::+  -- | Red component.+  Float ->+  -- | Green component.+  Float ->+  -- | Blue component.+  Float ->+  -- | Alpha component.+  Float ->+  Color makeColor r g b a =   clampColor $     RGBA r g b a

@@ -11,11 +11,10 @@    -- * Bitmaps   Rectangle (..),-  BitmapData,+  BitmapData (..),   PixelFormat (..),   BitmapFormat (..),   RowOrder (..),-  bitmapSize,   bitmapOfForeignPtr,   bitmapDataOfForeignPtr,   bitmapOfByteString,@@ -29,7 +28,7 @@  import Brillo.Internals.Data.Color (Color) import Brillo.Internals.Rendering.Bitmap (-  BitmapData (BitmapData, bitmapSize),+  BitmapData (..),   BitmapFormat (..),   PixelFormat (..),   Rectangle (..),@@ -39,6 +38,7 @@ import Data.ByteString (ByteString) import Data.ByteString.Unsafe qualified as BSU import Data.Data (Data, Typeable)+import Data.Text (Text) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr) import Foreign.Marshal.Alloc (finalizerFree, mallocBytes)@@ -72,29 +72,66 @@      -- | A blank picture, with nothing in it.     Blank-  | -- | A convex polygon filled with a solid color.+  | -- | A polygon filled with a solid color, drawn with anti-aliased edges.     Polygon Path-  | -- | A line along an arbitrary path.+  | -- | A polygon filled with a solid color, drawn without anti-aliasing.+    PolygonAliased Path+  | -- | A line along an arbitrary path, drawn with anti-aliasing.     Line Path-  | -- | A circle with the given radius.+  | -- | A line along an arbitrary path, drawn without anti-aliasing.+    LineAliased Path+  | -- | A line along an arbitrary path with a given thickness, drawn with anti-aliasing.+    ThickLine Path Float+  | -- | A line along an arbitrary path with a given thickness, drawn without anti-aliasing.+    ThickLineAliased Path Float+  | -- | A circle with the given radius, drawn with anti-aliasing.     Circle Float-  | -- | A circle with the given radius and thickness.-    --   If the thickness is 0 then this is equivalent to `Circle`.+  | -- | A circle with the given radius, drawn without anti-aliasing.+    CircleAliased Float+  | {-| A circle with the given radius and thickness, drawn with anti-aliasing.+    If the thickness is 0 then this is equivalent to `Circle`.+    -}     ThickCircle Float Float-  | -- | A circular arc drawn counter-clockwise between two angles-    --  (in degrees) at the given radius.+  | {-| A circle with the given radius and thickness, drawn without anti-aliasing.+    If the thickness is 0 then this is equivalent to `CircleAliased`.+    -}+    ThickCircleAliased Float Float+  | {-| A circular arc drawn counter-clockwise between two angles+    (in degrees) at the given radius, drawn with anti-aliasing.+    -}     Arc Float Float Float-  | -- | A circular arc drawn counter-clockwise between two angles-    --  (in degrees), with the given radius and thickness.-    --   If the thickness is 0 then this is equivalent to `Arc`.+  | {-| A circular arc drawn counter-clockwise between two angles+    (in degrees) at the given radius, drawn without anti-aliasing.+    -}+    ArcAliased Float Float Float+  | {-| A circular arc drawn counter-clockwise between two angles+    (in degrees), with the given radius and thickness, drawn with anti-aliasing.+    If the thickness is 0 then this is equivalent to `Arc`.+    -}     ThickArc Float Float Float Float-  | -- | Text to draw with a vector font-    Text String+  | {-| A circular arc drawn counter-clockwise between two angles+    (in degrees), with the given radius and thickness, drawn without anti-aliasing.+    If the thickness is 0 then this is equivalent to `ArcAliased`.+    -}+    ThickArcAliased Float Float Float Float+  | -- | Text to draw with a vector font, drawn with anti-aliasing.+    Text Text+  | -- | Text to draw with a vector font, drawn without anti-aliasing.+    TextAliased Text+  | -- | Text to draw with a vector font and a given thickness, drawn with anti-aliasing.+    ThickText Text Float+  | -- | Text to draw with a vector font and a given thickness, drawn without anti-aliasing.+    ThickTextAliased Text Float+  | {-| Text to draw with a TrueType font located at the given path,+    rendered at the specified pixel height.+    -}+    TrueTypeText FilePath Int Text   | -- | A bitmap image.     Bitmap BitmapData-  | -- | A subsection of a bitmap image where-    --   the first argument selects a sub section in the bitmap,-    --   and second argument determines the bitmap data.+  | {-| A subsection of a bitmap image where+    the first argument selects a sub section in the bitmap,+    and second argument determines the bitmap data.+    -}     BitmapSection Rectangle BitmapData   | -- Color ------------------------------------------ @@ -138,7 +175,8 @@   the image for each frame then use `False`. If you have loaded it   from a file then use `True`. -}-bitmapOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> Picture+bitmapOfForeignPtr ::+  Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> Picture bitmapOfForeignPtr width height fmt fptr cacheMe =   Bitmap $     bitmapDataOfForeignPtr width height fmt fptr cacheMe@@ -146,7 +184,8 @@  -- Bitmap width height (bitmapDataOfForeignPtr width height fmt fptr) cacheMe -bitmapDataOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> BitmapData+bitmapDataOfForeignPtr ::+  Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> BitmapData bitmapDataOfForeignPtr width height fmt fptr cacheMe =   let len = width * height * 4   in  BitmapData len fmt (width, height) cacheMe fptr@@ -160,13 +199,15 @@   the image for each frame then use `False`. If you have loaded it   from a file then use `True`. -}-bitmapOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> Picture+bitmapOfByteString ::+  Int -> Int -> BitmapFormat -> ByteString -> Bool -> Picture bitmapOfByteString width height fmt bs cacheMe =   Bitmap $     bitmapDataOfByteString width height fmt bs cacheMe  -bitmapDataOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> BitmapData+bitmapDataOfByteString ::+  Int -> Int -> BitmapFormat -> ByteString -> Bool -> BitmapData bitmapDataOfByteString width height fmt bs cacheMe =   unsafePerformIO $     do@@ -202,7 +243,8 @@       BSU.unsafeUseAsCString bs $         \cstr -> copyBytes ptr (castPtr cstr) len -      return $ BitmapData len (BitmapFormat BottomToTop PxRGBA) (width, height) True fptr+      return $+        BitmapData len (BitmapFormat BottomToTop PxRGBA) (width, height) True fptr {-# NOINLINE bitmapDataOfBMP #-}  

@@ -5,7 +5,9 @@ -- | Fast(ish) rendering of circles. module Brillo.Internals.Rendering.Circle (   renderCircle,+  renderCircleSmooth,   renderArc,+  renderArcSmooth, ) where @@ -20,9 +22,16 @@   sinFloat#,   timesFloat#,  )+import Graphics.Rendering.OpenGL (($=)) import Graphics.Rendering.OpenGL.GL qualified as GL  +-- | Tau = 2 * pi, the ratio of circumference to radius+tau :: Float+tau = 2 * pi+{-# INLINE tau #-}++ -------------------------------------------------------------------------------  {-| Decide how many line segments to use to render the circle.@@ -69,8 +78,8 @@ renderCircleLine :: Float -> Float -> Int -> Float -> IO () renderCircleLine (F# posX) (F# posY) steps (F# rad) =   let n = fromIntegral steps-      !(F# tStep) = (2 * pi) / n-      !(F# tStop) = (2 * pi)+      !(F# tStep) = tau / n+      !(F# tStop) = tau   in  GL.renderPrimitive GL.LineLoop $         renderCircleLineStep posX posY tStep tStop rad 0.0# {-# INLINE renderCircleLine #-}@@ -80,8 +89,8 @@ renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO () renderCircleStrip (F# posX) (F# posY) steps r width =   let n = fromIntegral steps-      !(F# tStep) = (2 * pi) / n-      !(F# tStop) = (2 * pi) + F# tStep / 2+      !(F# tStep) = tau / n+      !(F# tStop) = tau + F# tStep / 2       !(F# r1) = r - width / 2       !(F# r2) = r + width / 2   in  GL.renderPrimitive GL.TriangleStrip $@@ -97,11 +106,100 @@ {-# INLINE renderCircleStrip #-}  +-- | Render a ring with given inner and outer radii as a triangle strip+renderCircleStripRadii :: Float -> Float -> Int -> Float -> Float -> IO ()+renderCircleStripRadii (F# posX) (F# posY) steps innerR outerR =+  let n = fromIntegral steps+      !(F# tStep) = tau / n+      !(F# tStop) = tau + F# tStep / 2+      !(F# r1) = innerR+      !(F# r2) = outerR+  in  GL.renderPrimitive GL.TriangleStrip $+        renderCircleStripStep+          posX+          posY+          tStep+          tStop+          r1+          0.0#+          r2+          (tStep `divideFloat#` 2.0#)+{-# INLINE renderCircleStripRadii #-}+++{-| Render a circle with the given thickness, with anti-aliasing.+  Draws filled shape slightly inset, then anti-aliased edge on boundary.+-}+renderCircleSmooth :: Float -> Float -> Float -> Float -> Float -> IO ()+renderCircleSmooth posX posY scaleFactor radius_ thickness_ =+  go (abs radius_) (abs thickness_)+  where+    go radius thickness+      -- If the circle is smaller than a pixel, render it as a point.+      | thickness == 0+      , radScreen <- scaleFactor * (radius + thickness / 2)+      , radScreen <= 1 =+          GL.renderPrimitive GL.Points $+            GL.vertex $+              GL.Vertex2 (gf posX) (gf posY)+      -- Render zero thickness circles with smoothed lines.+      | thickness == 0+      , radScreen <- scaleFactor * radius+      , steps <- circleSteps radScreen =+          do+            GL.lineSmooth $= GL.Enabled+            renderCircleLine posX posY steps radius+            GL.lineSmooth $= GL.Disabled+      -- Solid circle (no inner hole): draw fill then smooth edge on top+      | radius - thickness / 2 <= 0+      , radScreen <- scaleFactor * (radius + thickness / 2)+      , steps <- circleSteps radScreen * 2 -- More segments for smoother result+        =+          do+            let outerRadius = radius + thickness / 2+            -- Draw fill at full size+            renderCircleFan posX posY steps outerRadius+            -- Draw anti-aliased edge at exact boundary+            GL.lineSmooth $= GL.Enabled+            renderCircleLine posX posY steps outerRadius+            GL.lineSmooth $= GL.Disabled+      -- Thick circle with inner hole: draw fill then smooth edges on top+      | radScreen <- scaleFactor * (radius + thickness / 2)+      , steps <- circleSteps radScreen * 2 -- More segments for smoother result+        =+          do+            let outerRadius = radius + thickness / 2+            let innerRadius = radius - thickness / 2+            -- Draw fill at full size+            renderCircleStripRadii posX posY steps innerRadius outerRadius+            -- Draw anti-aliased edges at exact boundaries+            GL.lineSmooth $= GL.Enabled+            renderCircleLine posX posY steps outerRadius+            renderCircleLine posX posY steps innerRadius+            GL.lineSmooth $= GL.Disabled+++-- | Render a filled circle as a triangle fan+renderCircleFan :: Float -> Float -> Int -> Float -> IO ()+renderCircleFan (F# posX) (F# posY) steps (F# rad) =+  let n = fromIntegral steps+      !(F# tStep) = tau / n+      !(F# tStop) = tau+  in  GL.renderPrimitive GL.TriangleFan $ do+        -- Center vertex+        GL.vertex $ GL.Vertex2 (gf (F# posX)) (gf (F# posY))+        -- Edge vertices+        renderCircleLineStep posX posY tStep tStop rad 0.0#+        -- Close the fan by repeating the first edge vertex+        addPointOnCircle posX posY rad 0.0#+{-# INLINE renderCircleFan #-}++ -- Arc ------------------------------------------------------------------------  -- | Render an arc with the given thickness.-renderArc-  :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()+renderArc ::+  Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO () renderArc posX posY scaleFactor radius_ a1 a2 thickness_ =   go (abs radius_) (abs thickness_)   where@@ -117,14 +215,60 @@           renderArcStrip posX posY steps radius a1 a2 thickness  +{-| Render an arc with the given thickness, with anti-aliasing.+  Draws filled shape slightly inset, then anti-aliased edge on boundary.+-}+renderArcSmooth ::+  Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()+renderArcSmooth posX posY scaleFactor radius_ a1 a2 thickness_ =+  go (abs radius_) (abs thickness_)+  where+    go radius thickness+      -- Render zero thickness arcs with smoothed lines.+      | thickness == 0+      , radScreen <- scaleFactor * radius+      , steps <- circleSteps radScreen =+          do+            GL.lineSmooth $= GL.Enabled+            renderArcLine posX posY steps radius a1 a2+            GL.lineSmooth $= GL.Disabled+      -- Solid arc (no inner hole): draw fill then smooth edge on top+      | radius - thickness / 2 <= 0+      , radScreen <- scaleFactor * (radius + thickness / 2)+      , steps <- circleSteps radScreen * 2 -- More segments for smoother result+        =+          do+            let outerRadius = radius + thickness / 2+            -- Draw fill at full size+            renderArcFan posX posY steps outerRadius a1 a2+            -- Draw anti-aliased edge at exact boundary+            GL.lineSmooth $= GL.Enabled+            renderArcLine posX posY steps outerRadius a1 a2+            GL.lineSmooth $= GL.Disabled+      -- Thick arc with inner hole: draw fill then smooth edges on top+      | radScreen <- scaleFactor * (radius + thickness / 2)+      , steps <- circleSteps radScreen * 2 -- More segments for smoother result+        =+          do+            let outerRadius = radius + thickness / 2+            let innerRadius = radius - thickness / 2+            -- Draw fill at full size+            renderArcStripRadii posX posY steps innerRadius outerRadius a1 a2+            -- Draw anti-aliased edges at exact boundaries+            GL.lineSmooth $= GL.Enabled+            renderArcLine posX posY steps outerRadius a1 a2+            renderArcLine posX posY steps innerRadius a1 a2+            GL.lineSmooth $= GL.Disabled++ -- | Render an arc as a line.-renderArcLine-  :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()+renderArcLine ::+  Float -> Float -> Int -> Float -> Float -> Float -> IO () renderArcLine (F# posX) (F# posY) steps (F# rad) a1 a2 =   let n = fromIntegral steps-      !(F# tStep) = (2 * pi) / n+      !(F# tStep) = tau / n       !(F# tStart) = degToRad a1-      !(F# tStop) = degToRad a2 + if a1 >= a2 then 2 * pi else 0+      !(F# tStop) = degToRad a2 + if a1 >= a2 then tau else 0        -- force the line to end at the desired angle       endVertex = addPointOnCircle posX posY rad tStop@@ -135,19 +279,32 @@ {-# INLINE renderArcLine #-}  --- | Render an arc with a given thickness as a triangle strip-renderArcStrip-  :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()-renderArcStrip (F# posX) (F# posY) steps r a1 a2 width =+-- | Render a filled arc (pie slice) as a triangle fan from center+renderArcFan :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()+renderArcFan (F# posX) (F# posY) steps (F# rad) a1 a2 =   let n = fromIntegral steps-      tStep = (2 * pi) / n+      !(F# tStep) = tau / n+      !(F# tStart) = degToRad a1+      !(F# tStop) = degToRad a2 + if a1 >= a2 then tau else 0+  in  GL.renderPrimitive GL.TriangleFan $ do+        -- Center vertex+        GL.vertex $ GL.Vertex2 (gf (F# posX)) (gf (F# posY))+        -- Edge vertices along the arc+        renderCircleLineStep posX posY tStep tStop rad tStart+        -- Final vertex at exact end angle+        addPointOnCircle posX posY rad tStop+{-# INLINE renderArcFan #-} -      t1 = normalizeAngle $ degToRad a1 -      a2' = normalizeAngle $ degToRad a2-      t2 = if a2' == 0 then 2 * pi else a2'+-- | Render an arc with a given thickness as a triangle strip+renderArcStrip ::+  Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()+renderArcStrip (F# posX) (F# posY) steps r a1 a2 width =+  let n = fromIntegral steps+      tStep = tau / n -      (tStart, tStop) = if t1 <= t2 then (t1, t2) else (t2, t1)+      tStart = degToRad a1+      tStop = degToRad a2 + if a1 >= a2 then tau else 0       tDiff = tStop - tStart       tMid = tStart + tDiff / 2 @@ -191,15 +348,67 @@ {-# INLINE renderArcStrip #-}  +-- | Render an arc with given inner and outer radii as a triangle strip+renderArcStripRadii ::+  Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()+renderArcStripRadii (F# posX) (F# posY) steps innerR outerR a1 a2 =+  let n = fromIntegral steps+      tStep = tau / n++      tStart = degToRad a1+      tStop = degToRad a2 + if a1 >= a2 then tau else 0+      tDiff = tStop - tStart+      tMid = tStart + tDiff / 2++      !(F# tStep') = tStep+      !(F# tStep2') = tStep / 2+      !(F# tStart') = tStart+      !(F# tStop') = tStop+      !(F# tCut') = tStop - tStep+      !(F# tMid') = tMid+      !(F# r1') = innerR+      !(F# r2') = outerR+  in  GL.renderPrimitive GL.TriangleStrip $+        do+          -- start vector+          addPointOnCircle posX posY r1' tStart'+          addPointOnCircle posX posY r2' tStart'++          -- If we don't have a complete step then just drop a point+          -- between the two ending lines.+          if tDiff < tStep+            then do+              addPointOnCircle posX posY r1' tMid'++              -- end vectors+              addPointOnCircle posX posY r2' tStop'+              addPointOnCircle posX posY r1' tStop'+            else do+              renderCircleStripStep+                posX+                posY+                tStep'+                tCut'+                r1'+                tStart'+                r2'+                (tStart' `plusFloat#` tStep2')++              -- end vectors+              addPointOnCircle posX posY r1' tStop'+              addPointOnCircle posX posY r2' tStop'+{-# INLINE renderArcStripRadii #-}++ -- Step functions --------------------------------------------------------------renderCircleLineStep-  :: Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> IO ()+renderCircleLineStep ::+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  IO () renderCircleLineStep posX posY tStep tStop rad tt   | 1# <- tt `geFloat#` tStop =       return ()@@ -216,16 +425,16 @@ {-# INLINE renderCircleLineStep #-}  -renderCircleStripStep-  :: Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> Float#-  -> IO ()+renderCircleStripStep ::+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  Float# ->+  IO () renderCircleStripStep posX posY tStep tStop r1 t1 r2 t2   | 1# <- t1 `geFloat#` tStop =       return ()@@ -264,15 +473,6 @@ degToRad d = d * pi / 180 {-# INLINE degToRad #-} ---- | Normalise an angle to be between 0 and 2*pi radians-normalizeAngle :: Float -> Float-normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))-  where-    floor' :: Float -> Float-    floor' x = fromIntegral (floor x :: Int)-{-# INLINE normalizeAngle #-}- {- Unused sector drawing code.    Sectors are currently drawn as compound Pictures,    but we might want this if we end up implementing the ThickSector@@ -282,9 +482,9 @@ renderSectorLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO () renderSectorLine pX@(F# posX) pY@(F# posY) steps (F# rad) a1 a2  = let  n               = fromIntegral steps-        !(F# tStep)     = (2 * pi) / n+        !(F# tStep)     = tau / n         !(F# tStart)    = degToRad a1-        !(F# tStop)     = degToRad a2 + if a1 >= a2 then 2 * pi else 0+        !(F# tStop)     = degToRad a2 + if a1 >= a2 then tau else 0          -- need to set up the edges of the start/end triangles         startVertex     = GL.vertex $ GL.Vertex2 (gf pX) (gf pY)

@@ -36,12 +36,12 @@ {-| Set up the OpenGL rendering context for orthographic projection and run an   action to draw the model. -}-withModelview-  :: (Int, Int)-  -- ^ Width and height of window.-  -> IO ()-  -- ^ Action to perform.-  -> IO ()+withModelview ::+  -- | Width and height of window.+  (Int, Int) ->+  -- | Action to perform.+  IO () ->+  IO () withModelview (sizeX, sizeY) action =   do     GL.matrixMode $= GL.Projection@@ -64,12 +64,12 @@ {-| Clear the OpenGL buffer with the given background color and run   an action to draw the model. -}-withClearBuffer-  :: Color-  -- ^ Background color-  -> IO ()-  -- ^ Action to perform-  -> IO ()+withClearBuffer ::+  -- | Background color+  Color ->+  -- | Action to perform+  IO () ->+  IO () withClearBuffer clearColor action =   do     -- initialization (done every time in this case)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_HADDOCK hide #-}@@ -12,9 +13,11 @@ import Data.IORef (IORef, readIORef, writeIORef) import Data.List (find) import Foreign.ForeignPtr (withForeignPtr)+import GHC.IO.StdHandles (stderr) import Graphics.Rendering.OpenGL (get, ($=)) import Graphics.Rendering.OpenGL.GL qualified as GL import Graphics.Rendering.OpenGL.GLU.Errors qualified as GLU+import System.IO (hPutStrLn) import System.Mem.StableName (makeStableName)  import Brillo.Internals.Data.Color (Color (RGBA))@@ -27,18 +30,32 @@   rectAtOrigin,  ) import Brillo.Internals.Rendering.Bitmap (BitmapData (..), bitmapPath)-import Brillo.Internals.Rendering.Circle (renderArc, renderCircle)+import Brillo.Internals.Rendering.Circle (+  renderArc,+  renderCircle,+ ) import Brillo.Internals.Rendering.Common (gf, gsizei)+import Brillo.Internals.Rendering.Polygon (+  renderComplexPolygon,+  renderComplexPolygonSmooth,+ )+import Brillo.Internals.Rendering.Shader (+  renderArcSDF,+  renderCircleSDF,+  renderThickLineSDF,+ ) import Brillo.Internals.Rendering.State (   State (     stateBlendAlpha,     stateColor,     stateLineSmooth,+    stateShaders,     stateTextures,     stateWireframe   ),   Texture (..),  )+import Brillo.Internals.Rendering.TrueTypeFont (renderTrueTypeText) import Brillo.Internals.Rendering.VectorFont as VF (canvastextFont, renderSafe)  @@ -46,20 +63,21 @@    Assumes that the OpenGL matrix mode is set to @Modelview@ -}-renderPicture-  :: State-  -- ^ Current rendering state.-  -> Float-  -- ^ View port scale, which controls the level of detail.-  --   Use 1.0 to start with.-  -> Picture-  -- ^ Picture to render.-  -> IO ()+renderPicture ::+  -- | Current rendering state.+  State ->+  {-| View port scale, which controls the level of detail.+  Use 1.0 to start with.+  -}+  Float ->+  -- | Picture to render.+  Picture ->+  IO () renderPicture state circScale picture =   do     -- Setup render state for world-    setLineSmooth (stateLineSmooth state)-    setBlendAlpha (stateBlendAlpha state)+    setLineSmooth state.stateLineSmooth+    setBlendAlpha state.stateBlendAlpha      -- Draw the picture     checkErrors "before drawPicture."@@ -71,30 +89,69 @@ drawPicture state circScale picture =   {-# SCC "drawComponent" #-}   case picture of-    -- nothin'+    --     Blank ->       return ()-    -- line-    Line path ->+    --+    Line path -> do+      GL.lineSmooth $= GL.Enabled       GL.renderPrimitive GL.LineStrip $         vertexPFs path-    -- polygon (where?)+      GL.lineSmooth $= GL.Disabled+    --+    LineAliased path ->+      GL.renderPrimitive GL.LineStrip $+        vertexPFs path+    --+    ThickLine path thickness ->+      renderThickLineSmoothSDF state 0 0 circScale path thickness+    --+    ThickLineAliased path thickness -> do+      widthRange <- GL.aliasedLineWidthRange+      when (thickness < fst widthRange || thickness > snd widthRange) $+        hPutStrLn stderr $+          "Error: The line width "+            <> show thickness+            <> " is outside the supported range of "+            <> show widthRange++      oldLineWidth <- get GL.lineWidth+      GL.lineWidth $= gf thickness+      GL.renderPrimitive GL.LineStrip $ vertexPFs path+      GL.lineWidth $= oldLineWidth+    --     Polygon path-      | stateWireframe state ->+      | state.stateWireframe -> do+          GL.lineSmooth $= GL.Enabled           GL.renderPrimitive GL.LineLoop $             vertexPFs path+          GL.lineSmooth $= GL.Disabled       | otherwise ->-          GL.renderPrimitive GL.Polygon $+          renderComplexPolygonSmooth path+    --+    PolygonAliased path+      | state.stateWireframe ->+          GL.renderPrimitive GL.LineLoop $             vertexPFs path+      | otherwise ->+          renderComplexPolygon path     -- circle     Circle radius ->+      renderCircleSmoothSDF state 0 0 circScale radius 0+    CircleAliased radius ->       renderCircle 0 0 circScale radius 0     ThickCircle radius thickness ->+      renderCircleSmoothSDF state 0 0 circScale radius thickness+    ThickCircleAliased radius thickness ->       renderCircle 0 0 circScale radius thickness     -- arc     Arc a1 a2 radius ->+      renderArcSmoothSDF state 0 0 circScale radius a1 a2 0+    ArcAliased a1 a2 radius ->       renderArc 0 0 circScale radius a1 a2 0     ThickArc a1 a2 radius thickness ->+      renderArcSmoothSDF state 0 0 circScale radius a1 a2 thickness+    ThickArcAliased a1 a2 radius thickness ->       renderArc 0 0 circScale radius a1 a2 thickness     -- Vector font text     Text str -> do@@ -102,16 +159,69 @@         characters :: [[(Double, Double)]]         characters = renderSafe canvastextFont str +      oldLineWidth <- get GL.lineWidth+      GL.lineWidth $= gf 3.0+      GL.lineSmooth $= GL.Enabled       GL.preservingMatrix $ do         GL.scale (gf 5) (gf 5) 0         forM_ characters $ \stroke -> do           GL.renderPrimitive GL.LineStrip $ do             forM_ stroke $ \(x, y) -> do               GL.vertex $ GL.Vertex2 x y+      GL.lineSmooth $= GL.Disabled+      GL.lineWidth $= oldLineWidth+    --+    TextAliased str -> do+      let+        characters :: [[(Double, Double)]]+        characters = renderSafe canvastextFont str +      oldLineWidth <- get GL.lineWidth+      GL.lineWidth $= gf 3.0+      GL.preservingMatrix $ do+        GL.scale (gf 5) (gf 5) 0+        forM_ characters $ \stroke -> do+          GL.renderPrimitive GL.LineStrip $ do+            forM_ stroke $ \(x, y) -> do+              GL.vertex $ GL.Vertex2 x y+      GL.lineWidth $= oldLineWidth+    --+    ThickText str thickness -> do+      let+        characters :: [[(Double, Double)]]+        characters = renderSafe canvastextFont str++      oldLineWidth <- get GL.lineWidth+      GL.lineWidth $= gf thickness+      GL.lineSmooth $= GL.Enabled+      GL.preservingMatrix $ do+        GL.scale (gf 5) (gf 5) 0+        forM_ characters $ \stroke -> do+          GL.renderPrimitive GL.LineStrip $ do+            forM_ stroke $ \(x, y) -> do+              GL.vertex $ GL.Vertex2 x y+      GL.lineSmooth $= GL.Disabled+      GL.lineWidth $= oldLineWidth+    --+    ThickTextAliased str thickness -> do+      let+        characters :: [[(Double, Double)]]+        characters = renderSafe canvastextFont str++      oldLineWidth <- get GL.lineWidth+      GL.lineWidth $= gf thickness+      GL.preservingMatrix $ do+        GL.scale (gf 5) (gf 5) 0+        forM_ characters $ \stroke -> do+          GL.renderPrimitive GL.LineStrip $ do+            forM_ stroke $ \(x, y) -> do+              GL.vertex $ GL.Vertex2 x y+      GL.lineWidth $= oldLineWidth+    TrueTypeText fontPath pixelHeight str ->+      renderTrueTypeText fontPath pixelHeight str     -- colors with float components.     Color col p-      | stateColor state -> do+      | state.stateColor -> do           oldColor <- get GL.currentColor            let RGBA r g b a = col@@ -124,12 +234,20 @@     -- Translation --------------------------     -- Easy translations are done directly to avoid calling GL.perserveMatrix.     Translate posX posY (Circle radius) ->+      renderCircleSmoothSDF state posX posY circScale radius 0+    Translate posX posY (CircleAliased radius) ->       renderCircle posX posY circScale radius 0     Translate posX posY (ThickCircle radius thickness) ->+      renderCircleSmoothSDF state posX posY circScale radius thickness+    Translate posX posY (ThickCircleAliased radius thickness) ->       renderCircle posX posY circScale radius thickness     Translate posX posY (Arc a1 a2 radius) ->+      renderArcSmoothSDF state posX posY circScale radius a1 a2 0+    Translate posX posY (ArcAliased a1 a2 radius) ->       renderArc posX posY circScale radius a1 a2 0     Translate posX posY (ThickArc a1 a2 radius thickness) ->+      renderArcSmoothSDF state posX posY circScale radius a1 a2 thickness+    Translate posX posY (ThickArcAliased a1 a2 radius thickness) ->       renderArc posX posY circScale radius a1 a2 thickness     Translate tx ty (Rotate deg p) ->       GL.preservingMatrix $@@ -146,12 +264,20 @@     -- Rotation -----------------------------     -- Easy rotations are done directly to avoid calling GL.perserveMatrix.     Rotate _ (Circle radius) ->+      renderCircleSmoothSDF state 0 0 circScale radius 0+    Rotate _ (CircleAliased radius) ->       renderCircle 0 0 circScale radius 0     Rotate _ (ThickCircle radius thickness) ->+      renderCircleSmoothSDF state 0 0 circScale radius thickness+    Rotate _ (ThickCircleAliased radius thickness) ->       renderCircle 0 0 circScale radius thickness     Rotate deg (Arc a1 a2 radius) ->+      renderArcSmoothSDF state 0 0 circScale radius (a1 - deg) (a2 - deg) 0+    Rotate deg (ArcAliased a1 a2 radius) ->       renderArc 0 0 circScale radius (a1 - deg) (a2 - deg) 0     Rotate deg (ThickArc a1 a2 radius thickness) ->+      renderArcSmoothSDF state 0 0 circScale radius (a1 - deg) (a2 - deg) thickness+    Rotate deg (ThickArcAliased a1 a2 radius thickness) ->       renderArc 0 0 circScale radius (a1 - deg) (a2 - deg) thickness     Rotate deg p ->       GL.preservingMatrix $@@ -208,8 +334,8 @@                               ( fst imgSectionPos                               , snd imgSectionPos + snd imgSectionSize                               )-                        ]-                        :: [(Float, Float)]+                        ] ::+                        [(Float, Float)]                     toFloatVec = vecMap fromIntegral fromIntegral                     vecMap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)                     vecMap f g (x, y) = (f x, g y)@@ -220,7 +346,7 @@            -- Load the image data into a texture,           -- or grab it from the cache if we've already done that before.-          tex <- loadTexture (stateTextures state) imgData cacheMe+          tex <- loadTexture state.stateTextures imgData cacheMe            -- Set up wrap and filtering mode           GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)@@ -306,14 +432,14 @@ {-| Load a texture into the OpenGL context, or retrieve the existing handle   from our own cache. -}-loadTexture-  :: IORef [Texture]-  -- ^ Existing texture cache.-  -> BitmapData-  -- ^ Texture data.-  -> Bool-  -- ^ Force cache for newly loaded textures.-  -> IO Texture+loadTexture ::+  -- | Existing texture cache.+  IORef [Texture] ->+  -- | Texture data.+  BitmapData ->+  -- | Force cache for newly loaded textures.+  Bool ->+  IO Texture loadTexture refTextures imgData@BitmapData{bitmapSize = (width, height)} cacheMe =   do     textures <- readIORef refTextures@@ -426,3 +552,34 @@     GL.vertex $ GL.Vertex2 (gf x) (gf y)     vertexPFs rest {-# INLINE vertexPFs #-}+++-- SDF-based rendering helpers ------------------------------------------------++-- | Render a smooth circle using SDF shader+renderCircleSmoothSDF ::+  State -> Float -> Float -> Float -> Float -> Float -> IO ()+renderCircleSmoothSDF state posX posY scaleFactor radius thickness = do+  color <- get GL.currentColor+  let outerR = abs radius + abs thickness / 2+      innerR = max 0 (abs radius - abs thickness / 2)+  renderCircleSDF state.stateShaders posX posY scaleFactor outerR innerR color+++-- | Render a smooth arc using SDF shader+renderArcSmoothSDF ::+  State -> Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()+renderArcSmoothSDF state posX posY scaleFactor radius a1 a2 thickness = do+  color <- get GL.currentColor+  let outerR = abs radius + abs thickness / 2+      innerR = max 0 (abs radius - abs thickness / 2)+  renderArcSDF state.stateShaders posX posY scaleFactor outerR innerR a1 a2 color+++-- | Render a smooth thick line using SDF shader+renderThickLineSmoothSDF ::+  State -> Float -> Float -> Float -> [(Float, Float)] -> Float -> IO ()+renderThickLineSmoothSDF state offsetX offsetY scaleFactor path thickness = do+  color <- get GL.currentColor+  let translatedPath = map (\(x, y) -> (x + offsetX, y + offsetY)) path+  renderThickLineSDF state.stateShaders translatedPath scaleFactor thickness color

@@ -0,0 +1,118 @@+{-# OPTIONS_HADDOCK hide #-}++module Brillo.Internals.Rendering.Polygon (+  renderComplexPolygon,+  renderComplexPolygonSmooth,+) where++import Brillo.Internals.Rendering.Common+import Graphics.Rendering.OpenGL (($=))+import Graphics.Rendering.OpenGL.GL qualified as GL+import Graphics.Rendering.OpenGL.GLU.Tessellation+++combiner :: a -> b -> ()+combiner _ _ = ()+++-- written this way to measurably improve performance+zipLoop :: [a] -> [(a, a)]+zipLoop [] = []+zipLoop (x : xs) =+  let+    go y [] = [(y, x)]+    go y (z : rs) = (y, z) : go z rs+  in+    go x xs+++zipWithLoop :: (a -> a -> b) -> [a] -> [b]+zipWithLoop f = map (uncurry f) . zipLoop+++{-| Signed angle between 2 vectors+https://stackoverflow.com/a/16544330/1779797+Note: `isConvex` would remain correct if this returned a value+between theta*7/2pi and theta*7/4pi+which probably provides an opportunity for optimization+-}+angle :: (Float, Float) -> (Float, Float) -> Float+angle (x1, y1) (x2, y2) =+  let dot = x1 * x2 + y1 * y2 -- cos theta * |v1||v2|+      det = y2 * x1 - x2 * y1 -- sin theta * |v1||v2|+  in  atan2 det dot+++{-| Approximating 2pi by 7 is reasonable here.+The total rotation theoretically must be a multiple of 2pi,+so a little generosity doesn't break anything,+but might save some cases that would fail due to floating point errors+-}+isConvex :: [(Float, Float)] -> Bool+isConvex ps =+  let+    -- Combine angles, but return a value greater than 7+    -- if they have opposite signs+    angleAdd :: Float -> Float -> Float+    angleAdd a b = if signum a * signum b < -0.5 then 10 else a + b+  in+    -- Check that it doesn't turn more than one full circle in total+    all (\theta -> (theta <= 7) && (theta > -7)) $+      scanl angleAdd 0 $ -- Check that the path's direction is consistent+        zipWithLoop angle $ -- Compute angles of turns at each vertex+          filter (/= (0, 0)) $ -- Discard edges arising from duplicated vertices+          -- Produce vectors for each edge+            zipWithLoop (\(x1, y1) (x2, y2) -> (x2 - x1, y2 - y1)) ps+++renderComplexPolygon :: [(Float, Float)] -> IO ()+renderComplexPolygon path =+  if isConvex path+    then GL.renderPrimitive GL.Polygon $ vertexPFs path+    else do+      Triangulation ts <-+        triangulate TessWindingOdd 0 (GL.Normal3 0 0 1) combiner $+          ComplexPolygon+            [ ComplexContour+                [ AnnotatedVertex (GL.Vertex3 (realToFrac a) (realToFrac b) 0) ()+                | (a, b) <- path+                ]+            ]+      GL.renderPrimitive GL.Triangles (trisToGLVertices ts)+      return ()+++{-| Render a complex polygon with anti-aliased edges+  Draws the filled polygon, then overlays anti-aliased edges+-}+renderComplexPolygonSmooth :: [(Float, Float)] -> IO ()+renderComplexPolygonSmooth path = do+  -- First draw the filled polygon+  renderComplexPolygon path+  -- Then draw anti-aliased edges on top+  GL.lineSmooth $= GL.Enabled+  GL.renderPrimitive GL.LineLoop $ vertexPFs path+  GL.lineSmooth $= GL.Disabled+++trisToGLVertices :: [Triangle a] -> IO ()+trisToGLVertices [] = return ()+trisToGLVertices+  ( (Triangle (AnnotatedVertex v1 _) (AnnotatedVertex v2 _) (AnnotatedVertex v3 _))+      : rest+    ) =+    do+      GL.vertex v1+      GL.vertex v2+      GL.vertex v3+      trisToGLVertices rest+{-# INLINE trisToGLVertices #-}+++vertexPFs :: [(Float, Float)] -> IO ()+vertexPFs [] = return ()+vertexPFs ((x, y) : rest) =+  do+    GL.vertex $ GL.Vertex2 (gf x) (gf y)+    vertexPFs rest+{-# INLINE vertexPFs #-}

@@ -0,0 +1,463 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Shader-based rendering for anti-aliased shapes using signed distance fields.+module Brillo.Internals.Rendering.Shader (+  ShaderState (..),+  initShaderState,+  renderCircleSDF,+  renderArcSDF,+  renderThickLineSDF,+) where++import Control.Monad (unless)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Graphics.Rendering.OpenGL (($=))+import Graphics.Rendering.OpenGL.GL qualified as GL+++-- | State for shader-based rendering+data ShaderState = ShaderState+  { circleProgram :: !(IORef (Maybe GL.Program))+  , arcProgram :: !(IORef (Maybe GL.Program))+  , lineProgram :: !(IORef (Maybe GL.Program))+  }+++-- | Initialize shader state (programs are compiled lazily on first use)+initShaderState :: IO ShaderState+initShaderState = do+  circleRef <- newIORef Nothing+  arcRef <- newIORef Nothing+  lineRef <- newIORef Nothing+  return+    ShaderState+      { circleProgram = circleRef+      , arcProgram = arcRef+      , lineProgram = lineRef+      }+++-- | Vertex shader for SDF shapes - uses texture coords for local position+vertexShaderSrc :: String+vertexShaderSrc =+  unlines+    [ "#version 120"+    , "varying vec2 vLocalCoord;"+    , "void main() {"+    , "  vLocalCoord = gl_MultiTexCoord0.xy;"+    , "  gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex;"+    , "}"+    ]+++-- | Fragment shader for filled circle with SDF anti-aliasing+circleFragmentShaderSrc :: String+circleFragmentShaderSrc =+  unlines+    [ "#version 120"+    , "varying vec2 vLocalCoord;"+    , "uniform vec4 uColor;"+    , "uniform float uOuterRadius;"+    , "uniform float uInnerRadius;" -- 0 for solid circle+    , "uniform float uPixelSize;" -- Size of a pixel in local coords for AA width+    , ""+    , "void main() {"+    , "  float dist = length(vLocalCoord);"+    , "  // Compute actual pixel size from screen-space derivatives"+    , "  float pixelSize = length(vec2(dFdx(dist), dFdy(dist)));"+    , "  // AA width: ~1 pixel, but capped at 25% of radius so small circles remain visible"+    , "  float aaWidth = min(pixelSize, uOuterRadius * 0.25);"+    , ""+    , "  // Outer edge - AA extends outward from the edge to match aliased circle size"+    , "  float outerAlpha = 1.0 - smoothstep(uOuterRadius, uOuterRadius + aaWidth, dist);"+    , ""+    , "  // Inner edge (for rings) - AA extends inward from the edge"+    , "  float innerAlpha = uInnerRadius > 0.0 ? smoothstep(uInnerRadius - aaWidth, uInnerRadius, dist) : 1.0;"+    , ""+    , "  float alpha = outerAlpha * innerAlpha;"+    , "  if (alpha < 0.001) discard;"+    , "  gl_FragColor = vec4(uColor.rgb, uColor.a * alpha);"+    , "}"+    ]+++{-| Fragment shader for arc with SDF anti-aliasing+Arc is drawn counter-clockwise from start angle to end angle+-}+arcFragmentShaderSrc :: String+arcFragmentShaderSrc =+  unlines+    [ "#version 120"+    , "varying vec2 vLocalCoord;"+    , "uniform vec4 uColor;"+    , "uniform float uOuterRadius;"+    , "uniform float uInnerRadius;"+    , "uniform float uStartAngle;" -- In radians+    , "uniform float uSweep;" -- Arc sweep in radians (always positive, counter-clockwise)+    , "uniform float uPixelSize;"+    , ""+    , "#define PI 3.14159265359"+    , "#define TAU 6.28318530718"+    , ""+    , "void main() {"+    , "  float dist = length(vLocalCoord);"+    , "  float angle = atan(vLocalCoord.y, vLocalCoord.x);"+    , "  // Compute actual pixel size from screen-space derivatives"+    , "  float pixelSize = length(vec2(dFdx(dist), dFdy(dist)));"+    , "  // AA width: ~1 pixel, but capped at 25% of radius so small circles remain visible"+    , "  float aaWidth = min(pixelSize, uOuterRadius * 0.25);"+    , ""+    , "  // Outer edge - AA extends outward from the edge to match aliased circle size"+    , "  float outerAlpha = 1.0 - smoothstep(uOuterRadius, uOuterRadius + aaWidth, dist);"+    , ""+    , "  // Inner edge (for rings) - AA extends inward from the edge"+    , "  float innerAlpha = uInnerRadius > 0.0 ? smoothstep(uInnerRadius - aaWidth, uInnerRadius, dist) : 1.0;"+    , ""+    , "  // Calculate angle relative to start, normalized to [0, 2*PI)"+    , "  float relAngle = angle - uStartAngle;"+    , "  // Normalize to [0, 2*PI) - add TAU twice to handle very negative values"+    , "  relAngle = relAngle - TAU * floor(relAngle / TAU);"+    , ""+    , "  // Soft edges at arc boundaries using signed distance from boundaries"+    , "  float angularAA = aaWidth / max(dist, 0.001);"+    , ""+    , "  // Distance from start edge (positive = inside arc)"+    , "  float startDist = relAngle;"+    , "  // Distance from end edge (positive = inside arc)"+    , "  float endDist = uSweep - relAngle;"+    , ""+    , "  float startAlpha = smoothstep(-angularAA, angularAA, startDist);"+    , "  float endAlpha = smoothstep(-angularAA, angularAA, endDist);"+    , ""+    , "  float alpha = outerAlpha * innerAlpha * startAlpha * endAlpha;"+    , "  if (alpha < 0.001) discard;"+    , "  gl_FragColor = vec4(uColor.rgb, uColor.a * alpha);"+    , "}"+    ]+++{-| Fragment shader for line segment (capsule) with SDF anti-aliasing.+A thick line segment is rendered as a capsule - all points within+a given distance from the line segment.+-}+lineFragmentShaderSrc :: String+lineFragmentShaderSrc =+  "#version 120 \n\+  \varying vec2 vLocalCoord; \+  \uniform vec4 uColor; \+  \uniform vec2 uPointA; \+  \uniform vec2 uPointB; \+  \uniform float uThickness; \+  \uniform float uPixelSize; \+  \void main() { \+  \  vec2 pa = vLocalCoord - uPointA; \+  \  vec2 ba = uPointB - uPointA; \+  \  float len2 = dot(ba, ba); \+  \  float h = len2 > 0.0 ? clamp(dot(pa, ba) / len2, 0.0, 1.0) : 0.0; \+  \  float dist = length(pa - ba * h); \+  \  float aaWidth = min(uPixelSize, uThickness * 0.1); \+  \  float d = dist - uThickness; \+  \  float alpha = 1.0 - smoothstep(-aaWidth, aaWidth, d); \+  \  if (alpha < 0.001) discard; \+  \  gl_FragColor = vec4(uColor.rgb, uColor.a * alpha); \+  \}"+++-- | Compile a shader from source+compileShader :: GL.ShaderType -> String -> IO GL.Shader+compileShader shaderType src = do+  shader <- GL.createShader shaderType+  GL.shaderSourceBS shader $= GL.packUtf8 src+  GL.compileShader shader+  ok <- GL.get (GL.compileStatus shader)+  unless ok $ do+    infoLog <- GL.get (GL.shaderInfoLog shader)+    error $ "Shader compilation failed: " ++ infoLog+  return shader+++-- | Create and link a shader program+createProgram :: String -> String -> IO GL.Program+createProgram vertSrc fragSrc = do+  vertShader <- compileShader GL.VertexShader vertSrc+  fragShader <- compileShader GL.FragmentShader fragSrc++  program <- GL.createProgram+  GL.attachShader program vertShader+  GL.attachShader program fragShader++  GL.linkProgram program+  ok <- GL.get (GL.linkStatus program)+  unless ok $ do+    infoLog <- GL.get (GL.programInfoLog program)+    error $ "Program linking failed: " ++ infoLog++  -- Clean up shaders (they're copied into the program)+  GL.deleteObjectName vertShader+  GL.deleteObjectName fragShader++  return program+++-- | Get or create the circle shader program+getCircleProgram :: ShaderState -> IO GL.Program+getCircleProgram state = do+  maybeProgram <- readIORef (circleProgram state)+  case maybeProgram of+    Just prog -> return prog+    Nothing -> do+      prog <- createProgram vertexShaderSrc circleFragmentShaderSrc+      writeIORef (circleProgram state) (Just prog)+      return prog+++-- | Get or create the arc shader program+getArcProgram :: ShaderState -> IO GL.Program+getArcProgram state = do+  maybeProgram <- readIORef (arcProgram state)+  case maybeProgram of+    Just prog -> return prog+    Nothing -> do+      prog <- createProgram vertexShaderSrc arcFragmentShaderSrc+      writeIORef (arcProgram state) (Just prog)+      return prog+++-- | Get or create the line shader program+getLineProgram :: ShaderState -> IO GL.Program+getLineProgram state = do+  maybeProgram <- readIORef (lineProgram state)+  case maybeProgram of+    Just prog -> return prog+    Nothing -> do+      prog <- createProgram vertexShaderSrc lineFragmentShaderSrc+      writeIORef (lineProgram state) (Just prog)+      return prog+++-- | Render a circle/ring using SDF shader+renderCircleSDF ::+  ShaderState ->+  Float -> -- posX+  Float -> -- posY+  Float -> -- scaleFactor (pixels per unit)+  Float -> -- outer radius+  Float -> -- inner radius (0 for solid)+  GL.Color4 GL.GLfloat -> -- color+  IO ()+renderCircleSDF state posX posY scaleFactor outerR innerR color = do+  program <- getCircleProgram state++  -- Save current program+  oldProgram <- GL.get GL.currentProgram++  GL.currentProgram $= Just program++  -- Set uniforms+  uColorLoc <- GL.get (GL.uniformLocation program "uColor")+  uOuterLoc <- GL.get (GL.uniformLocation program "uOuterRadius")+  uInnerLoc <- GL.get (GL.uniformLocation program "uInnerRadius")+  uPixelLoc <- GL.get (GL.uniformLocation program "uPixelSize")++  GL.uniform uColorLoc $= color+  GL.uniform uOuterLoc $= (realToFrac outerR :: GL.GLfloat)+  GL.uniform uInnerLoc $= (realToFrac innerR :: GL.GLfloat)+  GL.uniform uPixelLoc $= (realToFrac (1.0 / scaleFactor) :: GL.GLfloat)++  -- Draw a quad that covers the circle+  let r = outerR + 2.0 / scaleFactor -- Add padding for AA+      x1 = posX - r+      x2 = posX + r+      y1 = posY - r+      y2 = posY + r+      -- Local coords relative to circle center+      l1 = -r+      l2 = r++  -- Draw quad with position (vertex) and local coords (texCoord)+  GL.renderPrimitive GL.Quads $ do+    GL.texCoord $+      GL.TexCoord2 (realToFrac l1 :: GL.GLfloat) (realToFrac l1 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x1 :: GL.GLfloat) (realToFrac y1 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l2 :: GL.GLfloat) (realToFrac l1 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x2 :: GL.GLfloat) (realToFrac y1 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l2 :: GL.GLfloat) (realToFrac l2 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x2 :: GL.GLfloat) (realToFrac y2 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l1 :: GL.GLfloat) (realToFrac l2 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x1 :: GL.GLfloat) (realToFrac y2 :: GL.GLfloat)++  GL.currentProgram $= oldProgram+++-- | Render an arc using SDF shader+renderArcSDF ::+  ShaderState ->+  Float -> -- posX+  Float -> -- posY+  Float -> -- scaleFactor+  Float -> -- outer radius+  Float -> -- inner radius+  Float -> -- start angle (degrees)+  Float -> -- end angle (degrees)+  GL.Color4 GL.GLfloat -> -- color+  IO ()+renderArcSDF state posX posY scaleFactor outerR innerR startDeg endDeg color = do+  program <- getArcProgram state++  oldProgram <- GL.get GL.currentProgram+  GL.currentProgram $= Just program++  -- Set uniforms+  uColorLoc <- GL.get (GL.uniformLocation program "uColor")+  uOuterLoc <- GL.get (GL.uniformLocation program "uOuterRadius")+  uInnerLoc <- GL.get (GL.uniformLocation program "uInnerRadius")+  uStartLoc <- GL.get (GL.uniformLocation program "uStartAngle")+  uSweepLoc <- GL.get (GL.uniformLocation program "uSweep")+  uPixelLoc <- GL.get (GL.uniformLocation program "uPixelSize")++  -- Convert to radians and calculate sweep (counter-clockwise from start to end)+  let startRad = startDeg * pi / 180.0+      endRad = endDeg * pi / 180.0+      -- Sweep is how far we go counter-clockwise from start to end+      -- If start >= end, we wrap around through 360 degrees+      sweep =+        if startDeg >= endDeg+          then (endRad + 2 * pi) - startRad+          else endRad - startRad++  GL.uniform uColorLoc $= color+  GL.uniform uOuterLoc $= (realToFrac outerR :: GL.GLfloat)+  GL.uniform uInnerLoc $= (realToFrac innerR :: GL.GLfloat)+  GL.uniform uStartLoc $= (realToFrac startRad :: GL.GLfloat)+  GL.uniform uSweepLoc $= (realToFrac sweep :: GL.GLfloat)+  GL.uniform uPixelLoc $= (realToFrac (1.0 / scaleFactor) :: GL.GLfloat)++  -- Draw a quad that covers the arc+  let r = outerR + 2.0 / scaleFactor+      x1 = posX - r+      x2 = posX + r+      y1 = posY - r+      y2 = posY + r+      l1 = -r+      l2 = r++  GL.renderPrimitive GL.Quads $ do+    GL.texCoord $+      GL.TexCoord2 (realToFrac l1 :: GL.GLfloat) (realToFrac l1 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x1 :: GL.GLfloat) (realToFrac y1 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l2 :: GL.GLfloat) (realToFrac l1 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x2 :: GL.GLfloat) (realToFrac y1 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l2 :: GL.GLfloat) (realToFrac l2 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x2 :: GL.GLfloat) (realToFrac y2 :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac l1 :: GL.GLfloat) (realToFrac l2 :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac x1 :: GL.GLfloat) (realToFrac y2 :: GL.GLfloat)++  GL.currentProgram $= oldProgram+++-- | Render a single line segment using SDF shader (capsule shape)+renderLineSegmentSDF ::+  ShaderState ->+  Float -> -- ax+  Float -> -- ay+  Float -> -- bx+  Float -> -- by+  Float -> -- scaleFactor (pixels per unit)+  Float -> -- thickness (diameter)+  GL.Color4 GL.GLfloat -> -- color+  IO ()+renderLineSegmentSDF state ax ay bx by scaleFactor thickness color = do+  program <- getLineProgram state++  oldProgram <- GL.get GL.currentProgram+  GL.currentProgram $= Just program++  -- Set uniforms+  uColorLoc <- GL.get (GL.uniformLocation program "uColor")+  uPointALoc <- GL.get (GL.uniformLocation program "uPointA")+  uPointBLoc <- GL.get (GL.uniformLocation program "uPointB")+  uThicknessLoc <- GL.get (GL.uniformLocation program "uThickness")+  uPixelLoc <- GL.get (GL.uniformLocation program "uPixelSize")++  let halfThick = thickness / 2.0++  GL.uniform uColorLoc $= color+  GL.uniform uPointALoc+    $= GL.Vector2 (realToFrac ax :: GL.GLfloat) (realToFrac ay)+  GL.uniform uPointBLoc+    $= GL.Vector2 (realToFrac bx :: GL.GLfloat) (realToFrac by)+  GL.uniform uThicknessLoc $= (realToFrac halfThick :: GL.GLfloat)+  GL.uniform uPixelLoc $= (realToFrac (1.0 / scaleFactor) :: GL.GLfloat)++  -- Compute bounding box with padding for AA+  let padding = 2.0 / scaleFactor+      r = halfThick + padding+      minX = min ax bx - r+      maxX = max ax bx + r+      minY = min ay by - r+      maxY = max ay by + r++  -- Draw quad covering the capsule+  -- vLocalCoord receives the vertex position (world space)+  GL.renderPrimitive GL.Quads $ do+    GL.texCoord $+      GL.TexCoord2 (realToFrac minX :: GL.GLfloat) (realToFrac minY :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac minX :: GL.GLfloat) (realToFrac minY :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac maxX :: GL.GLfloat) (realToFrac minY :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac maxX :: GL.GLfloat) (realToFrac minY :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac maxX :: GL.GLfloat) (realToFrac maxY :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac maxX :: GL.GLfloat) (realToFrac maxY :: GL.GLfloat)++    GL.texCoord $+      GL.TexCoord2 (realToFrac minX :: GL.GLfloat) (realToFrac maxY :: GL.GLfloat)+    GL.vertex $+      GL.Vertex2 (realToFrac minX :: GL.GLfloat) (realToFrac maxY :: GL.GLfloat)++  GL.currentProgram $= oldProgram+++-- | Render an entire path as connected thick line segments using SDF+renderThickLineSDF ::+  ShaderState ->+  [(Float, Float)] -> -- Path points+  Float -> -- scaleFactor+  Float -> -- thickness+  GL.Color4 GL.GLfloat -> -- color+  IO ()+renderThickLineSDF _state [] _ _ _ = return ()+renderThickLineSDF _state [_] _ _ _ = return () -- Single point, nothing to draw+renderThickLineSDF state path scaleFactor thickness color = do+  -- Render each segment as a capsule+  -- Overlapping capsules at joins naturally create rounded joins+  let segments = zip path (drop 1 path)+  mapM_ renderSegment segments+  where+    renderSegment ((ax, ay), (bx, by)) =+      renderLineSegmentSDF state ax ay bx by scaleFactor thickness color

@@ -9,6 +9,7 @@ where  import Brillo.Internals.Rendering.Bitmap (BitmapData)+import Brillo.Internals.Rendering.Shader (ShaderState, initShaderState) import Data.IORef (IORef, newIORef) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr)@@ -31,6 +32,8 @@   -- ^ Whether to use line smoothing   , stateTextures :: !(IORef [Texture])   -- ^ Cache of Textures that we've sent to OpenGL.+  , stateShaders :: !ShaderState+  -- ^ Shader programs for SDF-based rendering.   }  @@ -60,6 +63,7 @@ initState =   do     textures <- newIORef []+    shaders <- initShaderState     return       State         { stateColor = True@@ -67,4 +71,5 @@         , stateBlendAlpha = True         , stateLineSmooth = False         , stateTextures = textures+        , stateShaders = shaders         }

@@ -0,0 +1,261 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++-- | Rendering support for TrueType fonts using the FreeType bindings.+module Brillo.Internals.Rendering.TrueTypeFont (+  renderTrueTypeText,+) where++import Brillo.Internals.Rendering.Common (gf)+import Control.Applicative ((<|>))+import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)+import Control.Exception (try)+import Control.Monad (foldM, forM, forM_)+import Data.Either (partitionEithers)+import Data.Int (Int32)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Word (Word8)+import Foreign (Ptr, nullPtr, peek)+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)+import Foreign.Storable (peekElemOff, pokeElemOff)+import FreeType (+  FT_Bitmap (bBuffer, bRows, bWidth),+  FT_Face,+  FT_FaceRec (frGlyph),+  FT_GlyphSlotRec (+    gsrAdvance,+    gsrBitmap,+    gsrBitmap_left,+    gsrBitmap_top+  ),+  FT_Vector (vX),+  ft_Done_Face,+  ft_Done_FreeType,+  ft_Init_FreeType,+  ft_Load_Char,+  ft_New_Face,+  ft_Set_Pixel_Sizes,+  pattern FT_LOAD_RENDER,+ )+import FreeType.Exception (FtError)+import Graphics.Rendering.OpenGL (+  TextureFunction (Modulate),+  get,+  textureBinding,+  ($=),+ )+import Graphics.Rendering.OpenGL.GL qualified as GL+import Graphics.UI.GLFW qualified as GLFW+import System.IO.Unsafe (unsafePerformIO)+++-- Glyph data ----------------------------------------------------------------++data Glyph+  = Glyph+  { glyphTexture :: !(Maybe GL.TextureObject)+  , glyphSize :: !(Int, Int)+  , glyphBearing :: !(Int32, Int32)+  , glyphAdvance :: !Int32+  }+++type FontKey = (FilePath, Int)+type FontCache = Map FontKey (Map Char Glyph)+++fontCache :: MVar FontCache+fontCache = unsafePerformIO (newMVar Map.empty)+{-# NOINLINE fontCache #-}+++-- | Detect the content scale factor (DPI scale) for HiDPI/Retina displays+getContentScale :: IO Float+getContentScale = do+  mWindow <- GLFW.getCurrentContext+  case mWindow of+    Nothing -> pure 1.0 -- No window context, assume scale 1.0+    Just win -> do+      (fbWidth, fbHeight) <- GLFW.getFramebufferSize win+      (winWidth, winHeight) <- GLFW.getWindowSize win+      -- Calculate scale factor from framebuffer vs window size+      -- Use width as primary, fall back to height if width is zero+      let scaleX = if winWidth > 0 then fromIntegral fbWidth / fromIntegral winWidth else 1.0+          scaleY = if winHeight > 0 then fromIntegral fbHeight / fromIntegral winHeight else 1.0+      -- Use the maximum scale factor to ensure crisp rendering+      pure $ max scaleX scaleY+++renderTrueTypeText :: FilePath -> Int -> Text -> IO ()+renderTrueTypeText fontPath pixelHeight str+  | T.null str = pure ()+  | otherwise = do+      -- Detect DPI scale factor for HiDPI/Retina displays+      scaleFactor <- getContentScale+      let scaledHeight = round (fromIntegral pixelHeight * scaleFactor)++      glyphs <- getOrLoadFont fontPath scaledHeight+      let fallbackGlyph = Map.lookup '?' glyphs+      GL.texture GL.Texture2D $= GL.Enabled+      oldTexFunc <- get GL.textureFunction+      GL.textureFunction $= Modulate+      GL.preservingMatrix $ do+        -- Scale down by the same factor to maintain logical size+        GL.scale+          (1.0 / realToFrac scaleFactor)+          (1.0 / realToFrac scaleFactor)+          (1.0 :: GL.GLfloat)+        _ <-+          foldM+            (renderGlyph glyphs fallbackGlyph scaledHeight)+            (0, 0)+            (T.unpack str)+        pure ()+      GL.textureFunction $= oldTexFunc+      GL.texture GL.Texture2D $= GL.Disabled+++renderGlyph ::+  Map Char Glyph ->+  Maybe Glyph ->+  Int ->+  (Float, Float) ->+  Char ->+  IO (Float, Float)+renderGlyph glyphs fallback lineHeight (penX, penY) = \case+  '\n' ->+    pure (0, penY - fromIntegral lineHeight)+  ch ->+    do+      let glyph = Map.lookup ch glyphs <|> fallback+      case glyph of+        Nothing ->+          pure (penX, penY)+        Just+          Glyph{glyphTexture, glyphSize = (w, h), glyphBearing = (bx, by), glyphAdvance} ->+            do+              let advance = fromIntegral glyphAdvance / 64+                  xpos = penX + fromIntegral bx+                  ypos = penY + fromIntegral by - fromIntegral h+                  width = fromIntegral w+                  height = fromIntegral h+              case glyphTexture of+                Nothing ->+                  pure (penX + advance, penY)+                Just tex -> do+                  textureBinding GL.Texture2D $= Just tex+                  GL.renderPrimitive GL.Quads $ do+                    GL.texCoord $ GL.TexCoord2 0 (0 :: GL.GLfloat)+                    GL.vertex $ GL.Vertex3 (gf xpos) (gf (ypos + height)) 0+                    GL.texCoord $ GL.TexCoord2 0 (1 :: GL.GLfloat)+                    GL.vertex $ GL.Vertex3 (gf xpos) (gf ypos) 0+                    GL.texCoord $ GL.TexCoord2 1 (1 :: GL.GLfloat)+                    GL.vertex $ GL.Vertex3 (gf (xpos + width)) (gf ypos) 0+                    GL.texCoord $ GL.TexCoord2 1 (0 :: GL.GLfloat)+                    GL.vertex $ GL.Vertex3 (gf (xpos + width)) (gf (ypos + height)) 0+                  pure (penX + advance, penY)+++-- Font loading --------------------------------------------------------------++getOrLoadFont :: FilePath -> Int -> IO (Map Char Glyph)+getOrLoadFont fontPath pixelHeight =+  modifyMVar fontCache $+    \cache ->+      case Map.lookup key cache of+        Just font ->+          pure (cache, font)+        Nothing -> do+          font <- loadFont fontPath pixelHeight+          pure (Map.insert key font cache, font)+  where+    key = (fontPath, pixelHeight)+++loadFont :: FilePath -> Int -> IO (Map Char Glyph)+loadFont fontPath pixelHeight = do+  library <- ft_Init_FreeType+  face <- ft_New_Face library fontPath 0+  ft_Set_Pixel_Sizes face 0 (fromIntegral pixelHeight)+  GL.rowAlignment GL.Unpack $= 1+  glyphs <- forM [0 .. 255] $ loadGlyph face+  ft_Done_Face face+  ft_Done_FreeType library+  let (errs, okGlyphs) = partitionEithers glyphs+  case errs of+    [] -> pure (Map.fromList okGlyphs)+    (err : _) -> ioError (userError err)+++loadGlyph :: FT_Face -> Int -> IO (Either String (Char, Glyph))+loadGlyph face codepoint = do+  let ch = toEnum codepoint+  loadResult <-+    try (ft_Load_Char face (fromIntegral codepoint) FT_LOAD_RENDER) ::+      IO (Either FtError ())+  case loadResult of+    Left err ->+      pure . Left $+        "FreeType load error for char " <> show ch <> ": " <> show err+    Right () -> do+      faceRec <- peek face+      glyphSlot <- peek (frGlyph faceRec)+      let bitmap = gsrBitmap glyphSlot+          width = fromIntegral (bWidth bitmap) :: Int+          rows = fromIntegral (bRows bitmap) :: Int+          bearingX = fromIntegral (gsrBitmap_left glyphSlot) :: Int32+          bearingY = fromIntegral (gsrBitmap_top glyphSlot) :: Int32+          advance = fromIntegral (vX (gsrAdvance glyphSlot)) :: Int32+          buffer = bBuffer bitmap++      texture <-+        if width == 0 || rows == 0 || buffer == nullPtr+          then pure Nothing+          else do+            rgbaData <- buildRgbaBuffer width rows buffer+            tex <- GL.genObjectName+            GL.textureBinding GL.Texture2D $= Just tex+            withForeignPtr rgbaData $ \ptr ->+              GL.texImage2D+                GL.Texture2D+                GL.NoProxy+                0+                GL.RGBA8+                (GL.TextureSize2D (fromIntegral width) (fromIntegral rows))+                0+                (GL.PixelData GL.RGBA GL.UnsignedByte ptr)+            GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.ClampToEdge)+            GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.ClampToEdge)+            GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')+            pure (Just tex)++      pure $+        Right+          ( ch+          , Glyph+              { glyphTexture = texture+              , glyphSize = (width, rows)+              , glyphBearing = (bearingX, bearingY)+              , glyphAdvance = advance+              }+          )+++buildRgbaBuffer :: Int -> Int -> Ptr Word8 -> IO (ForeignPtr Word8)+buildRgbaBuffer width rows src = do+  let pixelCount = width * rows+      byteCount = pixelCount * 4+  dest <- mallocForeignPtrBytes byteCount+  withForeignPtr dest $ \ptr -> do+    forM_ [0 .. pixelCount - 1] $ \i -> do+      alpha <- peekElemOff src i+      let base = i * 4+      pokeElemOff ptr base (255 :: Word8)+      pokeElemOff ptr (base + 1) (255 :: Word8)+      pokeElemOff ptr (base + 2) (255 :: Word8)+      pokeElemOff ptr (base + 3) alpha+  pure dest

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Inspired by https://hackage.haskell.org/package/VectorFont module Brillo.Internals.Rendering.VectorFont (   VectorFont,@@ -12,10 +14,13 @@ ) where  import Control.Monad (replicateM, (>=>))+import Data.Bifunctor (first) import Data.Either (partitionEithers) import Data.List (minimumBy, permutations) import Data.Map (Map, findWithDefault, fromList, lookup) import Data.Ord (comparing)+import Data.Text (Text)+import Data.Text qualified as T   type VFWidth = Double@@ -39,22 +44,22 @@ newtype VectorFont = VectorFont (Map Char VFGlyph)  -{-| Given a @VectorFont@ and a @String@, return-  * @Right@ strokes if the @String@ can be rendered.+{-| Given a @VectorFont@ and a @Text@, return+  * @Right@ strokes if the @Text@ can be rendered.   * @Left@ error otherwise. -}-render :: VectorFont -> String -> Either String [VFStroke]+render :: VectorFont -> Text -> Either Text [VFStroke] render f =   getGlyphs f >=> (Right . renderLine 0)  -getGlyphs :: VectorFont -> String -> Either String [VFGlyph]+getGlyphs :: VectorFont -> Text -> Either Text [VFGlyph] getGlyphs f =-  addErrorMsg . leftsOrRights . map (getGlyph f)+  addErrorMsg . first T.pack . leftsOrRights . map (getGlyph f) . T.unpack  -addErrorMsg :: Either String a -> Either String a-addErrorMsg (Left a) = Left $ "Missing chars: " ++ a+addErrorMsg :: Either Text a -> Either Text a+addErrorMsg (Left a) = Left $ "Missing chars: " <> a addErrorMsg a = a  @@ -78,9 +83,9 @@ useful if you want to ignore the possibility of errors e.g. because you're manually checking the output. -}-renderSafe :: VectorFont -> String -> [VFStroke]+renderSafe :: VectorFont -> Text -> [VFStroke] renderSafe f =-  renderLine 0 . map (getGlyphSafe f)+  renderLine 0 . map (getGlyphSafe f) . T.unpack   getGlyphSafe :: VectorFont -> Char -> VFGlyph@@ -153,17 +158,20 @@ -- preferring (in order): score :: [VFStroke] -> (Int, Double, VFPoint) score ss | length ss < 2 = (length ss, 0.0, (0.0, 0.0))-score ss = do+score ss@((firstPoint : _) : _) = do   let-    skips = zipWith (\as bs -> dist (last as) (head bs)) ss (tail ss)-    firstPoint = head $ head ss+    skips = zipWith (\as bs -> dist (last as) (safeHead bs)) ss (drop 1 ss)+    safeHead (x : _) = x+    safeHead [] = (0.0, 0.0)   (length ss, sum skips, firstPoint)+score _ = (0, 0.0, (0.0, 0.0))   joinStrokes :: (Eq a) => [[a]] -> [[a]]-joinStrokes (s0 : s1 : ss)-  | last s0 == head s1 = joinStrokes $ (s0 ++ tail s1) : ss+joinStrokes (s0 : s1@(h1 : t1) : ss)+  | last s0 == h1 = joinStrokes $ (s0 ++ t1) : ss   | otherwise = s0 : joinStrokes (s1 : ss)+joinStrokes (s0 : s1 : ss) = s0 : joinStrokes (s1 : ss) joinStrokes ss = ss  {- FOURMOLU_DISABLE -}@@ -281,11 +289,11 @@   , ('^',(12,[[(2,12),(8,18),(14,12)],[(11,15),(8,19),(5,15)]]))   , ('_',(12,[[(0,-2),(16,-2)]]))   , ('`',(6,[[(5,17),(6,16),(5,15),(4,16),(4,18),(5,20),(6,21)]]))-  , ('a',(15,[[(15,0),(15,14)],[(15,11),(13,13),(11,14),(8,14),(6,13),(4,11)+  , ('a',(16,[[(15,0),(15,14)],[(15,11),(13,13),(11,14),(8,14),(6,13),(4,11)       ,(3,8),(3,6),(4,3),(6,1),(8,0),(11,0),(13,1),(15,3)]]))   , ('b',(15,[[(4,11),(6,13),(8,14),(11,14),(13,13),(15,11),(16,8),(16,6),(15,3)       ,(13,1),(11,0),(8,0),(6,1),(4,3)],[(4,0),(4,21)]]))-  , ('c',(14,[[(15,3),(13,1),(11,0),(8,0),(6,1),(4,3),(3,6),(3,8),(4,11),(6,13)+  , ('c',(15,[[(15,3),(13,1),(11,0),(8,0),(6,1),(4,3),(3,6),(3,8),(4,11),(6,13)       ,(8,14),(11,14),(13,13),(15,11)]]))   , ('d',(14,[[(12,11),(10,13),(8,14),(6,14),(4,13),(2,11),(1,8),(1,6),(2,3)       ,(4,1),(6,0),(8,0),(10,1),(12,3)],[(12,0),(12,21)]]))

@@ -16,8 +16,7 @@    -- * Bitmaps   Rectangle (..),-  BitmapData,-  bitmapSize,+  BitmapData (..),   BitmapFormat (..),   PixelFormat (..),   RowOrder (..),@@ -57,19 +56,20 @@   and set that to the active context. If you don't want to do your own window   management then use the @brillo@ package instead. -}-displayPicture-  :: (Int, Int)-  -- ^ Window width and height.-  -> Color-  -- ^ Color to clear the window with.-  -> RS.State-  -- ^ Current rendering state.-  -> Float-  -- ^ View port scale, which controls the level of detail.-  --   Use 1.0 to start with.-  -> Picture-  -- ^ Picture to draw.-  -> IO ()+displayPicture ::+  -- | Window width and height.+  (Int, Int) ->+  -- | Color to clear the window with.+  Color ->+  -- | Current rendering state.+  RS.State ->+  {-| View port scale, which controls the level of detail.+  Use 1.0 to start with.+  -}+  Float ->+  -- | Picture to draw.+  Picture ->+  IO () displayPicture windowSize colorClear state scale picture =   withModelview windowSize $     withClearBuffer colorClear $

@@ -1,6 +1,6 @@ cabal-version: 3.0 name:          brillo-rendering-version:       1.13.3+version:       2.0.0 license:       MIT license-file:  LICENSE author:        Elise Huard, Ben Lippmeier, Adrian Sieber@@ -14,6 +14,8 @@   If you want Brillo to setup your window as well,   then use the plain @brillo@ package. +tested-with:   GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2+ source-repository head   type:     git   location: https://github.com/ad-si/Brillo@@ -29,15 +31,20 @@     Brillo.Internals.Rendering.Color     Brillo.Internals.Rendering.Common     Brillo.Internals.Rendering.Picture+    Brillo.Internals.Rendering.Polygon+    Brillo.Internals.Rendering.Shader     Brillo.Internals.Rendering.State+    Brillo.Internals.Rendering.TrueTypeFont     Brillo.Internals.Rendering.VectorFont    build-depends:     , base        >=4.8  && <5     , bmp         >=1.2  && <1.3-    , bytestring  >=0.11 && <0.12-    , containers  >=0.5  && <0.7+    , bytestring  >=0.11 && <0.13+    , containers  >=0.5  && <0.9+    , freetype2   >=0.2  && <0.4+    , GLFW-b      >=3.3  && <4     , OpenGL      >=2.12 && <3.1-    , vector      >=0.13 && <0.14+    , text        >=2.0  && <2.2    ghc-options:      -Wall -O2