mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
update list model upon undo/redo
This commit is contained in:
parent
1ca6d9ccf5
commit
23cc439ff2
|
@ -115,8 +115,8 @@ import MetaBrush.Asset.WindowIcons
|
|||
( drawClose )
|
||||
import MetaBrush.Document.Diff
|
||||
import MetaBrush.Document.History
|
||||
( DocumentHistory(..), newHistory
|
||||
, back, fwd
|
||||
( DocumentHistory(..), Do(..)
|
||||
, newHistory, back, fwd
|
||||
)
|
||||
import MetaBrush.Document.Serialise
|
||||
( saveDocument, loadDocument )
|
||||
|
@ -134,6 +134,8 @@ import MetaBrush.UI.InfoBar
|
|||
( updateInfoBar )
|
||||
import MetaBrush.UI.FileBar
|
||||
( newFileTab, removeFileTab )
|
||||
import MetaBrush.UI.StrokeTreeView
|
||||
( applyDiffToListModel )
|
||||
import MetaBrush.UI.Viewport
|
||||
( Viewport(..) )
|
||||
import MetaBrush.Unique
|
||||
|
@ -557,25 +559,31 @@ data Redo = Redo
|
|||
instance HandleAction Redo where
|
||||
handleAction uiElts vars _ = updateHistory fwd uiElts vars
|
||||
|
||||
updateHistory :: ( DocumentHistory -> DocumentHistory ) -> UIElements -> Variables -> IO ()
|
||||
updateHistory :: ( DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) ) ) -> UIElements -> Variables -> IO ()
|
||||
updateHistory f uiElts vars@( Variables {..} ) = do
|
||||
uiUpdateAction <- STM.atomically do
|
||||
mbUnique <- STM.readTVar activeDocumentTVar
|
||||
case mbUnique of
|
||||
Nothing -> pure ( pure () )
|
||||
Just unique -> do
|
||||
mbDocHistory <- Map.lookup unique <$> STM.readTVar openDocumentsTVar
|
||||
Just docUnique -> do
|
||||
mbDocHistory <- Map.lookup docUnique <$> STM.readTVar openDocumentsTVar
|
||||
case mbDocHistory of
|
||||
Nothing -> pure ( pure () )
|
||||
Just docHistory -> do
|
||||
let
|
||||
newDocHistory :: DocumentHistory
|
||||
newDocHistory = f docHistory
|
||||
STM.modifyTVar' openDocumentsTVar ( Map.insert unique newDocHistory )
|
||||
uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
|
||||
pure do
|
||||
updateHistoryState uiElts ( Just newDocHistory )
|
||||
uiUpdateAction
|
||||
let mbNewHist = f docHistory
|
||||
case mbNewHist of
|
||||
Nothing -> pure ( pure () )
|
||||
Just ( newDocHistory, ( doOrUndo, diff ) ) -> do
|
||||
STM.modifyTVar' openDocumentsTVar ( Map.insert docUnique newDocHistory )
|
||||
uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
|
||||
pure do
|
||||
case diff of
|
||||
DocumentDiff {} -> return ()
|
||||
HierarchyDiff hDiff ->
|
||||
applyDiffToListModel parStoresTVar docUnique ( doOrUndo, hDiff )
|
||||
ContentDiff {} -> return ()
|
||||
updateHistoryState uiElts ( Just newDocHistory )
|
||||
uiUpdateAction
|
||||
uiUpdateAction
|
||||
|
||||
---------
|
||||
|
|
|
@ -863,10 +863,6 @@ getSelectedItem layersView = do
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Do or undo?
|
||||
data Do = Do | Undo
|
||||
deriving stock ( Eq, Show )
|
||||
|
||||
-- | Do, undo or redo?
|
||||
data DoLayerChange = DoLayerChange !LayerChange | RedoChange | UndoChange
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
module MetaBrush.Document.History
|
||||
( DocumentHistory(..)
|
||||
, Do(..)
|
||||
, back, fwd, newHistory, newFutureStep
|
||||
, atStart, atEnd
|
||||
, affirmPresentSaved
|
||||
|
@ -49,23 +50,33 @@ instance NFData DocumentHistory where
|
|||
rnf ( History { past = ps, present, future } ) =
|
||||
ps `deepseq` present `deepseq` future `deepseq` ()
|
||||
|
||||
back :: DocumentHistory -> DocumentHistory
|
||||
back hist@( History { past = ps, present = c, future = fs } ) = case ps of
|
||||
Empty
|
||||
-> hist
|
||||
qs :|> ( q, diff )
|
||||
-> History { past = qs
|
||||
, present = c { documentContent = q }
|
||||
, future = ( diff, documentContent c ) : fs }
|
||||
-- | Do or undo?
|
||||
data Do = Do | Undo
|
||||
deriving stock ( Eq, Show )
|
||||
|
||||
fwd :: DocumentHistory -> DocumentHistory
|
||||
fwd hist@( History { past = ps, present = c, future = fs } ) = case fs of
|
||||
back :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
|
||||
back ( History { past = ps, present = c, future = fs } ) = case ps of
|
||||
Empty
|
||||
-> Nothing
|
||||
qs :|> ( q, diff )
|
||||
-> Just
|
||||
( History { past = qs
|
||||
, present = c { documentContent = q }
|
||||
, future = ( diff, documentContent c ) : fs }
|
||||
, ( Undo, diff )
|
||||
)
|
||||
|
||||
fwd :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
|
||||
fwd ( History { past = ps, present = c, future = fs } ) = case fs of
|
||||
[]
|
||||
-> hist
|
||||
-> Nothing
|
||||
( diff, g ) : gs
|
||||
-> History { past = ps :|> ( documentContent c, diff )
|
||||
, present = c { documentContent = g }
|
||||
, future = gs }
|
||||
-> Just
|
||||
( History { past = ps :|> ( documentContent c, diff )
|
||||
, present = c { documentContent = g }
|
||||
, future = gs }
|
||||
, ( Do, diff )
|
||||
)
|
||||
|
||||
newHistory :: Document -> DocumentHistory
|
||||
newHistory a = History { past = Empty, present = a, future = [] }
|
||||
|
|
Loading…
Reference in a new issue