metabrush/app/Main.hs

{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE NegativeLiterals  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeApplications  #-}

module Main
  ( main )
  where

-- base
import Control.Monad
  ( void, unless )
import Data.Foldable
  ( for_ )
import Data.Int
  ( Int32 )
import Data.Word
  ( Word32 )
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 )

-- directory
import qualified System.Directory as Directory
  ( canonicalizePath )

-- gi-cairo-connector
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

-- 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
  ( newTVarIO, writeTVar, readTVarIO )

-- text
import qualified Data.Text as Text
  ( pack )

-- MetaBrush
import Math.Module
  ( (*^) )
import Math.Vector2D
  ( Point2D(..), Vector2D(..) )
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
  , 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.Menu
  ( newMenuBar )
import qualified Paths_MetaBrush as Cabal
  ( getDataFileName )

--------------------------------------------------------------------------------

testDocuments :: IntMap Document
testDocuments = IntMap.fromList
  $ zip [0..]
    [ Document
      { displayName    = "Document 1"
      , filePath       = Nothing
      , unsavedChanges = False
      , strokes        = [ Stroke [ Point2D 10 10, Point2D 30 30, Point2D 40 70 ] ]
      , bounds         = AABB ( Point2D  0  0 ) ( Point2D 100 100 )
      , viewportCenter = Point2D 50 50
      , zoomFactor     = 1
      }
    , Document
      { displayName    = "Document 2"
      , filePath       = Nothing
      , unsavedChanges = True
      , strokes        = [ Stroke [ Point2D 0 0, Point2D 10 10, Point2D 20 20 ] ]
      , bounds         = AABB ( Point2D  0  0 ) ( Point2D 50 50 )
      , viewportCenter = Point2D 10 10
      , zoomFactor     = 0.25
      }
    ]

--------------------------------------------------------------------------------

main :: IO ()
main = do

  ---------------------------------------------------------
  -- Initialise state

  activeDocumentTVar <- STM.newTVarIO @( Maybe Int       ) Nothing
  openDocumentsTVar  <- STM.newTVarIO @( IntMap Document ) testDocuments
  pressedKeysTVar    <- STM.newTVarIO @[ Word32 ]          []

  ---------------------------------------------------------
  -- Initialise GTK

  void $ GTK.init Nothing
  Just screen <- GDK.screenGetDefault

  themePath <- Text.pack <$> ( Directory.canonicalizePath =<< Cabal.getDataFileName "theme.css" )
  cssProvider <- GTK.cssProviderNew
  GTK.cssProviderLoadFromPath cssProvider themePath
  GTK.styleContextAddProviderForScreen screen cssProvider 1000

  window <- GTK.windowNew GTK.WindowTypeToplevel
  windowWidgetPath <- GTK.widgetGetPath window
  widgetAddClass window "window"
  GTK.setWindowResizable window True
  GTK.setWindowDecorated window False
  GTK.setWindowTitle window "MetaBrush"
  GTK.windowSetDefaultSize window 800 600

  let
    baseMinWidth, baseMinHeight :: Int32
    baseMinWidth  = 480
    baseMinHeight = 240

  windowGeometry <- GDK.newZeroGeometry
  GDK.setGeometryMinWidth  windowGeometry baseMinWidth
  GDK.setGeometryMinHeight windowGeometry baseMinHeight
  GTK.windowSetGeometryHints window ( Nothing @GTK.Widget )
    ( Just windowGeometry )
    [ GDK.WindowHintsMinSize ]

  iconPath <- Directory.canonicalizePath =<< Cabal.getDataFileName "icon.png"
  GTK.windowSetIconFromFile window iconPath

  colours <- getColours windowWidgetPath

  ---------------------------------------------------------
  -- Create base UI elements

  baseOverlay <- GTK.overlayNew
  GTK.setContainerChild window baseOverlay

  uiGrid <- GTK.gridNew
  GTK.setContainerChild baseOverlay uiGrid

  logo     <- GTK.boxNew   GTK.OrientationVertical   0
  titleBar <- GTK.boxNew   GTK.OrientationHorizontal 0
  toolBar  <- GTK.boxNew   GTK.OrientationVertical   0
  mainPane <- GTK.panedNew GTK.OrientationHorizontal
  panelBox <- GTK.boxNew   GTK.OrientationVertical   0

  GTK.gridAttach uiGrid logo      0 0 1 2
  GTK.gridAttach uiGrid titleBar  1 0 2 1
  GTK.gridAttach uiGrid toolBar   0 2 2 1
  GTK.gridAttach uiGrid mainPane  2 2 1 1

  mainView     <- GTK.boxNew GTK.OrientationVertical   0

  GTK.panedPack1 mainPane mainView True  False
  GTK.panedPack2 mainPane panelBox False False

  fileBar      <- GTK.scrolledWindowNew ( Nothing @GTK.Adjustment ) ( Nothing @GTK.Adjustment )
  viewportGrid <- GTK.gridNew
  infoBar      <- GTK.boxNew GTK.OrientationHorizontal 0

  GTK.boxPackStart mainView fileBar      False False 0
  GTK.boxPackStart mainView viewportGrid True  True  0
  GTK.boxPackStart mainView infoBar      False False 0

  ---------------------------------------------------------
  -- Background

  widgetAddClass uiGrid "bg"

  ---------------------------------------------------------
  -- Title bar

  widgetAddClass titleBar "titleBar"

  --------
  -- Logo

  widgetAddClass logo "logo"

  logoArea <- GTK.drawingAreaNew
  GTK.boxPackStart logo logoArea True True 0

  void $ GTK.onWidgetDraw logoArea
    $ Cairo.renderWithContext ( drawLogo colours )

  ------------
  -- Menu bar

  ( 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

  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"

  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"
  
  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

  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" ]

  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 "300%" )

  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: 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 )
  _ <- GTK.onWidgetDestroy         window GTK.mainQuit

  ---------------------------------------------------------
  -- GTK main loop

  GTK.widgetShowAll window
  GTK.main

  exitSuccess

---------------------------------------------------------
-- Utils.

data Exists c where
  Exists :: c a => a -> Exists c