hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-12-03 12:24:08 +00:00
Code Issues Actions Projects Releases Wiki Activity

always use current viewport sizes

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

23
app/Main.hs
View file

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

7
src/app/MetaBrush/Action.hs
View file

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

4
src/app/MetaBrush/Context.hs
View file

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

10
src/app/MetaBrush/Render/Document.hs
View file

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