mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 23:03:38 +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 )
|
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
|
||||||
|
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
||||||
|
|
|
@ -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 ) )
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue