add ruler ticks

* also includes some improvements to Cairo pixel alignment

MetaBrush.cabal

@@ -115,6 +115,7 @@ executable MetaBrush
       , MetaBrush.Document.SubdivideStroke
       , MetaBrush.Event
       , MetaBrush.Render.Document
+      , MetaBrush.Render.Rulers
       , MetaBrush.Time
       , MetaBrush.UI.Coordinates
       , MetaBrush.UI.FileBar

app/Main.hs

@@ -13,7 +13,7 @@ module Main
 
 -- base
 import Control.Monad
-  ( void, when )
+  ( void )
 import Data.Foldable
   ( for_ )
 import Data.Int
@@ -86,7 +86,9 @@ import MetaBrush.Document
 import MetaBrush.Event
   ( handleEvents )
 import MetaBrush.Render.Document
-  ( renderDocument, renderGuides, blankRender )
+  ( renderDocument, blankRender )
+import MetaBrush.Render.Rulers
+  ( renderRuler )
 import MetaBrush.UI.FileBar
   ( FileBar(..), createFileBar )
 import MetaBrush.UI.InfoBar
@@ -303,11 +305,10 @@ main = do
           colours mode ( viewportWidth, viewportHeight )
           mbMousePos mbHoldAction mbPartialPath
           doc
-        when showGuides do
+        renderRuler
-          renderGuides
+          colours ( viewportWidth, viewportHeight ) ViewportOrigin ( viewportWidth, viewportHeight )
-            colours ( viewportWidth, viewportHeight ) ViewportOrigin ( viewportWidth, viewportHeight )
+          mbMousePos mbHoldAction showGuides
-            mbMousePos mbHoldAction
+          doc
-            doc
     case mbRender of
       Just render -> Cairo.renderWithContext render                  ctx
       Nothing     -> Cairo.renderWithContext ( blankRender colours ) ctx
@@ -328,11 +329,10 @@ main = do
         mbHoldAction   <- STM.readTVar mouseHoldTVar
         showGuides     <- STM.readTVar showGuidesTVar
         pure do
-          when showGuides do
+          renderRuler
-            renderGuides
+            colours ( viewportWidth, viewportHeight ) ( RulerOrigin ruler ) ( width, height )
-              colours ( viewportWidth, viewportHeight ) ( RulerOrigin ruler ) ( width, height )
+            mbMousePos mbHoldAction showGuides
-              mbMousePos mbHoldAction
+            doc
-              doc
       for_ mbRender \ render -> Cairo.renderWithContext render ctx
 
       pure True

assets/theme.css

@@ -21,6 +21,9 @@
 .cursorStroke {
   color: black;
 }
+.cursorIndicator {
+  color: rgba(199, 40, 29, 0.9);
+}
 .plain {
   color: rgb(212, 190, 152);
 }
@@ -75,8 +78,11 @@
 .tabScrollbar {
   background-color: rgba(48, 45, 38, 0.66);
 }
+.rulerTick {
+  color: black;
+}
 .guide {
-  color: rgba(28, 196, 79, 0.4)
+  color: rgba(28, 196, 79, 0.75);
 }
 .magnifier {
   color: rgb(236, 223, 210);
@@ -152,7 +158,22 @@ tooltip {
   background-size: 16px 16px;
 }
 
+.leftRuler {
+  border-right: 1px solid black;
+  min-width: 16px;
+}
 
+.topRuler {
+  border-bottom: 1px solid black;
+  min-height: 16px;
+}
+
+.rulerCorner {
+  min-width: 8px;
+  min-height: 8px;
+  border-bottom: 1px solid black;
+  border-right: 1px solid black;
+}
 
 /* Cursor colour */
 .cursor {

src/app/MetaBrush/Asset/CloseTabButton.hs

@@ -24,8 +24,6 @@ import MetaBrush.Util
 drawCloseTabButton :: Colours -> Bool -> [ GTK.StateFlags ] -> Cairo.Render Bool
 drawCloseTabButton ( Colours {..} ) unsavedChanges flags = do
 
-  Cairo.setLineCap  Cairo.LineCapRound
-  Cairo.setLineJoin Cairo.LineJoinMiter
 
   if unsavedChanges
   then do
@@ -44,6 +42,7 @@ drawCloseTabButton ( Colours {..} ) unsavedChanges flags = do
     if clicked
     then do
       Cairo.setLineWidth 5
+      Cairo.setLineCap  Cairo.LineCapRound
       withRGBA close Cairo.setSourceRGBA
       drawCross
       
@@ -54,7 +53,7 @@ drawCloseTabButton ( Colours {..} ) unsavedChanges flags = do
       else withRGBA plain Cairo.setSourceRGBA
 
   Cairo.setLineWidth 2
-
+  Cairo.setLineCap  Cairo.LineCapButt
   drawCross
 
   pure True
@@ -66,10 +65,10 @@ drawCloseTabButton ( Colours {..} ) unsavedChanges flags = do
 drawCross :: Cairo.Render ()
 drawCross = do
   Cairo.newPath
-  Cairo.moveTo 3 9
+  Cairo.moveTo 2.5  8.5
-  Cairo.lineTo 7 13
+  Cairo.lineTo 7.5 13.5
   Cairo.stroke
 
-  Cairo.moveTo 3 13
+  Cairo.moveTo 2.5 13.5
-  Cairo.lineTo 7 9
+  Cairo.lineTo 7.5  8.5
   Cairo.stroke

src/app/MetaBrush/Asset/Colours.hs

@@ -30,13 +30,14 @@ import Data.Text
 
 data ColourRecord a
   = Colours
-  { bg, active, close, highlight, cursor, cursorOutline      
+  { bg, active, close, highlight
+  , cursor, cursorOutline, cursorIndicator
   , plain, base, splash
   , pathPoint, pathPointOutline, controlPoint, controlPointOutline
   , path, brush, brushStroke, brushCenter
   , pointHover, pointSelected
   , viewport, viewportScrollbar, tabScrollbar
-  , guide, magnifier, glass
+  , guide, rulerTick, magnifier, glass
   , selected, selectedOutline :: !a
   }
   deriving stock ( Show, Functor, Foldable, Traversable )
@@ -62,6 +63,7 @@ colourNames = Colours
   , highlight           = ColourName "highlight"                   Colour [ GTK.StateFlagsNormal ]
   , cursor              = ColourName "cursor"                      Colour [ GTK.StateFlagsNormal ]
   , cursorOutline       = ColourName "cursorStroke"                Colour [ GTK.StateFlagsNormal ]
+  , cursorIndicator     = ColourName "cursorIndicator"             Colour [ GTK.StateFlagsNormal ]
   , plain               = ColourName "plain"                       Colour [ GTK.StateFlagsNormal ]
   , base                = ColourName "base"                        Colour [ GTK.StateFlagsNormal ]
   , splash              = ColourName "splash"                      Colour [ GTK.StateFlagsNormal ]
@@ -78,6 +80,7 @@ colourNames = Colours
   , viewport            = ColourName "viewport"          BackgroundColour [ GTK.StateFlagsNormal ]
   , viewportScrollbar   = ColourName "viewportScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
   , tabScrollbar        = ColourName "tabScrollbar"      BackgroundColour [ GTK.StateFlagsNormal ]
+  , rulerTick           = ColourName "rulerTick"                   Colour [ GTK.StateFlagsNormal ]
   , guide               = ColourName "guide"                       Colour [ GTK.StateFlagsNormal ]
   , magnifier           = ColourName "magnifier"                   Colour [ GTK.StateFlagsNormal ]
   , glass               = ColourName "glass"                       Colour [ GTK.StateFlagsNormal ]

src/app/MetaBrush/Asset/Cursor.hs

@@ -19,18 +19,19 @@ import MetaBrush.Util
 drawCursor :: Colours -> Cairo.Render Bool
 drawCursor ( Colours { cursor, cursorOutline } ) = do
 
-  Cairo.setLineWidth 1
-  withRGBA cursorOutline Cairo.setSourceRGBA
   Cairo.newPath
-  Cairo.moveTo 12.625 10.582031
+  Cairo.moveTo  12.5 10.5
-  Cairo.curveTo 5.699219 11.101563 4.097656 12.3125 0 17.976563
+  Cairo.curveTo  5.5 11.5 4.5 12.5 0.5 17.5
-  Cairo.lineTo 0.078125 0
+  Cairo.lineTo   0.5  0
   Cairo.closePath
-  Cairo.strokePreserve
 
   withRGBA cursor Cairo.setSourceRGBA
   Cairo.fillPreserve
 
+  Cairo.setLineWidth 1
+  withRGBA cursorOutline Cairo.setSourceRGBA
+  Cairo.strokePreserve
+
   pure True
 
 -- | "Selection" tool icon. 40 x 40.
@@ -39,9 +40,9 @@ drawCursorIcon ( Colours { cursor } )  = do
 
   withRGBA cursor Cairo.setSourceRGBA
   Cairo.newPath
-  Cairo.moveTo 29.035156 22.058594
+  Cairo.moveTo  29 22
-  Cairo.curveTo 20.089844 22.722656 18.023438 24.289063 12.734375 31.605469
+  Cairo.curveTo 20 22 18 24 12 31
-  Cairo.lineTo 12.835938 8.394531
+  Cairo.lineTo  12 8.5
   Cairo.closePath
   Cairo.fillPreserve
 

src/app/MetaBrush/Asset/WindowIcons.hs

@@ -22,10 +22,10 @@ drawMinimise ( Colours { plain } ) = do
   withRGBA plain Cairo.setSourceRGBA
 
   Cairo.newPath
-  Cairo.moveTo 6.144531 12.914063
+  Cairo.moveTo  6 13
-  Cairo.lineTo 6.144531 16.675781
+  Cairo.lineTo  6 17
-  Cairo.lineTo 17.855469 16.675781
+  Cairo.lineTo 18 17
-  Cairo.lineTo 17.855469 12.914063
+  Cairo.lineTo 18 13
   Cairo.closePath
   Cairo.fillPreserve
 
@@ -38,26 +38,26 @@ drawRestoreDown ( Colours { plain } ) = do
   withRGBA plain Cairo.setSourceRGBA
 
   Cairo.newPath
-  Cairo.moveTo 8.453125 4.179688
+  Cairo.moveTo  8  4
-  Cairo.lineTo 8.453125 9.230469
+  Cairo.lineTo  8  9
-  Cairo.lineTo 4.941406 9.230469
+  Cairo.lineTo  4  9
-  Cairo.lineTo 4.941406 19.105469
+  Cairo.lineTo  4 19
-  Cairo.lineTo 15.8125 19.105469
+  Cairo.lineTo 15 19
-  Cairo.lineTo 15.8125 14.761719
+  Cairo.lineTo 15 14
-  Cairo.lineTo 19.324219 14.761719
+  Cairo.lineTo 19 14
-  Cairo.lineTo 19.324219 4.179688
+  Cairo.lineTo 19  4
   Cairo.closePath
-  Cairo.moveTo 9.988281 7.261719
+  Cairo.moveTo  9  7
-  Cairo.lineTo 17.773438 7.261719
+  Cairo.lineTo 18  7
-  Cairo.lineTo 17.773438 13.238281
+  Cairo.lineTo 18 13
-  Cairo.lineTo 15.8125 13.238281
+  Cairo.lineTo 15 13
-  Cairo.lineTo 15.8125 9.230469
+  Cairo.lineTo 15  9
-  Cairo.lineTo 9.988281 9.230469
+  Cairo.lineTo  9  9
   Cairo.closePath
-  Cairo.moveTo 6.476563 12.316406
+  Cairo.moveTo  5 12
-  Cairo.lineTo 14.261719 12.316406
+  Cairo.lineTo 14 12
-  Cairo.lineTo 14.261719 17.597656
+  Cairo.lineTo 14 18
-  Cairo.lineTo 6.476563 17.597656
+  Cairo.lineTo  5 18
   Cairo.closePath
   Cairo.fillPreserve
 
@@ -70,15 +70,15 @@ drawMaximise ( Colours { plain } ) = do
   withRGBA plain Cairo.setSourceRGBA
 
   Cairo.newPath  
-  Cairo.moveTo 5.386719 5.449219
+  Cairo.moveTo  6  5
-  Cairo.lineTo 5.386719 18.550781
+  Cairo.lineTo  6 18
-  Cairo.lineTo 18.613281 18.550781
+  Cairo.lineTo 19 18
-  Cairo.lineTo 18.613281 5.449219
+  Cairo.lineTo 19  5
   Cairo.closePath
-  Cairo.moveTo 6.921875 9.128906
+  Cairo.moveTo  7  9
-  Cairo.lineTo 17.078125 9.128906
+  Cairo.lineTo 18  9
-  Cairo.lineTo 17.078125 17.023438
+  Cairo.lineTo 18 17
-  Cairo.lineTo 6.921875 17.023438
+  Cairo.lineTo  7 17
   Cairo.closePath
   Cairo.fillPreserve
 
@@ -91,17 +91,17 @@ drawClose ( Colours { plain } ) = do
   Cairo.setLineWidth 2
   withRGBA plain Cairo.setSourceRGBA
 
-  Cairo.setLineCap  Cairo.LineCapRound
+  Cairo.setLineCap  Cairo.LineCapSquare
   Cairo.setLineJoin Cairo.LineJoinMiter
 
   Cairo.newPath 
-  Cairo.moveTo 6.132813 6.238281
+  Cairo.moveTo  6.5  6.5
-  Cairo.lineTo 17.867188 17.761719
+  Cairo.lineTo 17.5 17.5
   Cairo.strokePreserve
 
   Cairo.newPath
-  Cairo.moveTo 6.132813 17.761719
+  Cairo.moveTo  6.5 17.5
-  Cairo.lineTo 17.867188 6.23828
+  Cairo.lineTo 17.5  6.5
   Cairo.strokePreserve
 
   pure True

src/app/MetaBrush/Render/Document.hs

@@ -12,14 +12,14 @@
 {-# LANGUAGE TypeApplications    #-}
 
 module MetaBrush.Render.Document
-  ( renderDocument, renderGuides, blankRender )
+  ( renderDocument, blankRender )
   where
 
 -- base
 import Control.Monad
   ( guard, when, unless )
 import Data.Foldable
-  ( for_, sequenceA_, toList )
+  ( for_, sequenceA_ )
 import Data.Functor.Compose
   ( Compose(..) )
 import Data.Int
@@ -38,8 +38,6 @@ import Data.Act
   )
 
 -- containers
-import qualified Data.Map as Map
-  ( adjust )
 import Data.Sequence
   ( Seq(..) )
 import qualified Data.Sequence as Seq
@@ -50,8 +48,6 @@ import Generic.Data
   ( Generically1(..) )
 
 -- generic-lens
-import Data.Generics.Product.Fields
-  ( field' )
 import Data.Generics.Product.Typed
   ( HasType )
 
@@ -60,7 +56,7 @@ import qualified GI.Cairo.Render as Cairo
 
 -- lens
 import Control.Lens
-  ( view, over )
+  ( view )
 
 -- MetaBrush
 import qualified Math.Bezier.Cubic     as Cubic
@@ -71,15 +67,13 @@ import Math.Bezier.Stroke
   ( StrokePoint(..), stroke )
 import Math.Vector2D
   ( Point2D(..), Vector2D(..) )
-import MetaBrush.Action
-  ( ActionOrigin(..) )
 import MetaBrush.Asset.Colours
   ( Colours, ColourRecord(..) )
 import MetaBrush.Context
-  ( HoldAction(..), GuideAction(..), PartialPath(..) )
+  ( HoldAction(..), PartialPath(..) )
 import MetaBrush.Document
   ( Document(..)
-  , Stroke(..), Guide(..), FocusState(..)
+  , Stroke(..), FocusState(..)
   , PointData(..), BrushPointData(..)
   , _selection
   )
@@ -87,8 +81,6 @@ import MetaBrush.Document.Selection
   ( translateSelection )
 import MetaBrush.UI.ToolBar
   ( Mode(..) )
-import MetaBrush.UI.Viewport
-  ( Ruler(..) )
 import MetaBrush.Util
   ( withRGBA )
 
@@ -129,7 +121,7 @@ renderDocument
   = do
 
     Cairo.save
-    Cairo.translate ( 0.5 * fromIntegral viewportWidth ) ( 0.5 * fromIntegral viewportHeight )
+    Cairo.translate ( 0.5 + 0.5 * fromIntegral viewportWidth ) ( 0.5 + 0.5 * fromIntegral viewportHeight )
     Cairo.scale zoomFactor zoomFactor
     Cairo.translate ( -cx ) ( -cy )
   
@@ -186,73 +178,6 @@ renderDocument
   
     pure ()
 
-renderGuides
-  :: Colours -> ( Int32, Int32 ) -> ActionOrigin -> ( Int32, Int32 )
-  -> Maybe ( Point2D Double ) -> Maybe HoldAction
-  -> Document 
-  -> Cairo.Render ()
-renderGuides
-  cols ( viewportWidth, viewportHeight ) actionOrigin ( width, height )
-  mbMousePos mbHoldEvent
-  ( Document { viewportCenter = Point2D cx cy, zoomFactor, guides } ) = do
-
-    let
-      modifiedGuides :: [ Guide ]
-      modifiedGuides
-        | Just ( GuideAction { holdStartPos = mousePos0, guideAction = act } ) <- mbHoldEvent
-        , Just mousePos <- mbMousePos
-        = case act of
-            MoveGuide guideUnique
-              -> 
-                let
-                  translate :: Point2D Double -> Point2D Double
-                  translate = ( ( mousePos0 --> mousePos :: Vector2D Double ) • )
-                in toList ( Map.adjust ( over ( field' @"guidePoint" ) translate ) guideUnique guides )
-            CreateGuide ruler
-              -> let
-                  addNewGuides :: [ Guide ] -> [ Guide ]
-                  addNewGuides gs = case ruler of
-                    RulerCorner
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideUnique = undefined }
-                       : Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideUnique = undefined }
-                       : gs
-                    LeftRuler
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideUnique = undefined }
-                       : gs
-                    TopRuler
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideUnique = undefined }
-                       : gs
-                 in addNewGuides ( toList guides )
-        | otherwise
-        = toList guides
-
-    Cairo.save
-    Cairo.translate ( 0.5 * fromIntegral viewportWidth ) ( 0.5 * fromIntegral viewportHeight )
-    additionalAdjustment
-    Cairo.scale zoomFactor zoomFactor
-    Cairo.translate ( -cx ) ( -cy )
-
-    for_ modifiedGuides ( renderGuide cols zoomFactor )
-
-    Cairo.restore
-  
-    pure ()
-
-  where
-    dx, dy :: Double
-    dx = fromIntegral width
-    dy = fromIntegral height
-    additionalAdjustment :: Cairo.Render ()
-    additionalAdjustment = case actionOrigin of
-      ViewportOrigin -> pure ()
-      RulerOrigin ruler -> case ruler of
-        RulerCorner -> do
-          Cairo.translate dx dy
-        LeftRuler -> do
-          Cairo.translate dx 0
-        TopRuler -> do
-          Cairo.translate 0 dy
-
 renderStroke :: Colours -> Mode -> Double -> Stroke -> Compose Renders Cairo.Render ()
 renderStroke cols@( Colours { brush } ) mode zoom ( Stroke { strokePoints = pts, strokeVisible } )
   | strokeVisible
@@ -353,22 +278,6 @@ renderBrushShape cols zoom pt =
     *> Compose blank { renderPPts = drawCross cols zoom }
     *> toAll Cairo.restore
 
-renderGuide :: Colours -> Double -> Guide -> Cairo.Render ()
-renderGuide ( Colours {..} ) zoom ( Guide { guidePoint = Point2D x y , guideNormal = Vector2D nx ny } ) = do
-
-  Cairo.save
-  Cairo.translate x y
-  Cairo.scale ( 1 / zoom ) ( 1 / zoom )
-
-  Cairo.setLineWidth 1.5
-  withRGBA guide Cairo.setSourceRGBA
-
-  Cairo.moveTo (  1e5 * ny ) ( -1e5 * nx )
-  Cairo.lineTo ( -1e5 * ny ) (  1e5 * nx )
-  Cairo.stroke
-
-  Cairo.restore
-
 drawPoint :: HasType FocusState d => Colours -> Double -> StrokePoint d -> Cairo.Render ()
 drawPoint ( Colours {..} ) zoom pt@( PathPoint { coords = Point2D x y } )
   = do

src/app/MetaBrush/Render/Rulers.hs

@@ -0,0 +1,291 @@
+{-# LANGUAGE BlockArguments     #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NamedFieldPuns     #-}
+{-# LANGUAGE NegativeLiterals   #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE TypeApplications   #-}
+
+module MetaBrush.Render.Rulers
+  ( renderRuler )
+  where
+
+-- base
+import Control.Monad
+  ( when )
+import Data.Fixed
+  ( mod' )
+import Data.Foldable
+  ( for_, traverse_, toList )
+import Data.Int
+  ( Int32 )
+
+-- acts
+import Data.Act
+  ( Act
+    ( (•) )
+  , Torsor
+    ( (-->) )
+  )
+
+-- containers
+import qualified Data.Map as Map
+  ( adjust )
+
+-- generic-lens
+import Data.Generics.Product.Fields
+  ( field' )
+
+-- gi-cairo-render
+import qualified GI.Cairo.Render as Cairo
+
+-- lens
+import Control.Lens
+  ( over )
+
+-- MetaBrush
+import Math.Vector2D
+  ( Point2D(..), Vector2D(..) )
+import MetaBrush.Action
+  ( ActionOrigin(..) )
+import MetaBrush.Asset.Colours
+  ( Colours, ColourRecord(..) )
+import MetaBrush.Context
+  ( HoldAction(..), GuideAction(..) )
+import MetaBrush.Document
+  ( Document(..), Guide(..) )
+import MetaBrush.UI.Coordinates
+  ( toViewportCoordinates )
+import MetaBrush.UI.Viewport
+  ( Ruler(..) )
+import MetaBrush.Util
+  ( withRGBA )
+
+--------------------------------------------------------------------------------
+
+renderRuler
+  :: Colours -> ( Int32, Int32 ) -> ActionOrigin -> ( Int32, Int32 )
+  -> Maybe ( Point2D Double ) -> Maybe HoldAction -> Bool
+  -> Document
+  -> Cairo.Render ()
+renderRuler
+  cols@( Colours {..} ) ( viewportWidth, viewportHeight ) actionOrigin ( width, height )
+  mbMousePos mbHoldEvent showGuides
+  ( Document { viewportCenter = center@( Point2D cx cy ), zoomFactor, guides } ) = do
+
+    let
+      modifiedGuides :: [ Guide ]
+      modifiedGuides
+        | Just ( GuideAction { holdStartPos = mousePos0, guideAction = act } ) <- mbHoldEvent
+        , Just mousePos <- mbMousePos
+        = case act of
+            MoveGuide guideUnique
+              -> 
+                let
+                  translate :: Point2D Double -> Point2D Double
+                  translate = ( ( mousePos0 --> mousePos :: Vector2D Double ) • )
+                in toList ( Map.adjust ( over ( field' @"guidePoint" ) translate ) guideUnique guides )
+            CreateGuide ruler
+              -> let
+                  addNewGuides :: [ Guide ] -> [ Guide ]
+                  addNewGuides gs = case ruler of
+                    RulerCorner
+                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideUnique = undefined }
+                       : Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideUnique = undefined }
+                       : gs
+                    LeftRuler
+                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideUnique = undefined }
+                       : gs
+                    TopRuler
+                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideUnique = undefined }
+                       : gs
+                 in addNewGuides ( toList guides )
+        | otherwise
+        = toList guides
+
+    Cairo.save
+    Cairo.translate ( 0.5 + 0.5 * fromIntegral viewportWidth ) ( 0.5 + 0.5 * fromIntegral viewportHeight )
+    additionalAdjustment
+    Cairo.scale zoomFactor zoomFactor
+    Cairo.translate ( -cx ) ( -cy )
+
+    -- Render tick marks.
+    renderTicks
+    -- Render guides.
+    when showGuides ( for_ modifiedGuides ( renderGuide cols zoomFactor ) )
+    -- Render mouse cursor indicator.
+    for_ mbMousePos \ ( Point2D mx my ) ->
+      case actionOrigin of
+        RulerOrigin TopRuler  -> do
+          Cairo.save
+          Cairo.translate mx top
+          Cairo.scale ( 1 / zoomFactor ) ( 1 / zoomFactor )
+          Cairo.moveTo 0 0
+          Cairo.lineTo -3 -6
+          Cairo.lineTo  3 -6
+          Cairo.closePath
+          withRGBA cursorIndicator Cairo.setSourceRGBA
+          Cairo.fill
+          Cairo.restore
+        RulerOrigin LeftRuler -> do
+          Cairo.save
+          Cairo.translate left my
+          Cairo.moveTo 0 0
+          Cairo.scale ( 1 / zoomFactor ) ( 1 / zoomFactor )
+          Cairo.lineTo -6 -3 
+          Cairo.lineTo -6  3
+          Cairo.closePath
+          withRGBA cursorIndicator Cairo.setSourceRGBA
+          Cairo.fill
+          Cairo.restore
+
+        _ -> pure ()
+
+    Cairo.restore
+    pure ()
+
+  where
+    dx, dy :: Double
+    dx = fromIntegral width
+    dy = fromIntegral height
+    left, right, top, bottom :: Double
+    Point2D left  top    = toViewport ( Point2D 0 0 )
+    Point2D right bottom = toViewport ( Point2D ( fromIntegral viewportWidth ) ( fromIntegral viewportHeight ) )
+    additionalAdjustment :: Cairo.Render ()
+    additionalAdjustment = case actionOrigin of
+      ViewportOrigin -> pure ()
+      RulerOrigin ruler -> case ruler of
+        RulerCorner -> do
+          Cairo.translate dx dy
+        LeftRuler -> do
+          Cairo.translate dx 0
+        TopRuler -> do
+          Cairo.translate 0 dy
+    toViewport :: Point2D Double -> Point2D Double
+    toViewport = toViewportCoordinates zoomFactor ( fromIntegral viewportWidth, fromIntegral viewportHeight ) center
+
+    setTickRenderContext :: Cairo.Render ()
+    setTickRenderContext = do
+      Cairo.setLineWidth 1
+      Cairo.setLineCap Cairo.LineCapButt
+      withRGBA rulerTick Cairo.setSourceRGBA
+      Cairo.selectFontFace "Fira Code" Cairo.FontSlantNormal Cairo.FontWeightNormal
+      Cairo.setFontSize 8
+
+    renderTicks :: Cairo.Render ()
+    renderTicks = case actionOrigin of
+      ViewportOrigin -> pure ()
+      RulerOrigin ruler -> case ruler of
+        RulerCorner -> pure ()
+        TopRuler  -> do
+          let
+            spacing, subdivs, subsubdivs, start :: Double
+            ( spacing, subdivs, subsubdivs ) = tickSpacing ( 60 / zoomFactor )
+            start = truncateWith spacing left
+          setTickRenderContext
+          traverse_ renderTickV
+            [ Tick { .. }
+            | i <- [ 0, 1 .. 1 + ( right - left ) / spacing ]
+            , j <- [ 0, 1 .. subdivs - 1 ]
+            , k <- if   spacing / ( subdivs * subsubdivs ) < 4 / zoomFactor
+                   then [ 0 ]
+                   else [ 0, 1 .. subsubdivs - 1 ]
+            , let
+                tickPosition = start + spacing * ( i + ( j + k / subsubdivs ) / subdivs )
+            , let tickSize
+                    | j == 0 && k == 0 = 12
+                    | k == 0           = 6
+                    | otherwise        = 3
+            , let tickHasLabel
+                    | j == 0 && k == 0 = True
+                    | otherwise        = False
+            ]
+        LeftRuler -> do
+          let
+            spacing, subdivs, subsubdivs, start :: Double
+            ( spacing, subdivs, subsubdivs ) = tickSpacing ( 60 / zoomFactor )
+            start = truncateWith spacing top
+          setTickRenderContext
+          traverse_ renderTickH
+            [ Tick { .. }
+            | i <- [ 0, 1 .. 1 + ( bottom - top ) / spacing ]
+            , j <- [ 0, 1 .. subdivs - 1 ]
+            , k <- if   spacing / ( subdivs * subsubdivs ) < 4 / zoomFactor
+                   then [ 0 ]
+                   else [ 0, 1 .. subsubdivs - 1 ]
+            , let
+                tickPosition = start + spacing * ( i + ( j + k / subsubdivs ) / subdivs )
+            , let tickSize
+                    | j == 0 && k == 0 = 12
+                    | k == 0           = 6
+                    | otherwise        = 3
+            , let tickHasLabel
+                    | j == 0 && k == 0 = True
+                    | otherwise        = False
+            ]
+
+    renderTickV, renderTickH :: Tick -> Cairo.Render ()
+    renderTickV ( Tick { .. } ) = do
+      Cairo.save
+      Cairo.translate tickPosition top
+      Cairo.scale ( 1 / zoomFactor ) ( 1 / zoomFactor )
+      Cairo.moveTo 0 0
+      Cairo.lineTo 0 (-tickSize)
+      Cairo.stroke
+      when tickHasLabel do
+        Cairo.translate 2 -8.5
+        Cairo.moveTo 0 0
+        Cairo.showText ( show $ round @_ @Int tickPosition )
+      Cairo.restore
+    renderTickH ( Tick { .. } ) = do
+      Cairo.save
+      Cairo.translate left tickPosition
+      Cairo.scale ( 1 / zoomFactor ) ( 1 / zoomFactor )
+      Cairo.moveTo 0           0
+      Cairo.lineTo (-tickSize) 0
+      Cairo.stroke
+      when tickHasLabel do
+        if tickPosition < 0
+        then Cairo.translate -14 8
+        else Cairo.translate -14 12
+        for_ ( show $ round @_ @Int tickPosition ) \ char -> do
+          Cairo.moveTo 0 0
+          Cairo.showText [char]
+          Cairo.translate 0 8
+      Cairo.restore
+
+data Tick
+  = Tick
+  { tickPosition :: Double
+  , tickSize     :: Double
+  , tickHasLabel :: Bool
+  }
+  deriving stock Show
+
+renderGuide :: Colours -> Double -> Guide -> Cairo.Render ()
+renderGuide ( Colours {..} ) zoom ( Guide { guidePoint = Point2D x y, guideNormal = Vector2D nx ny } ) = do
+
+  Cairo.save
+  Cairo.translate x y
+  Cairo.scale ( 1 / zoom ) ( 1 / zoom )
+
+  Cairo.setLineWidth 1
+  withRGBA guide Cairo.setSourceRGBA
+
+  Cairo.moveTo (  1e5 * ny ) ( -1e5 * nx )
+  Cairo.lineTo ( -1e5 * ny ) (  1e5 * nx )
+  Cairo.stroke
+
+  Cairo.restore
+
+tickSpacing :: Double -> ( Double, Double, Double )
+tickSpacing d
+  | d <= 1 = ( 1, 4, 5  )
+  | d <= 2 = ( 2, 2, 10 )
+  | d <= 5 = ( 5, 5, 4  )
+  | otherwise
+  = case tickSpacing ( 0.1 * d ) of
+     ( sp, sub, subsub ) -> ( 10 * sp, sub, subsub )
+
+truncateWith :: Double -> Double -> Double
+truncateWith m x = x - ( x `mod'` m )

src/app/MetaBrush/UI/InfoBar.hs

@@ -119,7 +119,7 @@ createInfoBar colours = do
   void $ GTK.onWidgetDraw cursorPosArea \ ctx ->
     ( `Cairo.renderWithContext` ctx ) $ do
       Cairo.scale 0.75 0.75
-      Cairo.translate 10 7
+      Cairo.translate 9.5 7
       drawCursorIcon colours
 
   ---------------------

src/app/MetaBrush/UI/Viewport.hs

@@ -21,7 +21,7 @@ import qualified GI.Gtk as GTK
 
 -- MetaBrush
 import MetaBrush.Util
-  ( widgetAddClass )
+  ( widgetAddClass, widgetAddClasses )
 
 --------------------------------------------------------------------------------
 
@@ -60,9 +60,9 @@ createViewport viewportGrid = do
   GTK.containerAdd rvLeftRuler   leftRuler
   GTK.containerAdd rvTopRuler    topRuler
 
-  widgetAddClass rulerCorner "ruler"
+  widgetAddClasses rulerCorner [ "ruler", "rulerCorner" ]
-  widgetAddClass leftRuler   "ruler"
+  widgetAddClasses leftRuler   [ "ruler", "leftRuler" ]
-  widgetAddClass topRuler    "ruler"
+  widgetAddClasses topRuler    [ "ruler",  "topRuler" ]
 
   GTK.revealerSetRevealChild rvRulerCorner True
   GTK.revealerSetRevealChild rvLeftRuler   True