update list model upon undo/redo

This commit is contained in:
sheaf 2024-09-27 23:53:33 +02:00
parent 1ca6d9ccf5
commit 23cc439ff2
3 changed files with 46 additions and 31 deletions

View file

@ -115,8 +115,8 @@ import MetaBrush.Asset.WindowIcons
( drawClose ) ( drawClose )
import MetaBrush.Document.Diff import MetaBrush.Document.Diff
import MetaBrush.Document.History import MetaBrush.Document.History
( DocumentHistory(..), newHistory ( DocumentHistory(..), Do(..)
, back, fwd , newHistory, back, fwd
) )
import MetaBrush.Document.Serialise import MetaBrush.Document.Serialise
( saveDocument, loadDocument ) ( saveDocument, loadDocument )
@ -134,6 +134,8 @@ import MetaBrush.UI.InfoBar
( updateInfoBar ) ( updateInfoBar )
import MetaBrush.UI.FileBar import MetaBrush.UI.FileBar
( newFileTab, removeFileTab ) ( newFileTab, removeFileTab )
import MetaBrush.UI.StrokeTreeView
( applyDiffToListModel )
import MetaBrush.UI.Viewport import MetaBrush.UI.Viewport
( Viewport(..) ) ( Viewport(..) )
import MetaBrush.Unique import MetaBrush.Unique
@ -557,25 +559,31 @@ data Redo = Redo
instance HandleAction Redo where instance HandleAction Redo where
handleAction uiElts vars _ = updateHistory fwd uiElts vars 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 updateHistory f uiElts vars@( Variables {..} ) = do
uiUpdateAction <- STM.atomically do uiUpdateAction <- STM.atomically do
mbUnique <- STM.readTVar activeDocumentTVar mbUnique <- STM.readTVar activeDocumentTVar
case mbUnique of case mbUnique of
Nothing -> pure ( pure () ) Nothing -> pure ( pure () )
Just unique -> do Just docUnique -> do
mbDocHistory <- Map.lookup unique <$> STM.readTVar openDocumentsTVar mbDocHistory <- Map.lookup docUnique <$> STM.readTVar openDocumentsTVar
case mbDocHistory of case mbDocHistory of
Nothing -> pure ( pure () ) Nothing -> pure ( pure () )
Just docHistory -> do Just docHistory -> do
let let mbNewHist = f docHistory
newDocHistory :: DocumentHistory case mbNewHist of
newDocHistory = f docHistory Nothing -> pure ( pure () )
STM.modifyTVar' openDocumentsTVar ( Map.insert unique newDocHistory ) Just ( newDocHistory, ( doOrUndo, diff ) ) -> do
uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars STM.modifyTVar' openDocumentsTVar ( Map.insert docUnique newDocHistory )
pure do uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
updateHistoryState uiElts ( Just newDocHistory ) pure do
uiUpdateAction case diff of
DocumentDiff {} -> return ()
HierarchyDiff hDiff ->
applyDiffToListModel parStoresTVar docUnique ( doOrUndo, hDiff )
ContentDiff {} -> return ()
updateHistoryState uiElts ( Just newDocHistory )
uiUpdateAction
uiUpdateAction uiUpdateAction
--------- ---------

View file

@ -863,10 +863,6 @@ getSelectedItem layersView = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Do or undo?
data Do = Do | Undo
deriving stock ( Eq, Show )
-- | Do, undo or redo? -- | Do, undo or redo?
data DoLayerChange = DoLayerChange !LayerChange | RedoChange | UndoChange data DoLayerChange = DoLayerChange !LayerChange | RedoChange | UndoChange

View file

@ -1,5 +1,6 @@
module MetaBrush.Document.History module MetaBrush.Document.History
( DocumentHistory(..) ( DocumentHistory(..)
, Do(..)
, back, fwd, newHistory, newFutureStep , back, fwd, newHistory, newFutureStep
, atStart, atEnd , atStart, atEnd
, affirmPresentSaved , affirmPresentSaved
@ -49,23 +50,33 @@ instance NFData DocumentHistory where
rnf ( History { past = ps, present, future } ) = rnf ( History { past = ps, present, future } ) =
ps `deepseq` present `deepseq` future `deepseq` () ps `deepseq` present `deepseq` future `deepseq` ()
back :: DocumentHistory -> DocumentHistory -- | Do or undo?
back hist@( History { past = ps, present = c, future = fs } ) = case ps of data Do = Do | Undo
Empty deriving stock ( Eq, Show )
-> hist
qs :|> ( q, diff )
-> History { past = qs
, present = c { documentContent = q }
, future = ( diff, documentContent c ) : fs }
fwd :: DocumentHistory -> DocumentHistory back :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
fwd hist@( History { past = ps, present = c, future = fs } ) = case fs of 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 ( diff, g ) : gs
-> History { past = ps :|> ( documentContent c, diff ) -> Just
, present = c { documentContent = g } ( History { past = ps :|> ( documentContent c, diff )
, future = gs } , present = c { documentContent = g }
, future = gs }
, ( Do, diff )
)
newHistory :: Document -> DocumentHistory newHistory :: Document -> DocumentHistory
newHistory a = History { past = Empty, present = a, future = [] } newHistory a = History { past = Empty, present = a, future = [] }