update infobar, mouse focus zoom, module refactor

MetaBrush.cabal

@@ -94,7 +94,13 @@ executable MetaBrush
       , MetaBrush.Event
       , MetaBrush.Render.Document
       , MetaBrush.Render.Util
+      , MetaBrush.UI.Coordinates
+      , MetaBrush.UI.FileBar
+      , MetaBrush.UI.InfoBar
       , MetaBrush.UI.Menu
+      , MetaBrush.UI.Panels
+      , MetaBrush.UI.ToolBar
+      , MetaBrush.UI.Viewport
       , Paths_MetaBrush
 
     autogen-modules:

app/Main.hs

@@ -1,9 +1,6 @@
 {-# LANGUAGE BlockArguments    #-}
-{-# LANGUAGE ConstraintKinds   #-}
-{-# LANGUAGE GADTs             #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
-{-# LANGUAGE NegativeLiterals  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms   #-}
 {-# LANGUAGE RecordWildCards   #-}
@@ -15,9 +12,7 @@ module Main
 
 -- base
 import Control.Monad
-  ( void, unless )
+  ( void )
-import Data.Foldable
-  ( for_ )
 import Data.Int
   ( Int32 )
 import Data.Word
@@ -25,17 +20,11 @@ import Data.Word
 import System.Exit
   ( exitSuccess )
 
--- acts
-import Data.Act
-  ( Act
-    ( (•) )
-  )
-
 -- containers
 import Data.IntMap.Strict
   ( IntMap )
 import qualified Data.IntMap.Strict as IntMap
-  ( fromList, lookup, insert, traverseWithKey )
+  ( fromList )
 
 -- directory
 import qualified System.Directory as Directory
@@ -45,9 +34,6 @@ import qualified System.Directory as Directory
 import qualified GI.Cairo.Render.Connector as Cairo
   ( renderWithContext )
 
--- gi-cairo-render
-import qualified GI.Cairo.Render as Cairo
-
 -- gi-gdk
 import qualified GI.Gdk as GDK
 
@@ -55,48 +41,43 @@ import qualified GI.Gdk as GDK
 import qualified GI.Gtk as GTK
 
 -- stm
-import qualified Control.Concurrent.STM      as STM
-  ( atomically )
 import qualified Control.Concurrent.STM.TVar as STM
-  ( newTVarIO, writeTVar, readTVarIO )
+  ( newTVarIO )
 
 -- text
 import qualified Data.Text as Text
   ( pack )
 
 -- MetaBrush
-import Math.Module
-  ( (*^) )
 import Math.Vector2D
-  ( Point2D(..), Vector2D(..) )
+  ( Point2D(..) )
 import MetaBrush.Asset.Colours
   ( getColours )
-import MetaBrush.Asset.Cursor
-  ( drawCursorIcon )
-import MetaBrush.Asset.InfoBar
-  ( drawMagnifier, drawTopLeftCornerRect )
 import MetaBrush.Asset.Logo
   ( drawLogo )
-import MetaBrush.Asset.Tools
-  ( drawBrush, drawMeta, drawPath, drawPen )
-import MetaBrush.Asset.WindowIcons
-  ( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
 import MetaBrush.Document
   ( Document(..)
   , AABB(..)
   , Stroke(..)
   )
 import MetaBrush.Event
-  ( handleKeyboardPressEvent, handleKeyboardReleaseEvent
+  ( handleKeyboardPressEvent, handleKeyboardReleaseEvent )
-  , pattern Control_L, pattern Control_R
-  , pattern Shift_L, pattern Shift_R
-  )
-import MetaBrush.Render.Document
-  ( renderDocument )
 import MetaBrush.Render.Util
   ( widgetAddClass, widgetAddClasses )
+import MetaBrush.UI.Coordinates
+  ( keepViewportCoordinatesUpdated )
+import MetaBrush.UI.FileBar
+  ( createFileBar )
+import MetaBrush.UI.InfoBar
+  ( createInfoBar )
 import MetaBrush.UI.Menu
-  ( newMenuBar )
+  ( createMenuBar )
+import MetaBrush.UI.Panels
+  ( createPanelBar )
+import MetaBrush.UI.ToolBar
+  ( createToolBar )
+import MetaBrush.UI.Viewport
+  ( Viewport(..), createViewport )
 import qualified Paths_MetaBrush as Cabal
   ( getDataFileName )
 
@@ -109,7 +90,11 @@ testDocuments = IntMap.fromList
       { displayName    = "Document 1"
       , filePath       = Nothing
       , unsavedChanges = False
-      , strokes        = [ Stroke [ Point2D 10 10, Point2D 30 30, Point2D 40 70 ] ]
+      , strokes        = [ Stroke [ Point2D 0 0 ]
+                         , Stroke [ Point2D 100 0, Point2D 105 0, Point2D 110 0 ]
+                         , Stroke [ Point2D 0 100 ]
+                         , Stroke [ Point2D 100 100, Point2D 105 105, Point2D 110 100 ]
+                         ]
       , bounds         = AABB ( Point2D  0  0 ) ( Point2D 100 100 )
       , viewportCenter = Point2D 50 50
       , zoomFactor     = 1
@@ -230,488 +215,64 @@ main = do
   ------------
   -- Menu bar
 
-  ( menuBar, _menu ) <- newMenuBar
+  _ <- createMenuBar colours window titleBar
-  widgetAddClasses menuBar [ "menuBar", "text", "plain" ]
-  GTK.boxPackStart titleBar menuBar False False 0
 
-  -- TODO: this is a bit of a workaround to add hover highlight to top-level menu items.
+  ------------
-  -- Activating a menu somehow sets the "hover" setting,
+  -- Title
-  -- so instead we use the "selected" setting for actual hover highlighting.
-  topLevelMenuItems <- GTK.containerGetChildren menuBar
-  for_ topLevelMenuItems \ topLevelMenuItem -> do
-    void $ GTK.onWidgetEnterNotifyEvent topLevelMenuItem \ _ -> do
-      flags <- GTK.widgetGetStateFlags topLevelMenuItem
-      GTK.widgetSetStateFlags topLevelMenuItem ( GTK.StateFlagsSelected : flags ) True
-      pure False
-    void $ GTK.onWidgetLeaveNotifyEvent topLevelMenuItem \ _ -> do
-      flags <- GTK.widgetGetStateFlags topLevelMenuItem
-      GTK.widgetSetStateFlags topLevelMenuItem ( filter ( /= GTK.StateFlagsSelected ) flags ) True
-      pure False
 
-  windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0
+  title <- GTK.labelNew ( Just "MetaBrush" )
-  widgetAddClasses windowIcons [ "windowIcon" ]
-  GTK.boxPackEnd titleBar windowIcons False False 0
-
-  title <- GTK.labelNew ( Just "● New Document (1) – MetaBrush" )
   widgetAddClasses title [ "text", "title", "plain" ]
   GTK.boxSetCenterWidget titleBar ( Just title )
 
-  minimiseButton   <- GTK.buttonNew
-  fullscreenButton <- GTK.buttonNew
-  closeButton      <- GTK.buttonNew
-
-  GTK.boxPackStart windowIcons   minimiseButton True True 0
-  GTK.boxPackStart windowIcons fullscreenButton True True 0
-  GTK.boxPackStart windowIcons      closeButton True True 0
-
-  minimiseArea   <- GTK.drawingAreaNew
-  fullscreenArea <- GTK.drawingAreaNew
-  closeArea      <- GTK.drawingAreaNew
-
-  GTK.containerAdd   minimiseButton   minimiseArea
-  GTK.containerAdd fullscreenButton fullscreenArea
-  GTK.containerAdd      closeButton      closeArea
-
-  void $ GTK.onWidgetDraw minimiseArea
-    $ Cairo.renderWithContext
-      ( drawMinimise colours )
-
-  void $ GTK.onWidgetDraw fullscreenArea \ cairoContext -> do
-    Just gdkWindow <- GTK.widgetGetWindow window
-    windowState <- GDK.windowGetState gdkWindow
-    if any ( \case { GDK.WindowStateFullscreen -> True; GDK.WindowStateMaximized -> True; _ -> False } ) windowState
-    then Cairo.renderWithContext ( drawRestoreDown colours ) cairoContext
-    else Cairo.renderWithContext ( drawMaximise    colours ) cairoContext
-
-  void $ GTK.onWidgetDraw closeArea
-    $ Cairo.renderWithContext
-      ( drawClose colours )
-
-  for_ [ minimiseButton, fullscreenButton, closeButton ] \ button -> do
-    widgetAddClass button "windowIcon"
-
-  widgetAddClass closeButton "closeWindowIcon"
-
   ---------------------------------------------------------
   -- Tool bar
 
-  widgetAddClass toolBar "toolBar"
+  _ <- createToolBar colours toolBar
-
-  GTK.widgetSetValign  toolBar GTK.AlignStart
-  GTK.widgetSetVexpand toolBar True
-
-  selectionTool <- GTK.radioButtonNew ( [] @GTK.RadioButton )
-  penTool       <- GTK.radioButtonNewFromWidget ( Just selectionTool )
-
-  pathTool  <- GTK.radioButtonNew ( [] @GTK.RadioButton )
-  brushTool <- GTK.radioButtonNewFromWidget ( Just pathTool )
-  metaTool  <- GTK.radioButtonNewFromWidget ( Just pathTool )
-
-  toolSep1 <- GTK.boxNew GTK.OrientationVertical 0
-
-  GTK.boxPackStart toolBar selectionTool True True 0
-  GTK.boxPackStart toolBar       penTool True True 0
-  GTK.boxPackStart toolBar      toolSep1 True True 0
-  GTK.boxPackStart toolBar      pathTool True True 0
-  GTK.boxPackStart toolBar     brushTool True True 0
-  GTK.boxPackStart toolBar      metaTool True True 0
-
-  for_ [ selectionTool, penTool, pathTool, brushTool, metaTool ] \ tool -> do
-    GTK.toggleButtonSetMode tool False -- don't display radio indicator
-    widgetAddClass tool "toolItem"
-
-  widgetAddClass toolSep1 "toolBarSeparator"
-
-  GTK.widgetSetTooltipText selectionTool ( Just "Select" )
-  GTK.widgetSetTooltipText       penTool ( Just "Draw" )
-  GTK.widgetSetTooltipText      pathTool ( Just "Brush path" )
-  GTK.widgetSetTooltipText     brushTool ( Just "Brushes" )
-  GTK.widgetSetTooltipText      metaTool ( Just "Meta-parameters" )
-
-  selectionToolArea <- GTK.drawingAreaNew
-  penToolArea       <- GTK.drawingAreaNew
-  pathToolArea      <- GTK.drawingAreaNew
-  brushToolArea     <- GTK.drawingAreaNew
-  metaToolArea      <- GTK.drawingAreaNew
-
-  GTK.containerAdd selectionTool selectionToolArea
-  GTK.containerAdd       penTool       penToolArea
-  GTK.containerAdd      pathTool      pathToolArea
-  GTK.containerAdd     brushTool     brushToolArea
-  GTK.containerAdd      metaTool      metaToolArea
-
-  void $ GTK.onWidgetDraw selectionToolArea
-    $ Cairo.renderWithContext
-      ( drawCursorIcon colours )
-
-  void $ GTK.onWidgetDraw penToolArea
-    $ Cairo.renderWithContext
-      ( drawPen colours )
-
-  void $ GTK.onWidgetDraw pathToolArea
-    $ Cairo.renderWithContext
-      ( drawPath colours )
-
-  void $ GTK.onWidgetDraw brushToolArea
-    $ Cairo.renderWithContext
-      ( drawBrush colours )
-
-  void $ GTK.onWidgetDraw metaToolArea
-    $ Cairo.renderWithContext
-      ( drawMeta colours )
 
   ---------------------------------------------------------
   -- Main viewport
 
-  widgetAddClass viewportGrid "viewport"
+  Viewport { viewportDrawingArea } <-
-  
+    createViewport
-  rvRulerCorner   <- GTK.revealerNew
+      colours
-  rvLeftRuler     <- GTK.revealerNew
+      activeDocumentTVar
-  rvTopRuler      <- GTK.revealerNew
+      openDocumentsTVar
-  viewportOverlay <- GTK.overlayNew
+      viewportGrid
-
-  GTK.gridAttach viewportGrid rvRulerCorner   0 0 1 1
-  GTK.gridAttach viewportGrid rvLeftRuler     0 1 1 1
-  GTK.gridAttach viewportGrid rvTopRuler      1 0 1 1
-  GTK.gridAttach viewportGrid viewportOverlay 1 1 1 1
-
-  ----------
-  -- Rulers
-
-  rulerCorner <- GTK.boxNew GTK.OrientationVertical   0
-  leftRuler   <- GTK.boxNew GTK.OrientationVertical   0
-  topRuler    <- GTK.boxNew GTK.OrientationHorizontal 0
-
-  GTK.containerAdd rvRulerCorner rulerCorner
-  GTK.containerAdd rvLeftRuler   leftRuler
-  GTK.containerAdd rvTopRuler    topRuler
-
-  widgetAddClass rulerCorner "ruler"
-  widgetAddClass leftRuler   "ruler"
-  widgetAddClass topRuler    "ruler"
-
-  GTK.revealerSetRevealChild rvRulerCorner True
-  GTK.revealerSetRevealChild rvLeftRuler   True
-  GTK.revealerSetRevealChild rvTopRuler    True
-
-  GTK.revealerSetTransitionType rvRulerCorner GTK.RevealerTransitionTypeSlideLeft
-  GTK.revealerSetTransitionType rvLeftRuler   GTK.RevealerTransitionTypeSlideLeft
-  GTK.revealerSetTransitionType rvTopRuler    GTK.RevealerTransitionTypeSlideUp
-
-  rulerCornerArea <- GTK.drawingAreaNew
-  GTK.boxPackStart rulerCorner rulerCornerArea True True 0
-
-  leftRulerArea   <- GTK.drawingAreaNew
-  GTK.boxPackStart leftRuler   leftRulerArea   True True 0
-  
-  topRulerArea    <- GTK.drawingAreaNew
-  GTK.boxPackStart topRuler    topRulerArea    True True 0
-
-  GTK.widgetSetHexpand rulerCorner     False
-  GTK.widgetSetVexpand rulerCorner     False
-  GTK.widgetSetHexpand leftRuler       False
-  GTK.widgetSetVexpand leftRuler       True
-  GTK.widgetSetHexpand topRuler        True
-  GTK.widgetSetVexpand topRuler        False
-  GTK.widgetSetHexpand viewportOverlay True
-  GTK.widgetSetVexpand viewportOverlay True
-
-  viewportArea <- GTK.drawingAreaNew
-  GTK.setContainerChild viewportOverlay viewportArea
-
-  -----------------
-  -- Viewport scrolling
-
-  viewportScrollbarGrid <- GTK.gridNew
-  GTK.overlayAddOverlay viewportOverlay viewportScrollbarGrid
-  GTK.overlaySetOverlayPassThrough viewportOverlay viewportScrollbarGrid True
-
-  viewportHScrollbar <- GTK.scrollbarNew GTK.OrientationHorizontal ( Nothing @GTK.Adjustment )
-  viewportVScrollbar <- GTK.scrollbarNew GTK.OrientationVertical   ( Nothing @GTK.Adjustment )
-  GTK.widgetSetValign  viewportHScrollbar GTK.AlignEnd
-  GTK.widgetSetHalign  viewportVScrollbar GTK.AlignEnd
-  GTK.widgetSetVexpand viewportVScrollbar True
-  GTK.widgetSetHexpand viewportHScrollbar True
-  GTK.gridAttach viewportScrollbarGrid viewportHScrollbar 0 1 1 1
-  GTK.gridAttach viewportScrollbarGrid viewportVScrollbar 1 0 1 1
-  widgetAddClass viewportHScrollbar "viewportScrollbar"
-  widgetAddClass viewportVScrollbar "viewportScrollbar"
-
-  void $ GTK.onWidgetScrollEvent viewportArea \ scrollEvent -> do
-
-    dx <- GDK.getEventScrollDeltaX scrollEvent
-    dy <- GDK.getEventScrollDeltaY scrollEvent
-    --GDK.getEventScrollDirection scrollEvent
-    --GDK.getEventScrollType scrollEvent
-    --GDK.getEventScrollX scrollEvent
-    --GDK.getEventScrollY scrollEvent
-
-    unless ( dx == 0 && dy == 0 ) do
-      mbActiveDoc <- STM.readTVarIO activeDocumentTVar
-      for_ mbActiveDoc \ i -> do
-        docs <- STM.readTVarIO openDocumentsTVar
-        for_ ( IntMap.lookup i docs ) \ ( doc@(Document { viewportCenter, zoomFactor } ) ) -> do
-          pressedKeys <- STM.readTVarIO pressedKeysTVar
-          let
-            newDoc :: Document
-            newDoc
-              -- Zooming using 'Control'.
-              | any ( \ key -> key == Control_L || key == Control_R ) pressedKeys
-              = let
-                  newZoomFactor :: Double
-                  newZoomFactor
-                    | dy > 0
-                    = max 0.0078125 ( zoomFactor / 2 )
-                    | otherwise
-                    = zoomFactor * 2
-                in doc { zoomFactor = newZoomFactor }
-              -- Vertical scrolling turned into horizontal scrolling using 'Shift'.
-              | dx == 0 && any ( \ key -> key == Shift_L || key == Shift_R ) pressedKeys
-              = let
-                  newCenter :: Point2D Double
-                  newCenter = ( ( 25 / zoomFactor ) *^ Vector2D ( Point2D dy 0 ) ) • viewportCenter
-                in doc { viewportCenter = newCenter }
-              -- Vertical scrolling.
-              | otherwise
-              = let
-                  newCenter :: Point2D Double
-                  newCenter = ( ( 25 / zoomFactor ) *^ Vector2D ( Point2D dx dy ) ) • viewportCenter
-                in doc { viewportCenter = newCenter }
-            docs' :: IntMap Document
-            docs' = IntMap.insert i newDoc docs
-          STM.atomically ( STM.writeTVar openDocumentsTVar docs' )
-          GTK.widgetQueueDraw viewportArea
-    pure True
-
-  -----------------
-  -- Rendering
-
-  void $ GTK.onWidgetDraw viewportArea \ctx -> do
-    -- Get the relevant document information
-    mbActiveDoc <- STM.readTVarIO activeDocumentTVar
-    for_ mbActiveDoc \ i -> do
-      docs <- STM.readTVarIO openDocumentsTVar
-      for_ ( IntMap.lookup i docs ) \ doc -> do
-        ( `Cairo.renderWithContext` ctx ) $ do
-          viewportWidth  <- GTK.widgetGetAllocatedWidth  viewportArea
-          viewportHeight <- GTK.widgetGetAllocatedHeight viewportArea
-          renderDocument colours ( viewportWidth, viewportHeight ) doc
-    pure True
-
-  ---------------------------------------------------------
-  -- File bar
-
-  widgetAddClass fileBar "fileBar"
-
-  fileTabs <- GTK.boxNew GTK.OrientationHorizontal 0
-  GTK.containerAdd fileBar fileTabs
-  widgetAddClasses fileTabs [ "fileBar", "plain", "text" ]
-
-  fileBarPhantomRadioButton <- GTK.radioButtonNew ( [] @GTK.RadioButton )
-
-  -- TODO: currently using static list of documents.
-  -- Need to dynamically update this widget as the user opens/closes documents.
-  fileButtons <- ( `IntMap.traverseWithKey` testDocuments ) \ i ( Document { displayName, unsavedChanges } ) -> do
-    -- File tab elements.
-    pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just fileBarPhantomRadioButton ) displayName
-    GTK.toggleButtonSetMode pgButton False -- don't display radio indicator
-    closeFileButton <- GTK.buttonNewWithLabel "x"
-
-    -- Create box for file tab elements.
-    tab <- GTK.boxNew GTK.OrientationHorizontal 0
-    widgetAddClasses tab [ "fileBarTab" ]
-    GTK.boxPackStart fileTabs tab               False False 0
-    GTK.boxPackStart tab      pgButton          True  True  0
-    GTK.boxPackStart tab      closeFileButton   False False 0
-
-    widgetAddClasses pgButton        [ "fileBarTabButton" ]
-    widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
-
-    -- Make both file tab elements activate styling on the whole tab
-    -- (e.g. hovering over the close file button should highlight the whole tab).
-    void $ GTK.onButtonClicked pgButton do
-      isActive <- GTK.toggleButtonGetActive pgButton
-      flags  <- GTK.widgetGetStateFlags tab
-      if isActive
-      then do
-        GTK.widgetSetStateFlags tab ( GTK.StateFlagsActive : flags ) True
-        STM.atomically ( STM.writeTVar activeDocumentTVar ( Just i ) )
-        GTK.widgetQueueDraw viewportArea
-      else 
-        GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsActive ) flags ) True
-
-{-
-    void $ GTK.onButtonClicked closeFileButton do
-      closeFileDialog ...
--}
-
-    for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do
-      void $ GTK.onWidgetEnterNotifyEvent button \ _ -> do
-        flags <- GTK.widgetGetStateFlags tab
-        GTK.widgetSetStateFlags tab ( GTK.StateFlagsPrelight : flags ) True
-        pure False
-      void $ GTK.onWidgetLeaveNotifyEvent button \ _ -> do
-        flags <- GTK.widgetGetStateFlags tab
-        GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsPrelight ) flags ) True
-        pure False
-
-    pure pgButton
-
-  GTK.scrolledWindowSetPolicy           fileBar GTK.PolicyTypeAutomatic GTK.PolicyTypeNever
-  GTK.scrolledWindowSetOverlayScrolling fileBar True
-
-  ---------------------------------------------------------
-  -- Panels
-
-  widgetAddClass panelBox "panels"
-
-  pane1 <- GTK.panedNew GTK.OrientationVertical
-  GTK.boxPackStart panelBox pane1 True True 0
-
-  panels1 <- GTK.notebookNew
-  panels2 <- GTK.notebookNew
-
-  GTK.notebookSetGroupName panels1 ( Just "Panel" )
-  GTK.notebookSetGroupName panels2 ( Just "Panel" )
-
-  GTK.panedPack1 pane1 panels1 True True
-  GTK.panedPack2 pane1 panels2 True True
-
-  strokesPanel   <- GTK.boxNew GTK.OrientationVertical 0
-  brushesPanel   <- GTK.boxNew GTK.OrientationVertical 0
-  transformPanel <- GTK.boxNew GTK.OrientationVertical 0
-
-  strokesTab   <- GTK.labelNew ( Just "Strokes" )
-  brushesTab   <- GTK.labelNew ( Just "Brushes" )
-  transformTab <- GTK.labelNew ( Just "Transform" )
-
-  for_ [ strokesTab, brushesTab, transformTab ] \ tab -> do
-    widgetAddClasses tab [ "plain", "text", "panelTab" ]
-
-  for_ [ strokesPanel, brushesPanel, transformPanel ] \ panel -> do
-    widgetAddClass panel "panel"
-
-  void $ GTK.notebookAppendPage panels1   strokesPanel ( Just   strokesTab )
-  void $ GTK.notebookAppendPage panels1   brushesPanel ( Just   brushesTab )
-
-  void $ GTK.notebookAppendPage panels2 transformPanel ( Just transformTab )
-
-  GTK.notebookSetTabReorderable panels1   strokesPanel True
-  GTK.notebookSetTabDetachable  panels1   strokesPanel True
-  GTK.notebookSetTabReorderable panels1   brushesPanel True
-  GTK.notebookSetTabDetachable  panels1   brushesPanel True
-
-  GTK.notebookSetTabReorderable panels2 transformPanel True
-  GTK.notebookSetTabDetachable  panels2 transformPanel True
-
-  strokesContent   <- GTK.labelNew ( Just "Strokes tab content..." )
-  brushesContent   <- GTK.labelNew ( Just "Brushes tab content..." )
-  transformContent <- GTK.labelNew ( Just "Transform tab content..." )
-
-  GTK.boxPackStart   strokesPanel   strokesContent True True 0
-  GTK.boxPackStart   brushesPanel   brushesContent True True 0
-  GTK.boxPackStart transformPanel transformContent True True 0
 
   ---------------------------------------------------------
   -- Info bar
 
-  widgetAddClasses infoBar [ "infoBar", "monospace", "contrast" ]
+  infoBarElements <- createInfoBar colours infoBar
 
-  zoomBox        <- GTK.boxNew GTK.OrientationHorizontal 0
+  keepViewportCoordinatesUpdated
-  cursorPosBox   <- GTK.boxNew GTK.OrientationHorizontal 0
+    activeDocumentTVar
-  topLeftPosBox  <- GTK.boxNew GTK.OrientationHorizontal 0
+    openDocumentsTVar
-  botRightPosBox <- GTK.boxNew GTK.OrientationHorizontal 0
+    pressedKeysTVar
+    infoBarElements
+    viewportDrawingArea
 
-  for_ [ botRightPosBox, topLeftPosBox, cursorPosBox, zoomBox ] \ box -> do
+  ---------------------------------------------------------
-    GTK.boxPackEnd infoBar box False False 0
+  -- File bar
-    widgetAddClass box "infoBarBox"
 
-  -------------
+  _ <-
-  -- Magnifier
+    createFileBar
+      activeDocumentTVar
+      openDocumentsTVar
+      window
+      title
+      viewportDrawingArea
+      fileBar
 
-  magnifierArea <- GTK.drawingAreaNew
+  ---------------------------------------------------------
-  zoomText <- GTK.labelNew ( Just "300%" )
+  -- Panels
 
-  GTK.boxPackStart zoomBox magnifierArea True True 0
+  createPanelBar panelBox
-  GTK.boxPackStart zoomBox zoomText      True True 0
-
-  void $ GTK.onWidgetDraw magnifierArea \ctx ->
-    ( `Cairo.renderWithContext` ctx ) $ do
-      Cairo.scale 0.9 0.9
-      Cairo.translate 14 10
-      drawMagnifier colours
-
-  -------------------
-  -- Cursor position
-
-  cursorPosArea <- GTK.drawingAreaNew
-  cursorPosText <- GTK.labelNew ( Just "x: 212.12 px\ny: 120.23 px" )
-
-  GTK.boxPackStart cursorPosBox cursorPosArea False False 0
-  GTK.boxPackStart cursorPosBox cursorPosText False False 0
-
-  void $ GTK.onWidgetDraw cursorPosArea \ctx ->
-    ( `Cairo.renderWithContext` ctx ) $ do
-      Cairo.scale 0.75 0.75
-      Cairo.translate 10 7
-      drawCursorIcon colours
-
-  ---------------------
-  -- Top left position
-
-  topLeftPosArea <- GTK.drawingAreaNew
-  topLeftPosText <- GTK.labelNew ( Just "x: 212.12 px\ny: 120.23 px" )
-
-  GTK.boxPackStart topLeftPosBox topLeftPosArea False False 0
-  GTK.boxPackStart topLeftPosBox topLeftPosText False False 0
-
-  void $ GTK.onWidgetDraw topLeftPosArea
-    $ Cairo.renderWithContext
-      ( drawTopLeftCornerRect colours )
-
-  -------------------------
-  -- Bottom right position
-
-  botRightPosArea <- GTK.drawingAreaNew
-  botRightPosText <- GTK.labelNew ( Just "x: 212.12 px\ny: 120.23 px" )
-
-  GTK.boxPackStart botRightPosBox botRightPosArea False False 0
-  GTK.boxPackStart botRightPosBox botRightPosText False False 0
-
-  void $ GTK.onWidgetDraw botRightPosArea \ctx ->
-    ( `Cairo.renderWithContext` ctx ) $ do
-      Cairo.scale -1 -1
-      Cairo.translate -40 -40
-      drawTopLeftCornerRect colours
-
-  -------------------------
-
-  for_ [ magnifierArea, cursorPosArea, topLeftPosArea, botRightPosArea ] \ area -> do
-    widgetAddClass area "infoBarIcon"
-    GTK.widgetSetSizeRequest area 40 40 -- not sure why this is needed...?
-
-  for_ [ zoomText, cursorPosText, topLeftPosText, botRightPosText ] \ info -> do
-    widgetAddClass info "infoBarInfo"
 
   ---------------------------------------------------------
   -- Actions
 
   GTK.widgetAddEvents window
     [ GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask ]
-  GTK.widgetAddEvents viewportArea
-    [ GDK.EventMaskScrollMask, GDK.EventMaskSmoothScrollMask ]
-
-  _ <- GTK.onButtonClicked         closeButton    GTK.mainQuit
-  _ <- GTK.onButtonClicked         minimiseButton ( GTK.windowIconify window )
-  _ <- GTK.onButtonClicked         fullscreenButton do
-    Just gdkWindow <- GTK.widgetGetWindow window
-    windowState <- GDK.windowGetState gdkWindow
-    if GDK.WindowStateFullscreen `elem` windowState
-    then   GTK.windowUnfullscreen window
-    else
-      if GDK.WindowStateMaximized `elem` windowState
-      then GTK.windowUnmaximize   window
-      else GTK.windowMaximize     window
 
   _ <- GTK.onWidgetKeyPressEvent   window ( handleKeyboardPressEvent   pressedKeysTVar )
   _ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent pressedKeysTVar )
@@ -724,9 +285,3 @@ main = do
   GTK.main
 
   exitSuccess
-
----------------------------------------------------------
--- Utils.
-
-data Exists c where
-  Exists :: c a => a -> Exists c

src/app/MetaBrush/Asset/Colours.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE BlockArguments     #-}
-{-# LANGUAGE DeriveFunctor      #-}
-{-# LANGUAGE DeriveFoldable     #-}
 {-# LANGUAGE DeriveTraversable  #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedStrings  #-}

src/app/MetaBrush/Document.hs

@@ -1,12 +1,25 @@
+{-# LANGUAGE BlockArguments        #-}
 {-# LANGUAGE DerivingStrategies    #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module MetaBrush.Document where
 
+-- containers
+import Data.IntMap.Strict
+  ( IntMap )
+import qualified Data.IntMap.Strict as IntMap
+  ( lookup )
+
 -- text
 import Data.Text
   ( Text )
 
+-- stm
+import qualified Control.Concurrent.STM      as STM
+  ( atomically )
+import qualified Control.Concurrent.STM.TVar as STM
+  ( TVar, readTVar )
+
 -- MetaBrush
 import Math.Vector2D
   ( Point2D )
@@ -36,3 +49,13 @@ data Stroke
   = Stroke
   { strokePoints :: ![ Point2D Double ] }
   deriving stock Show
+
+
+currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
+currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
+  mbActive <- STM.readTVar activeDocumentTVar
+  case mbActive of
+    Nothing -> pure Nothing
+    Just i  -> do
+      docs <- STM.readTVar openDocumentsTVar
+      pure ( IntMap.lookup i docs )

src/app/MetaBrush/UI/Coordinates.hs

@@ -0,0 +1,191 @@
+{-# LANGUAGE BlockArguments   #-}
+{-# LANGUAGE NamedFieldPuns   #-}
+{-# LANGUAGE PatternSynonyms  #-}
+{-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE TypeApplications #-}
+
+module MetaBrush.UI.Coordinates
+  ( keepViewportCoordinatesUpdated )
+  where
+
+-- base
+import Control.Monad
+  ( unless, void )
+import Data.Foldable
+  ( for_ )
+import Data.Word
+  ( Word32 )
+
+-- acts
+import Data.Act
+  ( Act
+    ( (•) )
+  , Torsor
+    ( (-->) )
+  )
+
+-- containers
+import Data.IntMap.Strict
+  ( IntMap )
+import qualified Data.IntMap.Strict as IntMap
+  ( insert, lookup )
+
+-- gi-gdk
+import qualified GI.Gdk as GDK
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- stm
+import qualified Control.Concurrent.STM      as STM
+  ( atomically )
+import qualified Control.Concurrent.STM.TVar as STM
+  ( TVar, readTVarIO, writeTVar )
+
+-- MetaBrush
+import Math.Module
+  ( (*^) )
+import Math.Vector2D
+  ( Point2D(..), Vector2D(..) )
+import MetaBrush.Document
+  ( Document(..), currentDocument )
+import MetaBrush.Event
+  ( pattern Control_L, pattern Control_R
+  , pattern Shift_L, pattern Shift_R
+  )
+import MetaBrush.UI.InfoBar
+  ( InfoBar, InfoData(..), updateInfoBar )
+
+--------------------------------------------------------------------------------
+
+-- | Updates viewport coordinates on mouse motion / mouse scroll.
+--
+--   * On a scroll event, modifies the viewport coordinates as required.
+--   * On a scroll event or a mouse motion event, updates the info bar coordinate display.
+keepViewportCoordinatesUpdated
+  :: STM.TVar ( Maybe Int )
+  -> STM.TVar ( IntMap Document )
+  -> STM.TVar [ Word32 ]
+  -> InfoBar
+  -> GTK.DrawingArea
+  -> IO ()
+keepViewportCoordinatesUpdated
+  activeDocumentTVar
+  openDocumentsTVar
+  pressedKeysTVar
+  infoBar
+  viewportDrawingArea = do
+
+    -----------------------------------------------------------------
+    -- Update mouse position on mouse move event.
+
+    void $ GTK.onWidgetMotionNotifyEvent viewportDrawingArea \ eventMotion -> do
+      mbDoc <- currentDocument activeDocumentTVar openDocumentsTVar
+      infoData <- case mbDoc of
+        Nothing ->
+          pure $ 
+            InfoData
+              { zoom        = 1
+              , mousePos    = Point2D 0 0
+              , topLeftPos  = Point2D 0 0
+              , botRightPos = Point2D 0 0
+              }
+        Just ( Document { .. } ) -> do
+          x <- GDK.getEventMotionX eventMotion
+          y <- GDK.getEventMotionY eventMotion
+          viewportWidth  <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth  viewportDrawingArea
+          viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
+          let
+            toViewport :: Point2D Double -> Point2D Double
+            toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
+          pure $ 
+            InfoData
+              { zoom        = zoomFactor
+              , mousePos    = toViewport ( Point2D x y )
+              , topLeftPos  = toViewport ( Point2D 0 0 )
+              , botRightPos = toViewport ( Point2D viewportWidth viewportHeight )
+              }
+
+      updateInfoBar infoBar infoData
+      pure False
+
+    -----------------------------------------------------------------
+    -- Update coordinates on scroll event.
+
+    void $ GTK.onWidgetScrollEvent viewportDrawingArea \ scrollEvent -> do
+
+      dx <- GDK.getEventScrollDeltaX scrollEvent
+      dy <- GDK.getEventScrollDeltaY scrollEvent
+      x <- GDK.getEventScrollX scrollEvent
+      y <- GDK.getEventScrollY scrollEvent
+      viewportWidth  <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth  viewportDrawingArea
+      viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
+
+      unless ( dx == 0 && dy == 0 ) do
+        mbActiveDoc <- STM.readTVarIO activeDocumentTVar
+        for_ mbActiveDoc \ i -> do
+          docs <- STM.readTVarIO openDocumentsTVar
+          for_ ( IntMap.lookup i docs ) \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do
+            pressedKeys <- STM.readTVarIO pressedKeysTVar
+            let
+              toViewport :: Point2D Double -> Point2D Double
+              toViewport = toViewportCoordinates oldZoomFactor ( viewportWidth, viewportHeight ) oldCenter
+              -- Mouse position in the coordinate system of the document (not the drawing area GTK coordinates)
+              mousePos :: Point2D Double
+              mousePos = toViewport ( Point2D x y )
+              newDoc :: Document
+              newDoc
+                -- Zooming using 'Control'.
+                | any ( \ key -> key == Control_L || key == Control_R ) pressedKeys
+                = let
+                    newZoomFactor :: Double
+                    newZoomFactor
+                      | dy > 0
+                      = max 0.0078125 ( oldZoomFactor / 2 )
+                      | otherwise
+                      = oldZoomFactor * 2
+                    newCenter :: Point2D Double
+                    newCenter
+                      = ( 1 - oldZoomFactor / newZoomFactor ) *^ ( oldCenter --> mousePos :: Vector2D Double )
+                      • oldCenter
+                  in doc { zoomFactor = newZoomFactor, viewportCenter = newCenter }
+                -- Vertical scrolling turned into horizontal scrolling using 'Shift'.
+                | dx == 0 && any ( \ key -> key == Shift_L || key == Shift_R ) pressedKeys
+                = let
+                    newCenter :: Point2D Double
+                    newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D ( Point2D dy 0 ) ) • oldCenter
+                  in doc { viewportCenter = newCenter }
+                -- Vertical scrolling.
+                | otherwise
+                = let
+                    newCenter :: Point2D Double
+                    newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D ( Point2D dx dy ) ) • oldCenter
+                  in doc { viewportCenter = newCenter }
+              docs' :: IntMap Document
+              docs' = IntMap.insert i newDoc docs
+            STM.atomically ( STM.writeTVar openDocumentsTVar docs' )
+            GTK.widgetQueueDraw viewportDrawingArea
+
+            let
+              newZoomFactor :: Double
+              newZoomFactor = zoomFactor     newDoc
+              newCenter :: Point2D Double
+              newCenter     = viewportCenter newDoc
+              toNewViewport :: Point2D Double -> Point2D Double
+              toNewViewport = toViewportCoordinates newZoomFactor ( viewportWidth, viewportHeight ) newCenter
+              infoData :: InfoData
+              infoData = InfoData
+                { zoom = zoomFactor newDoc
+                , mousePos
+                , topLeftPos  = toNewViewport ( Point2D 0 0 )
+                , botRightPos = toNewViewport ( Point2D viewportWidth viewportHeight )
+                }
+            updateInfoBar infoBar infoData
+
+      pure True
+
+
+toViewportCoordinates :: Double -> ( Double, Double ) -> Point2D Double -> Point2D Double -> Point2D Double
+toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter ( Point2D x y )
+  = ( recip zoomFactor *^ ( Point2D ( 0.5 * viewportWidth ) ( 0.5 * viewportHeight ) --> Point2D x y :: Vector2D Double ) )
+  • viewportCenter

src/app/MetaBrush/UI/FileBar.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE ConstraintKinds   #-}
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+
+module MetaBrush.UI.FileBar
+  ( createFileBar )
+  where
+
+-- base
+import Control.Monad
+  ( void )
+import Data.Foldable
+  ( for_ )
+
+-- containers
+import Data.IntMap.Strict
+  ( IntMap )
+import qualified Data.IntMap.Strict as IntMap
+  ( lookup, traverseWithKey )
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- stm
+import qualified Control.Concurrent.STM      as STM
+  ( atomically )
+import qualified Control.Concurrent.STM.TVar as STM
+  ( TVar, writeTVar, readTVarIO )
+
+-- text
+import Data.Text
+  ( Text )
+
+-- MetaBrush
+import MetaBrush.Document
+  ( Document(..) )
+import MetaBrush.Render.Util
+  ( widgetAddClass, widgetAddClasses )
+
+--------------------------------------------------------------------------------
+
+-- | Add the file bar: tabs allowing selection of the active document.
+createFileBar
+  :: STM.TVar ( Maybe Int )
+  -> STM.TVar ( IntMap Document )
+  -> GTK.Window
+  -> GTK.Label
+  -> GTK.DrawingArea
+  -> GTK.ScrolledWindow
+  -> IO ( IntMap GTK.RadioButton )
+createFileBar activeDocumentTVar openDocumentsTVar window title viewportArea fileBar = do
+  
+  widgetAddClass fileBar "fileBar"
+
+  fileTabs <- GTK.boxNew GTK.OrientationHorizontal 0
+  GTK.containerAdd fileBar fileTabs
+  widgetAddClasses fileTabs [ "fileBar", "plain", "text" ]
+
+  fileBarPhantomRadioButton <- GTK.radioButtonNew ( [] @GTK.RadioButton )
+
+  -- TODO: currently using static list of documents.
+  -- Need to dynamically update this widget as the user opens/closes documents.
+  documents <- STM.readTVarIO openDocumentsTVar
+  fileButtons <- ( `IntMap.traverseWithKey` documents ) \ i ( Document { displayName, unsavedChanges } ) -> do
+    -- File tab elements.
+    pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just fileBarPhantomRadioButton ) displayName
+    GTK.toggleButtonSetMode pgButton False -- don't display radio indicator
+    closeFileButton <- GTK.buttonNewWithLabel "x"
+
+    -- Create box for file tab elements.
+    tab <- GTK.boxNew GTK.OrientationHorizontal 0
+    widgetAddClasses tab [ "fileBarTab" ]
+    GTK.boxPackStart fileTabs tab               False False 0
+    GTK.boxPackStart tab      pgButton          True  True  0
+    GTK.boxPackStart tab      closeFileButton   False False 0
+
+    widgetAddClasses pgButton        [ "fileBarTabButton" ]
+    widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
+
+    -- Make both file tab elements activate styling on the whole tab
+    -- (e.g. hovering over the close file button should highlight the whole tab).
+    void $ GTK.onButtonClicked pgButton do
+      isActive <- GTK.toggleButtonGetActive pgButton
+      flags  <- GTK.widgetGetStateFlags tab
+      if isActive
+      then do
+        GTK.widgetSetStateFlags tab ( GTK.StateFlagsActive : flags ) True
+        STM.atomically ( STM.writeTVar activeDocumentTVar ( Just i ) )
+        GTK.widgetQueueDraw viewportArea
+        mbActiveDoc <- IntMap.lookup i <$> STM.readTVarIO openDocumentsTVar
+        case mbActiveDoc of
+          Nothing -> do
+            GTK.labelSetText   title  "MetaBrush"
+            GTK.setWindowTitle window "MetaBrush"
+          Just ( Document { displayName, unsavedChanges } ) -> do
+            let
+              titleText :: Text
+              titleText
+                | unsavedChanges
+                = "● " <> displayName <> " – MetaBrush"
+                | otherwise
+                = displayName <> " – MetaBrush"
+            GTK.labelSetText   title  titleText
+            GTK.setWindowTitle window titleText
+      else do
+        GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsActive ) flags ) True
+        GTK.labelSetText   title  "MetaBrush"
+        GTK.setWindowTitle window "MetaBrush"
+
+{-
+    void $ GTK.onButtonClicked closeFileButton do
+      closeFileDialog ...
+-}
+
+    for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do
+      void $ GTK.onWidgetEnterNotifyEvent button \ _ -> do
+        flags <- GTK.widgetGetStateFlags tab
+        GTK.widgetSetStateFlags tab ( GTK.StateFlagsPrelight : flags ) True
+        pure False
+      void $ GTK.onWidgetLeaveNotifyEvent button \ _ -> do
+        flags <- GTK.widgetGetStateFlags tab
+        GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsPrelight ) flags ) True
+        pure False
+
+    pure pgButton
+
+  GTK.scrolledWindowSetPolicy           fileBar GTK.PolicyTypeAutomatic GTK.PolicyTypeNever
+  GTK.scrolledWindowSetOverlayScrolling fileBar True
+
+  pure fileButtons
+
+---------------------------------------------------------
+-- Util.
+
+data Exists c where
+  Exists :: c a => a -> Exists c

src/app/MetaBrush/UI/InfoBar.hs

@@ -0,0 +1,169 @@
+{-# LANGUAGE BlockArguments     #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NamedFieldPuns     #-}
+{-# LANGUAGE NegativeLiterals   #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE TypeApplications   #-}
+
+module MetaBrush.UI.InfoBar
+  ( InfoBar(..), createInfoBar, updateInfoBar
+  , InfoData(..)
+  )
+  where
+
+-- base
+import Control.Monad
+  ( void )
+import Data.Foldable
+  ( for_ )
+
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
+-- gi-cairo-render
+import qualified GI.Cairo.Render as Cairo
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- text
+import qualified Data.Text as Text
+  ( pack )
+
+-- MetaBrush
+import Math.Vector2D
+  ( Point2D(..), Vector2D(..) )
+import MetaBrush.Asset.Colours
+  ( Colours )
+import MetaBrush.Asset.Cursor
+  ( drawCursorIcon )
+import MetaBrush.Asset.InfoBar
+  ( drawMagnifier, drawTopLeftCornerRect )
+import MetaBrush.Render.Util
+  ( widgetAddClass, widgetAddClasses )
+
+--------------------------------------------------------------------------------
+
+data InfoBar
+  = InfoBar
+  { zoomText        :: !GTK.Label -- make this editable
+  , cursorPosText   :: !GTK.Label
+  , topLeftPosText  :: !GTK.Label
+  , botRightPosText :: !GTK.Label
+  }
+
+data InfoData
+  = InfoData
+  { zoom        :: !Double
+  , mousePos    :: !( Point2D Double )
+  , topLeftPos  :: !( Point2D Double )
+  , botRightPos :: !( Point2D Double )
+  }
+  deriving stock Show
+
+-- | Add the UI elements for the info bar:
+--
+--   * current zoom level,
+--   * current cursor position,
+--   * current viewport extent (top left and bottom right corner coordinates).
+--
+-- Returns the GTK label widgets, so that the information can be updated.
+createInfoBar :: Colours -> GTK.Box -> IO InfoBar
+createInfoBar colours infoBar = do
+  widgetAddClasses infoBar [ "infoBar", "monospace", "contrast" ]
+
+  zoomBox        <- GTK.boxNew GTK.OrientationHorizontal 0
+  cursorPosBox   <- GTK.boxNew GTK.OrientationHorizontal 0
+  topLeftPosBox  <- GTK.boxNew GTK.OrientationHorizontal 0
+  botRightPosBox <- GTK.boxNew GTK.OrientationHorizontal 0
+
+  for_ [ botRightPosBox, topLeftPosBox, cursorPosBox, zoomBox ] \ box -> do
+    GTK.boxPackEnd infoBar box False False 0
+    widgetAddClass box "infoBarBox"
+
+  -------------
+  -- Magnifier
+
+  magnifierArea <- GTK.drawingAreaNew
+  zoomText <- GTK.labelNew ( Just "100%" )
+
+  GTK.boxPackStart zoomBox magnifierArea True True 0
+  GTK.boxPackStart zoomBox zoomText      True True 0
+
+  void $ GTK.onWidgetDraw magnifierArea \ ctx ->
+    ( `Cairo.renderWithContext` ctx ) $ do
+      Cairo.scale 0.9 0.9
+      Cairo.translate 14 10
+      drawMagnifier colours
+
+  -------------------
+  -- Cursor position
+
+  cursorPosArea <- GTK.drawingAreaNew
+  cursorPosText <- GTK.labelNew ( Just "x:  50.00 px\ny:  50.00 px" )
+
+  GTK.boxPackStart cursorPosBox cursorPosArea False False 0
+  GTK.boxPackStart cursorPosBox cursorPosText False False 0
+
+  void $ GTK.onWidgetDraw cursorPosArea \ ctx ->
+    ( `Cairo.renderWithContext` ctx ) $ do
+      Cairo.scale 0.75 0.75
+      Cairo.translate 10 7
+      drawCursorIcon colours
+
+  ---------------------
+  -- Top left position
+
+  topLeftPosArea <- GTK.drawingAreaNew
+  topLeftPosText <- GTK.labelNew ( Just "x:   0.00 px\ny:   0.00 px" )
+
+  GTK.boxPackStart topLeftPosBox topLeftPosArea False False 0
+  GTK.boxPackStart topLeftPosBox topLeftPosText False False 0
+
+  void $ GTK.onWidgetDraw topLeftPosArea
+    $ Cairo.renderWithContext
+      ( drawTopLeftCornerRect colours )
+
+  -------------------------
+  -- Bottom right position
+
+  botRightPosArea <- GTK.drawingAreaNew
+  botRightPosText <- GTK.labelNew ( Just "x: 100.00 px\ny: 100.00 px" )
+
+  GTK.boxPackStart botRightPosBox botRightPosArea False False 0
+  GTK.boxPackStart botRightPosBox botRightPosText False False 0
+
+  void $ GTK.onWidgetDraw botRightPosArea \ ctx ->
+    ( `Cairo.renderWithContext` ctx ) $ do
+      Cairo.scale -1 -1
+      Cairo.translate -40 -40
+      drawTopLeftCornerRect colours
+
+  -------------------------
+
+  for_ [ magnifierArea, cursorPosArea, topLeftPosArea, botRightPosArea ] \ area -> do
+    widgetAddClass area "infoBarIcon"
+    GTK.widgetSetSizeRequest area 40 40 -- not sure why this is needed...?
+
+  for_ [ zoomText, cursorPosText, topLeftPosText, botRightPosText ] \ info -> do
+    widgetAddClass info "infoBarInfo"
+
+  pure ( InfoBar { .. } )
+
+updateInfoBar :: InfoBar -> InfoData -> IO ()
+updateInfoBar
+  ( InfoBar { .. } )
+  ( InfoData
+    { zoom
+    , mousePos    = Point2D mx my
+    , topLeftPos  = Point2D  l  t
+    , botRightPos = Point2D  r  b
+    }
+  ) = do
+    GTK.labelSetText        zoomText $ Text.pack ( show ( 100 * zoom ) <> "%" )
+    GTK.labelSetText   cursorPosText $ Text.pack ( "x: " <> show mx <> "\ny: " <> show my )
+    GTK.labelSetText  topLeftPosText $ Text.pack ( "x: " <> show  l <> "\ny: " <> show  t )
+    GTK.labelSetText botRightPosText $ Text.pack ( "x: " <> show  r <> "\ny: " <> show  b )
+

src/app/MetaBrush/UI/Menu.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase             #-}
 {-# LANGUAGE NamedFieldPuns         #-}
 {-# LANGUAGE OverloadedStrings      #-}
 {-# LANGUAGE PolyKinds              #-}
@@ -18,12 +19,13 @@ module MetaBrush.UI.Menu
   , FileMenu(..), EditMenu(..), ViewMenu(..), HelpMenu(..)
   , ResourceType(..)
   , MenuItem(..)
+  , createMenuBar
   )
   where
 
 -- base
 import Control.Monad
-  ( unless )
+  ( void, unless )
 import Data.Foldable
   ( for_ )
 import Data.Kind
@@ -35,6 +37,13 @@ import GHC.Generics
 import Data.Generics.Product.Constraints
   ( HasConstraints(constraints) )
 
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
+-- gi-gdk
+import qualified GI.Gdk as GDK
+
 -- gi-gtk
 import qualified GI.Gtk as GTK
 
@@ -47,8 +56,12 @@ import Control.Monad.IO.Class
   ( MonadIO(liftIO) )
 
 -- MetaBrush
+import MetaBrush.Asset.Colours
+  ( Colours )
+import MetaBrush.Asset.WindowIcons
+  ( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
 import MetaBrush.Render.Util
-  ( widgetAddClasses )
+  ( widgetAddClass, widgetAddClasses )
 
 --------------------------------------------------------------------------------
 -- Types for describing menu items.
@@ -252,3 +265,86 @@ newMenuBar = do
       ( createMenuItem ( GTK.menuShellAppend menuBar ) )
       menuDescription
   pure ( menuBar, menu )
+
+--------------------------------------------------------------------------------
+-- Creating the menu bar from its declarative specification.
+
+-- | Add the menu bar to the given box (title bar box).
+createMenuBar :: Colours -> GTK.Window -> GTK.Box -> IO ( Menu Object )
+createMenuBar colours window titleBar = do
+  ( menuBar, menu ) <- newMenuBar
+  widgetAddClasses menuBar [ "menuBar", "text", "plain" ]
+  GTK.boxPackStart titleBar menuBar False False 0
+
+  -- TODO: this is a bit of a workaround to add hover highlight to top-level menu items.
+  -- Activating a menu somehow sets the "hover" setting,
+  -- so instead we use the "selected" setting for actual hover highlighting.
+  topLevelMenuItems <- GTK.containerGetChildren menuBar
+  for_ topLevelMenuItems \ topLevelMenuItem -> do
+    void $ GTK.onWidgetEnterNotifyEvent topLevelMenuItem \ _ -> do
+      flags <- GTK.widgetGetStateFlags topLevelMenuItem
+      GTK.widgetSetStateFlags topLevelMenuItem ( GTK.StateFlagsSelected : flags ) True
+      pure False
+    void $ GTK.onWidgetLeaveNotifyEvent topLevelMenuItem \ _ -> do
+      flags <- GTK.widgetGetStateFlags topLevelMenuItem
+      GTK.widgetSetStateFlags topLevelMenuItem ( filter ( /= GTK.StateFlagsSelected ) flags ) True
+      pure False
+
+  windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0
+  widgetAddClasses windowIcons [ "windowIcon" ]
+  GTK.boxPackEnd titleBar windowIcons False False 0
+
+  minimiseButton   <- GTK.buttonNew
+  fullscreenButton <- GTK.buttonNew
+  closeButton      <- GTK.buttonNew
+
+  GTK.boxPackStart windowIcons   minimiseButton True True 0
+  GTK.boxPackStart windowIcons fullscreenButton True True 0
+  GTK.boxPackStart windowIcons      closeButton True True 0
+
+  minimiseArea   <- GTK.drawingAreaNew
+  fullscreenArea <- GTK.drawingAreaNew
+  closeArea      <- GTK.drawingAreaNew
+
+  GTK.containerAdd   minimiseButton   minimiseArea
+  GTK.containerAdd fullscreenButton fullscreenArea
+  GTK.containerAdd      closeButton      closeArea
+
+  void $ GTK.onWidgetDraw minimiseArea
+    $ Cairo.renderWithContext
+      ( drawMinimise colours )
+
+  void $ GTK.onWidgetDraw fullscreenArea \ cairoContext -> do
+    Just gdkWindow <- GTK.widgetGetWindow window
+    windowState <- GDK.windowGetState gdkWindow
+    if any ( \case { GDK.WindowStateFullscreen -> True; GDK.WindowStateMaximized -> True; _ -> False } ) windowState
+    then Cairo.renderWithContext ( drawRestoreDown colours ) cairoContext
+    else Cairo.renderWithContext ( drawMaximise    colours ) cairoContext
+
+  void $ GTK.onWidgetDraw closeArea
+    $ Cairo.renderWithContext
+      ( drawClose colours )
+
+  for_ [ minimiseButton, fullscreenButton, closeButton ] \ button -> do
+    widgetAddClass button "windowIcon"
+
+  widgetAddClass closeButton "closeWindowIcon"
+
+  ---------------------------------------------------------
+  -- Actions
+
+  _ <- GTK.onButtonClicked         closeButton    GTK.mainQuit
+  _ <- GTK.onButtonClicked         minimiseButton ( GTK.windowIconify window )
+  _ <- GTK.onButtonClicked         fullscreenButton do
+    Just gdkWindow <- GTK.widgetGetWindow window
+    windowState <- GDK.windowGetState gdkWindow
+    if GDK.WindowStateFullscreen `elem` windowState
+    then   GTK.windowUnfullscreen window
+    else
+      if GDK.WindowStateMaximized `elem` windowState
+      then GTK.windowUnmaximize   window
+      else GTK.windowMaximize     window
+
+  ---------------------------------------------------------
+
+  pure menu

src/app/MetaBrush/UI/Panels.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module MetaBrush.UI.Panels
+  ( createPanelBar )
+  where
+
+-- base
+import Control.Monad
+  ( void )
+import Data.Foldable
+  ( for_ )
+
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
+-- gi-cairo-render
+import qualified GI.Cairo.Render as Cairo
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- MetaBrush
+import MetaBrush.Asset.Colours
+  ( Colours )
+import MetaBrush.Render.Util
+  ( widgetAddClass, widgetAddClasses )
+
+--------------------------------------------------------------------------------
+
+-- | Creates the right hand side panel UI.
+createPanelBar :: GTK.Box -> IO ()
+createPanelBar panelBox = do 
+  
+  widgetAddClass panelBox "panels"
+
+  pane1 <- GTK.panedNew GTK.OrientationVertical
+  GTK.boxPackStart panelBox pane1 True True 0
+
+  panels1 <- GTK.notebookNew
+  panels2 <- GTK.notebookNew
+
+  GTK.notebookSetGroupName panels1 ( Just "Panel" )
+  GTK.notebookSetGroupName panels2 ( Just "Panel" )
+
+  GTK.panedPack1 pane1 panels1 True True
+  GTK.panedPack2 pane1 panels2 True True
+
+  strokesPanel   <- GTK.boxNew GTK.OrientationVertical 0
+  brushesPanel   <- GTK.boxNew GTK.OrientationVertical 0
+  transformPanel <- GTK.boxNew GTK.OrientationVertical 0
+
+  strokesTab   <- GTK.labelNew ( Just "Strokes" )
+  brushesTab   <- GTK.labelNew ( Just "Brushes" )
+  transformTab <- GTK.labelNew ( Just "Transform" )
+
+  for_ [ strokesTab, brushesTab, transformTab ] \ tab -> do
+    widgetAddClasses tab [ "plain", "text", "panelTab" ]
+
+  for_ [ strokesPanel, brushesPanel, transformPanel ] \ panel -> do
+    widgetAddClass panel "panel"
+
+  void $ GTK.notebookAppendPage panels1   strokesPanel ( Just   strokesTab )
+  void $ GTK.notebookAppendPage panels1   brushesPanel ( Just   brushesTab )
+
+  void $ GTK.notebookAppendPage panels2 transformPanel ( Just transformTab )
+
+  GTK.notebookSetTabReorderable panels1   strokesPanel True
+  GTK.notebookSetTabDetachable  panels1   strokesPanel True
+  GTK.notebookSetTabReorderable panels1   brushesPanel True
+  GTK.notebookSetTabDetachable  panels1   brushesPanel True
+
+  GTK.notebookSetTabReorderable panels2 transformPanel True
+  GTK.notebookSetTabDetachable  panels2 transformPanel True
+
+  strokesContent   <- GTK.labelNew ( Just "Strokes tab content..." )
+  brushesContent   <- GTK.labelNew ( Just "Brushes tab content..." )
+  transformContent <- GTK.labelNew ( Just "Transform tab content..." )
+
+  GTK.boxPackStart   strokesPanel   strokesContent True True 0
+  GTK.boxPackStart   brushesPanel   brushesContent True True 0
+  GTK.boxPackStart transformPanel transformContent True True 0
+
+  pure ()

src/app/MetaBrush/UI/ToolBar.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TypeApplications  #-}
+
+module MetaBrush.UI.ToolBar
+  ( ToolBar(..), createToolBar )
+  where
+
+-- base
+import Control.Monad
+  ( void )
+import Data.Foldable
+  ( for_ )
+
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- MetaBrush
+import MetaBrush.Asset.Colours
+  ( Colours )
+import MetaBrush.Asset.Cursor
+  ( drawCursorIcon )
+import MetaBrush.Asset.Tools
+  ( drawBrush, drawMeta, drawPath, drawPen )
+import MetaBrush.Render.Util
+  ( widgetAddClass )
+
+--------------------------------------------------------------------------------
+
+data ToolBar
+  = ToolBar
+  { selectionTool :: !GTK.RadioButton
+  , penTool       :: !GTK.RadioButton
+  , pathTool      :: !GTK.RadioButton
+  , brushTool     :: !GTK.RadioButton
+  , metaTool      :: !GTK.RadioButton
+  }
+
+createToolBar :: Colours -> GTK.Box -> IO ToolBar
+createToolBar colours toolBar = do
+  
+  widgetAddClass toolBar "toolBar"
+
+  GTK.widgetSetValign  toolBar GTK.AlignStart
+  GTK.widgetSetVexpand toolBar True
+
+  selectionTool <- GTK.radioButtonNew ( [] @GTK.RadioButton )
+  penTool       <- GTK.radioButtonNewFromWidget ( Just selectionTool )
+
+  pathTool  <- GTK.radioButtonNew ( [] @GTK.RadioButton )
+  brushTool <- GTK.radioButtonNewFromWidget ( Just pathTool )
+  metaTool  <- GTK.radioButtonNewFromWidget ( Just pathTool )
+
+  toolSep1 <- GTK.boxNew GTK.OrientationVertical 0
+
+  GTK.boxPackStart toolBar selectionTool True True 0
+  GTK.boxPackStart toolBar       penTool True True 0
+  GTK.boxPackStart toolBar      toolSep1 True True 0
+  GTK.boxPackStart toolBar      pathTool True True 0
+  GTK.boxPackStart toolBar     brushTool True True 0
+  GTK.boxPackStart toolBar      metaTool True True 0
+
+  for_ [ selectionTool, penTool, pathTool, brushTool, metaTool ] \ tool -> do
+    GTK.toggleButtonSetMode tool False -- don't display radio indicator
+    widgetAddClass tool "toolItem"
+
+  widgetAddClass toolSep1 "toolBarSeparator"
+
+  GTK.widgetSetTooltipText selectionTool ( Just "Select" )
+  GTK.widgetSetTooltipText       penTool ( Just "Draw" )
+  GTK.widgetSetTooltipText      pathTool ( Just "Brush path" )
+  GTK.widgetSetTooltipText     brushTool ( Just "Brushes" )
+  GTK.widgetSetTooltipText      metaTool ( Just "Meta-parameters" )
+
+  selectionToolArea <- GTK.drawingAreaNew
+  penToolArea       <- GTK.drawingAreaNew
+  pathToolArea      <- GTK.drawingAreaNew
+  brushToolArea     <- GTK.drawingAreaNew
+  metaToolArea      <- GTK.drawingAreaNew
+
+  GTK.containerAdd selectionTool selectionToolArea
+  GTK.containerAdd       penTool       penToolArea
+  GTK.containerAdd      pathTool      pathToolArea
+  GTK.containerAdd     brushTool     brushToolArea
+  GTK.containerAdd      metaTool      metaToolArea
+
+  void $ GTK.onWidgetDraw selectionToolArea
+    $ Cairo.renderWithContext
+      ( drawCursorIcon colours )
+
+  void $ GTK.onWidgetDraw penToolArea
+    $ Cairo.renderWithContext
+      ( drawPen colours )
+
+  void $ GTK.onWidgetDraw pathToolArea
+    $ Cairo.renderWithContext
+      ( drawPath colours )
+
+  void $ GTK.onWidgetDraw brushToolArea
+    $ Cairo.renderWithContext
+      ( drawBrush colours )
+
+  void $ GTK.onWidgetDraw metaToolArea
+    $ Cairo.renderWithContext
+      ( drawMeta colours )
+
+  pure ( ToolBar { .. } )

src/app/MetaBrush/UI/Viewport.hs

@@ -0,0 +1,151 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TypeApplications  #-}
+
+module MetaBrush.UI.Viewport
+  ( Viewport(..), createViewport )
+  where
+
+-- base
+import Control.Monad
+  ( void )
+import Data.Foldable
+  ( for_ )
+
+-- containers
+import Data.IntMap.Strict
+  ( IntMap )
+
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
+-- gi-gdk
+import qualified GI.Gdk as GDK
+
+-- gi-gtk
+import qualified GI.Gtk as GTK
+
+-- stm
+import qualified Control.Concurrent.STM.TVar as STM
+  ( TVar )
+
+-- MetaBrush
+import MetaBrush.Asset.Colours
+  ( Colours )
+import MetaBrush.Document
+  ( Document(..), currentDocument )
+import MetaBrush.Render.Document
+  ( renderDocument )
+import MetaBrush.Render.Util
+  ( widgetAddClass )
+
+--------------------------------------------------------------------------------
+
+data Viewport
+  = Viewport
+  { viewportDrawingArea :: !GTK.DrawingArea
+  }
+
+createViewport
+  :: Colours
+  -> STM.TVar ( Maybe Int )
+  -> STM.TVar ( IntMap Document )
+  -> GTK.Grid
+  -> IO Viewport
+createViewport colours activeDocumentTVar openDocumentsTVar viewportGrid = do
+  
+  widgetAddClass viewportGrid "viewport"
+  
+  rvRulerCorner   <- GTK.revealerNew
+  rvLeftRuler     <- GTK.revealerNew
+  rvTopRuler      <- GTK.revealerNew
+  viewportOverlay <- GTK.overlayNew
+
+  GTK.gridAttach viewportGrid rvRulerCorner   0 0 1 1
+  GTK.gridAttach viewportGrid rvLeftRuler     0 1 1 1
+  GTK.gridAttach viewportGrid rvTopRuler      1 0 1 1
+  GTK.gridAttach viewportGrid viewportOverlay 1 1 1 1
+
+  ----------
+  -- Rulers
+
+  rulerCorner <- GTK.boxNew GTK.OrientationVertical   0
+  leftRuler   <- GTK.boxNew GTK.OrientationVertical   0
+  topRuler    <- GTK.boxNew GTK.OrientationHorizontal 0
+
+  GTK.containerAdd rvRulerCorner rulerCorner
+  GTK.containerAdd rvLeftRuler   leftRuler
+  GTK.containerAdd rvTopRuler    topRuler
+
+  widgetAddClass rulerCorner "ruler"
+  widgetAddClass leftRuler   "ruler"
+  widgetAddClass topRuler    "ruler"
+
+  GTK.revealerSetRevealChild rvRulerCorner True
+  GTK.revealerSetRevealChild rvLeftRuler   True
+  GTK.revealerSetRevealChild rvTopRuler    True
+
+  GTK.revealerSetTransitionType rvRulerCorner GTK.RevealerTransitionTypeSlideLeft
+  GTK.revealerSetTransitionType rvLeftRuler   GTK.RevealerTransitionTypeSlideLeft
+  GTK.revealerSetTransitionType rvTopRuler    GTK.RevealerTransitionTypeSlideUp
+
+  rulerCornerArea <- GTK.drawingAreaNew
+  GTK.boxPackStart rulerCorner rulerCornerArea True True 0
+
+  leftRulerArea   <- GTK.drawingAreaNew
+  GTK.boxPackStart leftRuler   leftRulerArea   True True 0
+  
+  topRulerArea    <- GTK.drawingAreaNew
+  GTK.boxPackStart topRuler    topRulerArea    True True 0
+
+  GTK.widgetSetHexpand rulerCorner     False
+  GTK.widgetSetVexpand rulerCorner     False
+  GTK.widgetSetHexpand leftRuler       False
+  GTK.widgetSetVexpand leftRuler       True
+  GTK.widgetSetHexpand topRuler        True
+  GTK.widgetSetVexpand topRuler        False
+  GTK.widgetSetHexpand viewportOverlay True
+  GTK.widgetSetVexpand viewportOverlay True
+
+  viewportDrawingArea <- GTK.drawingAreaNew
+  GTK.setContainerChild viewportOverlay viewportDrawingArea
+  GTK.widgetAddEvents viewportDrawingArea
+    [ GDK.EventMaskPointerMotionMask
+    , GDK.EventMaskScrollMask, GDK.EventMaskSmoothScrollMask
+    ]
+
+  -----------------
+  -- Viewport scrolling
+
+  viewportScrollbarGrid <- GTK.gridNew
+  GTK.overlayAddOverlay viewportOverlay viewportScrollbarGrid
+  GTK.overlaySetOverlayPassThrough viewportOverlay viewportScrollbarGrid True
+
+  viewportHScrollbar <- GTK.scrollbarNew GTK.OrientationHorizontal ( Nothing @GTK.Adjustment )
+  viewportVScrollbar <- GTK.scrollbarNew GTK.OrientationVertical   ( Nothing @GTK.Adjustment )
+  GTK.widgetSetValign  viewportHScrollbar GTK.AlignEnd
+  GTK.widgetSetHalign  viewportVScrollbar GTK.AlignEnd
+  GTK.widgetSetVexpand viewportVScrollbar True
+  GTK.widgetSetHexpand viewportHScrollbar True
+  GTK.gridAttach viewportScrollbarGrid viewportHScrollbar 0 1 1 1
+  GTK.gridAttach viewportScrollbarGrid viewportVScrollbar 1 0 1 1
+  widgetAddClass viewportHScrollbar "viewportScrollbar"
+  widgetAddClass viewportVScrollbar "viewportScrollbar"
+
+  -----------------
+  -- Rendering
+
+  void $ GTK.onWidgetDraw viewportDrawingArea \ctx -> do
+    -- Get the relevant document information
+    mbDoc <- currentDocument activeDocumentTVar openDocumentsTVar
+    for_ mbDoc \ doc -> do
+      ( `Cairo.renderWithContext` ctx ) $ do
+        viewportWidth  <- GTK.widgetGetAllocatedWidth  viewportDrawingArea
+        viewportHeight <- GTK.widgetGetAllocatedHeight viewportDrawingArea
+        renderDocument colours ( viewportWidth, viewportHeight ) doc
+    pure True
+
+  pure ( Viewport { .. } )

src/lib/Math/Bezier/Cubic.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE DeriveFunctor         #-}
-{-# LANGUAGE DeriveFoldable        #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE DerivingStrategies    #-}

src/lib/Math/Bezier/Quadratic.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE DeriveFunctor         #-}
-{-# LANGUAGE DeriveFoldable        #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE DerivingStrategies    #-}

src/lib/Math/Vector2D.hs

@@ -1,10 +1,7 @@
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveFoldable             #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE DerivingVia           #-}
 {-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Math.Vector2D