add toggle for showing guides

This commit is contained in:
sheaf 2020-09-06 05:32:03 +02:00
parent 3660cb8dce
commit 091c1603bb
6 changed files with 47 additions and 21 deletions

View file

@ -12,7 +12,7 @@ module Main
-- base
import Control.Monad
( void )
( void, when )
import Data.Foldable
( for_ )
import Data.Int
@ -181,6 +181,7 @@ main = do
modeTVar <- STM.newTVarIO @Mode Path
partialPathTVar <- STM.newTVarIO @( Maybe PartialPath ) Nothing
fileBarTabsTVar <- STM.newTVarIO @( Map Unique GTK.Box ) Map.empty
showGuidesTVar <- STM.newTVarIO @Bool True
-- Put all these stateful variables in a record for conciseness.
let
@ -297,15 +298,17 @@ main = do
mbHoldAction <- STM.readTVar mouseHoldTVar
mbPartialPath <- STM.readTVar partialPathTVar
mode <- STM.readTVar modeTVar
showGuides <- STM.readTVar showGuidesTVar
pure do
renderDocument
colours mode ( viewportWidth, viewportHeight )
mbMousePos mbHoldAction mbPartialPath
doc
renderGuides
colours ( viewportWidth, viewportHeight ) ViewportOrigin ( viewportWidth, viewportHeight )
mbMousePos mbHoldAction
doc
when showGuides do
renderGuides
colours ( viewportWidth, viewportHeight ) ViewportOrigin ( viewportWidth, viewportHeight )
mbMousePos mbHoldAction
doc
case mbRender of
Just render -> Cairo.renderWithContext render ctx
Nothing -> Cairo.renderWithContext ( blankRender colours ) ctx
@ -324,11 +327,13 @@ main = do
mbRender <- STM.atomically $ withCurrentDocument variables \ doc@( Document {..} ) -> do
mbMousePos <- STM.readTVar mousePosTVar
mbHoldAction <- STM.readTVar mouseHoldTVar
showGuides <- STM.readTVar showGuidesTVar
pure do
renderGuides
colours ( viewportWidth, viewportHeight ) ( RulerOrigin ruler ) ( width, height )
mbMousePos mbHoldAction
doc
when showGuides do
renderGuides
colours ( viewportWidth, viewportHeight ) ( RulerOrigin ruler ) ( width, height )
mbMousePos mbHoldAction
doc
for_ mbRender \ render -> Cairo.renderWithContext render ctx
pure True

View file

@ -76,7 +76,7 @@
background-color: rgba(48, 45, 38, 0.66);
}
.guide {
color: rgba(28, 196, 79, 0.66)
color: rgba(28, 196, 79, 0.4)
}
.magnifier {
color: rgb(236, 223, 210);

View file

@ -482,6 +482,20 @@ instance HandleAction Delete where
pure ( UpdateDocTo $ Just ( deleteSelected mode doc ) )
_ -> pure ()
-------------------
-- Toggle guides --
-------------------
data ToggleGuides = ToggleGuides
deriving stock Show
instance HandleAction ToggleGuides where
handleAction ( UIElements { viewport = Viewport {..} } ) ( Variables { showGuidesTVar } ) _ = do
STM.atomically $ STM.modifyTVar' showGuidesTVar not
GTK.widgetQueueDraw viewportDrawingArea
for_ [ rulerCornerDrawingArea, topRulerDrawingArea, leftRulerDrawingArea ] \ drawingArea -> do
GTK.widgetQueueDraw drawingArea
------------
-- Confirm --
------------
@ -659,16 +673,18 @@ instance HandleAction MouseClick where
_ -> pure Don'tModifyDoc
RulerOrigin ruler -> do
let
mbGuide :: Maybe Guide
mbGuide = selectGuide pos doc
guideAction :: GuideAction
guideAction
| Just guide <- mbGuide
= MoveGuide ( guideUnique guide )
| otherwise
= CreateGuide ruler
STM.writeTVar mouseHoldTVar ( Just $ GuideAction { holdStartPos = pos, guideAction } )
showGuides <- STM.readTVar showGuidesTVar
when showGuides do
let
mbGuide :: Maybe Guide
mbGuide = selectGuide pos doc
guideAction :: GuideAction
guideAction
| Just guide <- mbGuide
= MoveGuide ( guideUnique guide )
| otherwise
= CreateGuide ruler
STM.writeTVar mouseHoldTVar ( Just $ GuideAction { holdStartPos = pos, guideAction } )
pure Don'tModifyDoc
-- Right mouse button: end partial path.

View file

@ -108,6 +108,7 @@ data Variables
, modeTVar :: !( STM.TVar Mode )
, partialPathTVar :: !( STM.TVar ( Maybe PartialPath ) )
, fileBarTabsTVar :: !( STM.TVar ( Map Unique GTK.Box ) )
, showGuidesTVar :: !( STM.TVar Bool )
}
--------------------------------------------------------------------------------

View file

@ -360,7 +360,7 @@ renderGuide ( Colours {..} ) zoom ( Guide { guidePoint = Point2D x y , guideNorm
Cairo.translate x y
Cairo.scale ( 1 / zoom ) ( 1 / zoom )
Cairo.setLineWidth 2.0
Cairo.setLineWidth 1.5
withRGBA guide Cairo.setSourceRGBA
Cairo.moveTo ( 1e5 * ny ) ( -1e5 * nx )

View file

@ -158,6 +158,8 @@ data ViewMenu ( rt :: ResourceType )
, metaparameters :: !( MenuItem () NoSubresource rt )
, viewSep2 :: !( Separator rt )
, transform :: !( MenuItem () NoSubresource rt )
, viewSep3 :: !( Separator rt )
, guides :: !( MenuItem ToggleGuides NoSubresource rt )
}
deriving stock Generic
@ -216,6 +218,8 @@ viewMenuDescription
, metaparameters = MenuItemDescription "Metaparameters" [ "submenuItem" ] () Nothing NoSubresource
, viewSep2 = SeparatorDescription [ "submenuSeparator" ]
, transform = MenuItemDescription "Transform" [ "submenuItem" ] () Nothing NoSubresource
, viewSep3 = SeparatorDescription [ "submenuSeparator" ]
, guides = MenuItemDescription "Guides" [ "submenuItem" ] ToggleGuides ( Just ( GDK.KEY_G, [] ) ) NoSubresource
}
helpMenuDescription :: HelpMenu Description