{-# 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.Util ( widgetAddClass ) -------------------------------------------------------------------------------- data Tool = Selection | Pen deriving stock ( Show, Eq ) data Mode = Path | Brush | Meta deriving stock ( Show, Eq ) data ToolBar = ToolBar { selectionTool, penTool, pathTool, brushTool, 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 { .. } )