mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
always use current viewport sizes
This commit is contained in:
parent
c1cae2b69f
commit
6dbade1fae
23
app/Main.hs
23
app/Main.hs
|
@ -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
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
||||
|
|
|
@ -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 ) )
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue