always use current viewport sizes

This commit is contained in:
sheaf 2021-02-23 21:52:03 +01:00
parent c1cae2b69f
commit 6dbade1fae
4 changed files with 23 additions and 21 deletions

View file

@ -218,7 +218,7 @@ main = do
mkPoint pt r = PointData pt Normal ( #r SuperRecord.:= r SuperRecord.& SuperRecord.rnil ) mkPoint pt r = PointData pt Normal ( #r SuperRecord.:= r SuperRecord.& SuperRecord.rnil )
recomputeStrokesTVar <- STM.newTVarIO @Bool False recomputeStrokesTVar <- STM.newTVarIO @Bool False
documentRenderTVar <- STM.newTVarIO @( Cairo.Render () ) ( pure () ) documentRenderTVar <- STM.newTVarIO @( ( Int32, Int32 ) -> Cairo.Render () ) ( const $ pure () )
activeDocumentTVar <- STM.newTVarIO @( Maybe Unique ) Nothing activeDocumentTVar <- STM.newTVarIO @( Maybe Unique ) Nothing
openDocumentsTVar <- STM.newTVarIO @( Map Unique DocumentHistory ) testDocuments openDocumentsTVar <- STM.newTVarIO @( Map Unique DocumentHistory ) testDocuments
brushesTVar <- STM.newTVarIO @( HashMap Brush Unique ) testBrushes brushesTVar <- STM.newTVarIO @( HashMap Brush Unique ) testBrushes
@ -350,8 +350,6 @@ main = do
-- Update the document render data in a separate thread. -- Update the document render data in a separate thread.
_ <- forkIO $ forever do _ <- forkIO $ forever do
viewportWidth <- GTK.widgetGetAllocatedWidth viewportDrawingArea
viewportHeight <- GTK.widgetGetAllocatedHeight viewportDrawingArea
( !mbUpdatedDoc, renderDoc ) <- STM.atomically do ( !mbUpdatedDoc, renderDoc ) <- STM.atomically do
needsRecomputation <- STM.readTVar recomputeStrokesTVar needsRecomputation <- STM.readTVar recomputeStrokesTVar
case needsRecomputation of case needsRecomputation of
@ -359,7 +357,7 @@ main = do
True -> do True -> do
mbDocNow <- fmap present <$> activeDocument variables mbDocNow <- fmap present <$> activeDocument variables
case mbDocNow of case mbDocNow of
Nothing -> pure ( Nothing, blankRender colours ) Nothing -> pure ( Nothing, const $ blankRender colours )
Just doc -> do Just doc -> do
modifiers <- STM.readTVar modifiersTVar modifiers <- STM.readTVar modifiersTVar
mbMousePos <- STM.readTVar mousePosTVar mbMousePos <- STM.readTVar mousePosTVar
@ -371,17 +369,17 @@ main = do
fitParameters <- STM.readTVar fitParametersTVar fitParameters <- STM.readTVar fitParametersTVar
STM.writeTVar recomputeStrokesTVar False STM.writeTVar recomputeStrokesTVar False
let let
addRulers :: ( Maybe Document, Cairo.Render () ) -> Cairo.Render () addRulers :: ( Maybe Document, ( Int32, Int32 ) -> Cairo.Render () ) -> ( ( Int32, Int32 ) -> Cairo.Render () )
addRulers ( Nothing , newRender ) = newRender addRulers ( Nothing , newRender ) viewportSize = newRender viewportSize
addRulers ( Just newDoc, newRender ) = do addRulers ( Just newDoc, newRender ) viewportSize = do
newRender newRender viewportSize
renderRuler renderRuler
colours ( viewportWidth, viewportHeight ) ViewportOrigin ( viewportWidth, viewportHeight ) colours viewportSize ViewportOrigin viewportSize
mbMousePos mbHoldAction showGuides mbMousePos mbHoldAction showGuides
newDoc newDoc
pure $ pure $
( fst &&& addRulers ) $ getDocumentRender ( fst &&& addRulers ) $ getDocumentRender
colours fitParameters mode debug ( viewportWidth, viewportHeight ) colours fitParameters mode debug
modifiers mbMousePos mbHoldAction mbPartialPath modifiers mbMousePos mbHoldAction mbPartialPath
doc doc
STM.atomically do STM.atomically do
@ -394,12 +392,15 @@ main = do
-- Render the document using the latest available draw data. -- Render the document using the latest available draw data.
void $ GTK.onWidgetDraw viewportDrawingArea \ ctx -> do void $ GTK.onWidgetDraw viewportDrawingArea \ ctx -> do
viewportWidth <- GTK.widgetGetAllocatedWidth viewportDrawingArea
viewportHeight <- GTK.widgetGetAllocatedHeight viewportDrawingArea
-- Get the Cairo instructions for rendering the current document -- Get the Cairo instructions for rendering the current document
mbDoc <- fmap present <$> STM.atomically ( activeDocument variables ) mbDoc <- fmap present <$> STM.atomically ( activeDocument variables )
render <- case mbDoc of render <- case mbDoc of
Nothing -> pure ( blankRender colours ) Nothing -> pure ( blankRender colours )
Just _ -> STM.atomically do Just _ -> STM.atomically do
STM.readTVar documentRenderTVar render <- STM.readTVar documentRenderTVar
pure ( render ( viewportWidth, viewportHeight ) )
Cairo.renderWithContext render ctx Cairo.renderWithContext render ctx
pure True pure True

View file

@ -635,11 +635,11 @@ instance HandleAction MouseMove where
mbPartialPath <- STM.readTVar partialPathTVar mbPartialPath <- STM.readTVar partialPathTVar
case tool of case tool of
Pen Pen
| any ( \ case { Control _ -> True; _ -> False } ) modifiers | Just pp <- mbPartialPath
, Just pp <- mbPartialPath
-> do -> do
STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just pos } )
STM.writeTVar recomputeStrokesTVar True STM.writeTVar recomputeStrokesTVar True
when ( any ( \ case { Control _ -> True; _ -> False } ) modifiers ) do
STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just pos } )
_ | Just _ <- mbMouseHold _ | Just _ <- mbMouseHold
-> STM.writeTVar recomputeStrokesTVar True -> STM.writeTVar recomputeStrokesTVar True
| otherwise | otherwise
@ -901,7 +901,6 @@ instance HandleAction MouseRelease where
Just upd -> pure $ UpdateDoc ( UpdateDocumentTo upd ) Just upd -> pure $ UpdateDoc ( UpdateDocumentTo upd )
Nothing -> pure Don'tModifyDoc Nothing -> pure Don'tModifyDoc
| SelectionHold pos0 <- hold | SelectionHold pos0 <- hold
, pos0 /= pos
-> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectRectangle selMode pos0 pos doc ) -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectRectangle selMode pos0 pos doc )
_ -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectAt selMode pos doc ) _ -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectAt selMode pos doc )

View file

@ -9,6 +9,8 @@ module MetaBrush.Context
where where
-- base -- base
import Data.Int
( Int32 )
import Data.Word import Data.Word
( Word32 ) ( Word32 )
@ -82,7 +84,7 @@ data Variables
= Variables = Variables
{ uniqueSupply :: !UniqueSupply { uniqueSupply :: !UniqueSupply
, recomputeStrokesTVar :: !( STM.TVar Bool ) , recomputeStrokesTVar :: !( STM.TVar Bool )
, documentRenderTVar :: !( STM.TVar ( Cairo.Render () ) ) , documentRenderTVar :: !( STM.TVar ( ( Int32, Int32 ) -> Cairo.Render () ) )
, activeDocumentTVar :: !( STM.TVar ( Maybe Unique ) ) , activeDocumentTVar :: !( STM.TVar ( Maybe Unique ) )
, openDocumentsTVar :: !( STM.TVar ( Map Unique DocumentHistory ) ) , openDocumentsTVar :: !( STM.TVar ( Map Unique DocumentHistory ) )
, brushesTVar :: !( STM.TVar ( HashMap Brush Unique ) ) , brushesTVar :: !( STM.TVar ( HashMap Brush Unique ) )

View file

@ -170,20 +170,20 @@ blankRender :: Colours -> Cairo.Render ()
blankRender _ = pure () blankRender _ = pure ()
getDocumentRender getDocumentRender
:: Colours -> FitParameters -> Mode -> Bool -> ( Int32, Int32 ) :: Colours -> FitParameters -> Mode -> Bool
-> Set Modifier -> Maybe ( Point2D Double ) -> Maybe HoldAction -> Maybe PartialPath -> Set Modifier -> Maybe ( Point2D Double ) -> Maybe HoldAction -> Maybe PartialPath
-> Document -> Document
-> ( Maybe Document, Cairo.Render () ) -> ( Maybe Document, ( Int32, Int32 ) -> Cairo.Render () )
getDocumentRender getDocumentRender
cols fitParams mode debug ( viewportWidth, viewportHeight ) cols fitParams mode debug
modifiers mbMousePos mbHoldEvent mbPartialPath modifiers mbMousePos mbHoldEvent mbPartialPath
doc@( Document { viewportCenter = Point2D cx cy, zoomFactor, documentContent = content, documentBrushes } ) doc@( Document { viewportCenter = Point2D cx cy, zoomFactor, documentContent = content, documentBrushes } )
= strokesRenderData `deepseq` ( mbUpdatedDoc, drawingInstructions ) = strokesRenderData `deepseq` ( mbUpdatedDoc, drawingInstructions )
where where
drawingInstructions :: Cairo.Render () drawingInstructions :: ( Int32, Int32 ) -> Cairo.Render ()
drawingInstructions = do drawingInstructions ( viewportWidth, viewportHeight ) = do
Cairo.save Cairo.save
Cairo.translate ( 0.5 + 0.5 * fromIntegral viewportWidth ) ( 0.5 + 0.5 * fromIntegral viewportHeight ) Cairo.translate ( 0.5 + 0.5 * fromIntegral viewportWidth ) ( 0.5 + 0.5 * fromIntegral viewportHeight )
Cairo.scale zoomFactor zoomFactor Cairo.scale zoomFactor zoomFactor