metabrush/src/app/MetaBrush/UI/ToolBar.hs

{-# LANGUAGE BlockArguments     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeApplications   #-}

module MetaBrush.UI.ToolBar
  ( Tool(..), Mode(..)
  , 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

-- stm
import qualified Control.Concurrent.STM      as STM
  ( atomically )
import qualified Control.Concurrent.STM.TVar as STM
  ( TVar, writeTVar )

-- 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 Tool
  = Selection
  | Pen
  deriving stock Show

data Mode
  = Path
  | Brush
  | Meta
  deriving stock Show

data ToolBar
  = ToolBar
  { selectionTool :: !GTK.RadioButton
  , penTool       :: !GTK.RadioButton
  , pathTool      :: !GTK.RadioButton
  , brushTool     :: !GTK.RadioButton
  , metaTool      :: !GTK.RadioButton
  }

createToolBar :: STM.TVar Tool -> STM.TVar Mode -> Colours -> GTK.DrawingArea -> GTK.Box -> IO ToolBar
createToolBar toolTVar modeTVar colours drawingArea toolBar = do
  
  widgetAddClass toolBar "toolBar"

  GTK.widgetSetValign  toolBar GTK.AlignStart
  GTK.widgetSetVexpand toolBar True

  selectionTool <- GTK.radioButtonNew ( [] @GTK.RadioButton )
  penTool       <- GTK.radioButtonNewFromWidget ( Just selectionTool )

  _ <- GTK.onButtonClicked selectionTool
    ( STM.atomically $ STM.writeTVar toolTVar Selection )
  _ <- GTK.onButtonClicked penTool
    ( STM.atomically $ STM.writeTVar toolTVar Pen )

  toolSep1 <- GTK.boxNew GTK.OrientationVertical 0

  pathTool  <- GTK.radioButtonNew ( [] @GTK.RadioButton )
  brushTool <- GTK.radioButtonNewFromWidget ( Just pathTool )
  metaTool  <- GTK.radioButtonNewFromWidget ( Just pathTool )

  _ <- GTK.onButtonClicked pathTool do
    STM.atomically $ STM.writeTVar modeTVar Path
    GTK.widgetQueueDraw drawingArea
  _ <- GTK.onButtonClicked brushTool do
    STM.atomically $ STM.writeTVar modeTVar Brush
    GTK.widgetQueueDraw drawingArea
  _ <- GTK.onButtonClicked metaTool do
    STM.atomically $ STM.writeTVar modeTVar Meta
    GTK.widgetQueueDraw drawingArea


  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 { .. } )