hxournal 0.6.0.1 → 0.6.1
raw patch · 24 files changed
+532/−203 lines, 24 filesdep ~xournal-renderdep ~xournal-types
Dependency ranges changed: xournal-render, xournal-types
Files
- CHANGES +2/−1
- hxournal.cabal +11/−14
- lib/Application/HXournal/Accessor.hs +2/−2
- lib/Application/HXournal/Config.hs +3/−0
- lib/Application/HXournal/Coroutine/Commit.hs +52/−1
- lib/Application/HXournal/Coroutine/Default.hs +3/−0
- lib/Application/HXournal/Coroutine/Draw.hs +36/−2
- lib/Application/HXournal/Coroutine/Eraser.hs +11/−6
- lib/Application/HXournal/Coroutine/File.hs +5/−5
- lib/Application/HXournal/Coroutine/Mode.hs +8/−2
- lib/Application/HXournal/Coroutine/Page.hs +8/−6
- lib/Application/HXournal/Coroutine/Pen.hs +2/−3
- lib/Application/HXournal/Coroutine/Scroll.hs +2/−1
- lib/Application/HXournal/Coroutine/Select.hs +46/−23
- lib/Application/HXournal/Draw.hs +131/−66
- lib/Application/HXournal/GUI.hs +8/−3
- lib/Application/HXournal/GUI/Menu.hs +1/−2
- lib/Application/HXournal/ModelAction/File.hs +9/−6
- lib/Application/HXournal/ModelAction/Page.hs +35/−16
- lib/Application/HXournal/ModelAction/Pen.hs +12/−8
- lib/Application/HXournal/ModelAction/Select.hs +29/−10
- lib/Application/HXournal/Type/Canvas.hs +1/−2
- lib/Application/HXournal/Type/Undo.hs +84/−0
- lib/Application/HXournal/Type/XournalState.hs +31/−24
CHANGES view
@@ -11,4 +11,5 @@ 0.6.0: 19 Dec 2011 * some bug fixes (temporary yet) related to automatic scrollbar disappearing. Check when new, open, annotate pdf if xournal file is not saved yet. - +0.6.1: 25 Dec 2011+ * undo/redo support, double buffer rendering while scrolling
hxournal.cabal view
@@ -1,5 +1,5 @@ Name: hxournal-Version: 0.6.0.1+Version: 0.6.1 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal@@ -19,12 +19,10 @@ type: git location: http://www.github.com/wavewave/hxournal - Flag Poppler- Description: Enable poppler support + Description: Enable poppler support Default: True - Executable hxournal Main-is: hxournal.hs hs-source-dirs: exe@@ -39,8 +37,8 @@ hs-source-dirs: lib ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind ghc-prof-options: -caf-all -auto-all- - if flag(poppler)++ if flag(poppler) Build-Depends: base == 4.*, mtl == 2.*, directory == 1.*,@@ -50,9 +48,9 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types == 0.1.*,+ xournal-types == 0.2.*, xournal-parser == 0.3.*,- xournal-render == 0.3.0.*,+ xournal-render == 0.4.*, xournal-builder == 0.1.*, containers == 0.4.*, template-haskell == 2.*,@@ -72,9 +70,9 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types == 0.1.*,+ xournal-types == 0.2.*, xournal-parser == 0.3.*,- xournal-render == 0.3.0.*,+ xournal-render == 0.4.*, xournal-builder == 0.1.*, containers == 0.4.*, template-haskell == 2.*,@@ -96,6 +94,7 @@ Application.HXournal.Type.Coroutine Application.HXournal.Type.XournalState Application.HXournal.Type.Window+ Application.HXournal.Type.Undo Application.HXournal.ModelAction.Adjustment Application.HXournal.ModelAction.Pen Application.HXournal.ModelAction.Page@@ -103,7 +102,6 @@ Application.HXournal.ModelAction.Select Application.HXournal.ModelAction.File Application.HXournal.ModelAction.Window- -- Application.HXournal.ModelAction.Common Application.HXournal.Coroutine.Callback Application.HXournal.GUI Application.HXournal.GUI.Menu@@ -128,7 +126,6 @@ Application.HXournal.Accessor Application.HXournal.Config - Other-Modules: Paths_hxournal c-sources: @@ -137,6 +134,6 @@ install-includes: csrc/c_initdevice.h csrc/template-hsc-gtk2hs.h- if flag(poppler) ++ if flag(poppler) cpp-options: -DPOPPLER-
lib/Application/HXournal/Accessor.hs view
@@ -41,8 +41,8 @@ let currCvsInfo = getCurrentCanvasInfo xstate let pagebbox = getPage currCvsInfo strs = do - l <- gToList (glayers pagebbox)- s <- gstrokes l+ l <- gToList (get g_layers pagebbox)+ s <- get g_bstrokes l return s return strs
lib/Application/HXournal/Config.hs view
@@ -24,6 +24,9 @@ config <- load [Required "$(HOME)/.hxournal"] return config +getMaxUndo :: Config -> IO (Maybe Int)+getMaxUndo c = C.lookup c "maxundo"+ getPenDevConfig :: Config -> IO (Maybe String, Maybe String,Maybe String) getPenDevConfig c = do mcore <- C.lookup c "core"
lib/Application/HXournal/Coroutine/Commit.hs view
@@ -3,15 +3,66 @@ import Application.HXournal.Type.XournalState import Application.HXournal.Type.Coroutine import Application.HXournal.Type.Event+import Application.HXournal.Type.Undo ++import Application.HXournal.Coroutine.Draw import Application.HXournal.ModelAction.File+import Application.HXournal.ModelAction.Page import Data.Label+-- import Control.Monad (liftM) import Control.Monad.Trans import Application.HXournal.Accessor +import Graphics.Xournal.Render.BBoxMapPDF+ commit :: HXournalState -> Iteratee MyEvent XournalStateIO () commit xstate = do let ui = get gtkUIManager xstate liftIO $ toggleSave ui True- let xstate' = set isSaved False xstate+ let xojstate = get xournalstate xstate+ undotable = get undoTable xstate + undotable' = addToUndo undotable xojstate+ xstate' = set isSaved False + . set undoTable undotable'+ $ xstate putSt xstate' ++undo :: Iteratee MyEvent XournalStateIO ()+undo = do + liftIO $ putStrLn "undo is called"+ xstate <- getSt+ let utable = get undoTable xstate+ case getPrevUndo utable of + Nothing -> liftIO $ putStrLn "no undo item yet"+ Just (xojstate1,newtable) -> do + xojstate <- liftIO $ resetXournalStateBuffers xojstate1 + let xstate' = set xournalstate xojstate+ . set undoTable newtable + . updatePageAll xojstate + $ xstate + -- commit xstate' + putSt xstate'+ invalidateAll + + +redo :: Iteratee MyEvent XournalStateIO ()+redo = do + liftIO $ putStrLn "redo is called"+ xstate <- getSt+ let utable = get undoTable xstate+ case getNextUndo utable of + Nothing -> liftIO $ putStrLn "no redo item"+ Just (xojstate1,newtable) -> do + xojstate <- liftIO $ resetXournalStateBuffers xojstate1 + let xstate' = set xournalstate xojstate+ . set undoTable newtable + . updatePageAll xojstate + $ xstate + putSt xstate'+ invalidateAll +++++
lib/Application/HXournal/Coroutine/Default.hs view
@@ -12,6 +12,7 @@ import Application.HXournal.GUI.Menu import Application.HXournal.Coroutine.Callback+import Application.HXournal.Coroutine.Commit import Application.HXournal.Coroutine.Draw import Application.HXournal.Coroutine.Pen import Application.HXournal.Coroutine.Eraser@@ -215,6 +216,8 @@ changePage (const (totalnumofpages-1)) menuEventProcess MenuNew = askIfSave fileNew menuEventProcess MenuAnnotatePDF = askIfSave fileAnnotatePDF+menuEventProcess MenuUndo = undo +menuEventProcess MenuRedo = redo menuEventProcess MenuOpen = askIfSave fileOpen menuEventProcess MenuSave = fileSave menuEventProcess MenuSaveAs = fileSaveAs
lib/Application/HXournal/Coroutine/Draw.hs view
@@ -78,15 +78,49 @@ keys = M.keys cinfoMap invalidateGen (filter (/=currCvsId) keys) Nothing drawPageInBBox +-- | invalidate everything+ invalidate :: CanvasId -> Iteratee MyEvent XournalStateIO () -invalidate cid = invalidateSelSingle cid Nothing drawPageInBBox drawSelectionInBBox+invalidate cid = invalidateSelSingle cid Nothing drawPageClearly drawPageSelClearly+ -- drawSelectionInBBox+ -- drawPageInBBox drawSelectionInBBox +-- | Drawing objects only in BBox+ invalidateInBBox :: CanvasId -> BBox -> Iteratee MyEvent XournalStateIO () invalidateInBBox cid bbox = invalidateSelSingle cid (Just bbox) drawPageInBBox drawSelectionInBBox +-- | Drawing BBox+ invalidateDrawBBox :: CanvasId -> BBox -> Iteratee MyEvent XournalStateIO () invalidateDrawBBox cid bbox = invalidateSelSingle cid (Just bbox) drawBBox drawBBoxSel ++{-+-- | Drawing pen strokes as bbox+ invalidateBBoxOnly :: CanvasId -> Iteratee MyEvent XournalStateIO () -invalidateBBoxOnly cid = invalidateSelSingle cid Nothing drawBBoxOnly drawSelectionInBBoxOnly+invalidateBBoxOnly cid = invalidateBBoxOnlyInBBox cid Nothing+ -- invalidateSelSingle cid Nothing drawBBoxOnly drawSelectionInBBoxOnly++invalidateBBoxOnlyInBBox :: CanvasId -> Maybe BBox -> Iteratee MyEvent XournalStateIO () +invalidateBBoxOnlyInBBox cid mbbox = invalidateSelSingle cid mbbox drawBBoxOnly drawSelectionInBBoxOnly+-}++-- | Drawing using layer buffer++invalidateWithBuf :: CanvasId -> Iteratee MyEvent XournalStateIO () +invalidateWithBuf = invalidateWithBufInBBox Nothing+ + -- invalidateSelSingle cid Nothing drawBuf drawSelectionInBBox+ -- drawSelectionInBBoxOnly -- drawSelBuf -- temporarily+++-- | Drawing using layer buffer in BBox++invalidateWithBufInBBox :: Maybe BBox -> CanvasId -> Iteratee MyEvent XournalStateIO () +invalidateWithBufInBBox mbbox cid = invalidateSelSingle cid mbbox drawBuf drawSelectionInBBox+ + -- drawSelectionInBBoxOnly -- drawSelBuf --temporarily+
lib/Application/HXournal/Coroutine/Eraser.hs view
@@ -18,6 +18,8 @@ import Data.Xournal.Map import Data.Xournal.BBox import Graphics.Xournal.Render.HitTest+import Graphics.Xournal.Render.BBox+import Graphics.Xournal.Render.BBoxMapPDF import Control.Monad.Coroutine.SuspensionFunctors import Control.Monad.Trans import qualified Control.Monad.State as St@@ -67,22 +69,25 @@ Nothing -> error "something wrong in eraserProcess" Just l -> l - (newstrokes,maybebbox) = St.runState (eraseHitted hitteststroke) Nothing- newlayerbbox = currlayer { gstrokes = newstrokes } - newpagebbox = currpage { glayers = IM.adjust (const newlayerbbox) 0 (glayers currpage) } + (newstrokes,maybebbox1) = St.runState (eraseHitted hitteststroke) Nothing+ maybebbox = fmap (flip inflate 2.0) maybebbox1+ newlayerbbox <- liftIO . updateLayerBuf maybebbox . set g_bstrokes newstrokes $ currlayer + let newpagebbox = currpage { glayers = IM.adjust (const newlayerbbox) 0 (glayers currpage) } newxojbbox = currxoj { gpages= IM.adjust (const newpagebbox) pgnum (gpages currxoj) } newxojstate = ViewAppendState newxojbbox commit . set xournalstate newxojstate . updatePageAll newxojstate $ xstate - case maybebbox of - Just bbox -> invalidateDrawBBox cid bbox- Nothing -> return ()+ invalidateWithBufInBBox maybebbox cid + {- case maybebbox of + Just bbox -> -- invalidateWithBufInBBox m-- invalidateDrawBBox cid bbox+ Nothing -> return () -} newstrs <- getAllStrokeBBoxInCurrentPage eraserProcess cid cpg connidup connidmove newstrs (x,y) else eraserProcess cid cpg connidmove connidup strs (x,y) PenUp _cid' _pcoord -> do disconnect connidmove disconnect connidup + invalidateAll _ -> return ()
lib/Application/HXournal/Coroutine/File.hs view
@@ -58,8 +58,8 @@ Just filename -> do let xojstate = get xournalstate xstate let xoj = case xojstate of - ViewAppendState xojmap -> Xournal <$> get g_title <*> gToList . fmap (toPage gToBackground) . get g_pages $ xojmap - SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPage gToBackground) . gselectAll $ txoj + ViewAppendState xojmap -> Xournal <$> get g_title <*> gToList . fmap (toPageFromBuf gToBackground) . get g_pages $ xojmap + SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPageFromBuf gToBackground) . gselectAll $ txoj liftIO . L.writeFile filename . builder $ xoj putSt . set isSaved True $ xstate let ui = get gtkUIManager xstate@@ -118,9 +118,9 @@ let xoj = case xojstate of ViewAppendState xojmap -> Xournal <$> get g_title - <*> gToList . fmap (toPage gToBackground) . get g_pages + <*> gToList . fmap (toPageFromBuf gToBackground) . get g_pages $ xojmap - SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPage gToBackground) . gselectAll $ txoj + SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPageFromBuf gToBackground) . gselectAll $ txoj liftIO . L.writeFile filename . builder $ xoj putSt . set isSaved True $ xstateNew let ui = get gtkUIManager xstateNew@@ -142,7 +142,7 @@ FileChooserActionOpen [ ("OK", ResponseOk) , ("Cancel", ResponseCancel) ]- liftIO $ fileChooserSetCurrentFolder dialog cwd + liftIO $ fileChooserSetCurrentFolder dialog cwd res <- liftIO $ dialogRun dialog case res of ResponseDeleteEvent -> liftIO $ widgetDestroy dialog
lib/Application/HXournal/Coroutine/Mode.hs view
@@ -5,6 +5,8 @@ import Application.HXournal.Type.XournalState import Application.HXournal.Accessor +--import Data.Foldable+import Data.Traversable import Data.Xournal.Map import Control.Monad.Trans@@ -12,11 +14,13 @@ import Control.Applicative import Control.Category import Data.Label-import Prelude hiding ((.),id) import Data.Xournal.Generic import Graphics.Xournal.Render.BBoxMapPDF +import Prelude hiding ((.),id, mapM_, mapM)++ modeChange :: MyEvent -> Iteratee MyEvent XournalStateIO () modeChange ToViewAppendMode = do xstate <- getSt@@ -25,8 +29,10 @@ ViewAppendState _ -> return () SelectState txoj -> do liftIO $ putStrLn "to view append mode"+ let pages = get g_selectAll txoj + newpages <- liftIO $ mapM resetPageBuffers pages putSt - . set xournalstate (ViewAppendState (GXournal (gselectTitle txoj) (gselectAll txoj)))+ . set xournalstate (ViewAppendState (GXournal (get g_selectTitle txoj) newpages )) $ xstate modeChange ToSelectMode = do xstate <- getSt
lib/Application/HXournal/Coroutine/Page.hs view
@@ -7,8 +7,10 @@ import Application.HXournal.Draw import Application.HXournal.Accessor import Application.HXournal.Coroutine.Draw+import Application.HXournal.Coroutine.Commit import Application.HXournal.ModelAction.Adjustment import Graphics.Xournal.Render.Type +import Graphics.Xournal.Render.BBoxMapPDF import Data.Xournal.Generic import Data.Xournal.Map import Graphics.UI.Gtk hiding (get,set)@@ -38,11 +40,11 @@ (xstate',xoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) then do - let npage = lpage { glayers = IM.insert 0 (GLayer []) IM.empty } + let npage = lpage { glayers = IM.insert 0 (GLayerBuf (LyBuf Nothing) []) IM.empty } npages = IM.insert totalnumofpages npage pgs newxoj = xoj { gpages = npages } xstate' = set xournalstate (ViewAppendState newxoj) xstate- putSt xstate'+ commit xstate' return (xstate',newxoj,npages,totalnumofpages+1,totalnumofpages) else if modifyfn oldpage < 0 then return (xstate,xoj,pgs,totalnumofpages,0)@@ -58,7 +60,7 @@ xstate'' = updatePageAll (ViewAppendState xoj') . updateCanvasInfo currCvsInfo' $ xstate'- lift . St.put $ xstate'' + putSt xstate'' invalidate currCvsId SelectState txoj -> do let pgs = gselectAll txoj @@ -70,11 +72,11 @@ (xstate',txoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) then do - let npage = lpage { glayers = IM.insert 0 (GLayer []) IM.empty } + let npage = lpage { glayers = IM.insert 0 (GLayerBuf (LyBuf Nothing) []) IM.empty } npages = IM.insert totalnumofpages npage pgs newtxoj = txoj { gselectAll = npages } xstate' = set xournalstate (SelectState newtxoj) xstate- putSt xstate'+ commit xstate' return (xstate',newtxoj,npages,totalnumofpages+1,totalnumofpages) else if modifyfn oldpage < 0 then return (xstate,txoj,pgs,totalnumofpages,0)@@ -90,7 +92,7 @@ xstate'' = updatePageAll (SelectState txoj') . updateCanvasInfo currCvsInfo' $ xstate'- lift . St.put $ xstate'' + putSt xstate'' invalidate currCvsId canvasZoomUpdate :: Maybe ZoomMode -> CanvasId -> Iteratee MyEvent XournalStateIO ()
lib/Application/HXournal/Coroutine/Pen.hs view
@@ -33,7 +33,6 @@ let currxoj = unView . get xournalstate $ xstate -- page = getPage cvsInfo pagenum = get currentPageNum cvsInfo- -- (x0,y0) = get (viewPortOrigin.viewInfo) cvsInfo pinfo = get penInfo xstate zmode = get (zoomMode.viewInfo) cvsInfo geometry <- getCanvasGeometry cvsInfo @@ -41,8 +40,8 @@ connidup <- connectPenUp cvsInfo connidmove <- connectPenMove cvsInfo pdraw <-penProcess cid geometry connidmove connidup (empty |> (x,y)) (x,y) - let (newxoj,bbox) = addPDraw pinfo currxoj pagenum pdraw- bbox' = inflate bbox (get (penWidth.penInfo) xstate) + (newxoj,bbox) <- liftIO $ addPDraw pinfo currxoj pagenum pdraw+ let bbox' = inflate bbox (get (penWidth.penInfo) xstate) xstate' = set xournalstate (ViewAppendState newxoj) . updatePageAll (ViewAppendState newxoj) $ xstate
lib/Application/HXournal/Coroutine/Scroll.hs view
@@ -35,7 +35,8 @@ . set currentCanvas cid $ xstate lift . St.put $ xstate'- invalidateBBoxOnly cid+ -- invalidateBBoxOnly cid+ invalidateWithBuf cid vscrollMove cid VScrollBarEnd cid' _v -> do invalidate cid'
lib/Application/HXournal/Coroutine/Select.hs view
@@ -30,7 +30,7 @@ import Graphics.Xournal.Render.BBox -+import qualified Data.IntMap as IM import Data.Maybe -- | main mouse pointer click entrance in rectangular selection mode. @@ -95,10 +95,15 @@ hittestbbox = mkHitTestInsideBBox bbox strs hittedstrs = concat . map unHitted . getB $ hittestbbox -- for the time being (until double buffer)- -- invalidateInBBox cid (inflate (fromJust (Just bbox `merge` Just prevbbox)) 2)- invalidateBBoxOnly cid - invalidateDrawBBox cid bbox- mapM_ (invalidateDrawBBox cid . strokebbox_bbox) hittedstrs+ + if not (isBBoxDeltaSmallerThan 1.0 geometry zmode bbox prevbbox) + then do flip invalidateWithBufInBBox cid . Just $+ (inflate (fromJust (Just bbox `merge` Just prevbbox)) 5.0)+ + -- invalidateBBoxOnly cid + invalidateDrawBBox cid bbox+ mapM_ (invalidateDrawBBox cid . strokebbox_bbox) hittedstrs+ else return () newSelectRectangle cinfo geometry zmode connidmove connidup strs orig (x,y) PenUp _cid' pcoord -> do let (x,y) = device2pageCoord geometry zmode pcoord @@ -110,15 +115,24 @@ selectstrs = fmapAL unNotHitted id hittestbbox xstate <- getSt let SelectState txoj = get xournalstate xstate- newlayer = GLayer (TEitherAlterHitted (Right selectstrs))+ newpage = case epage of Left pagebbox -> - let tpg = ttempPageSelectPDFFromTPageBBoxMapPDF pagebbox+ let currlayer = case IM.lookup 0 (get g_layers pagebbox) of+ Nothing -> error "something wrong in newSelectRectangle"+ Just l -> l+ newlayer = GLayerBuf (get g_buffer currlayer) (TEitherAlterHitted (Right selectstrs))+ + + tpg = gcast pagebbox ls = glayers tpg - in tpg { glayers = ls { gselectedlayer = newlayer} }+ in tpg { glayers = ls { gselectedlayerbuf = newlayer} } Right tpage -> let ls = glayers tpage - in tpage { glayers = ls { gselectedlayer = newlayer } } + currlayer = gselectedlayerbuf ls+ newlayer = GLayerBuf (get g_buffer currlayer) (TEitherAlterHitted (Right selectstrs))++ in tpage { glayers = ls { gselectedlayerbuf = newlayer } } newtxoj = txoj { gselectSelected = Just (cpn,newpage) } let ui = get gtkUIManager xstate liftIO $ toggleCutCopyDelete ui (isAnyHitted selectstrs)@@ -170,12 +184,13 @@ xstate <- getSt let SelectState txoj = get xournalstate xstate Just (n,tpage) = gselectSelected txoj- case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage of + slayer = gselectedlayerbuf . glayers $ tpage+ case unTEitherAlterHitted . get g_bstrokes $ slayer of Left _ -> liftIO $ putStrLn "no stroke selection 2 " Right alist -> do let newlayer = Left . concat . getA $ alist oldlayers = glayers tpage- newpage = tpage { glayers = oldlayers { gselectedlayer = GLayer (TEitherAlterHitted newlayer) } } + newpage = tpage { glayers = oldlayers { gselectedlayerbuf = GLayerBuf (get g_buffer slayer) (TEitherAlterHitted newlayer) } } newtxoj = updateTempXournalSelect txoj newpage n newxstate = updatePageAll (SelectState newtxoj) . set xournalstate (SelectState newtxoj)@@ -200,7 +215,8 @@ case etpage of Left _ -> return () Right tpage -> do - case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage of + let slayer = gselectedlayerbuf . glayers $ tpage+ case unTEitherAlterHitted . get g_bstrokes $ slayer of Left _ -> return () Right alist -> do let strs = takeHittedStrokes alist @@ -225,18 +241,19 @@ cinfo = getCurrentCanvasInfo xstate pagenum = get currentPageNum cinfo tpage = case get currentPage cinfo of - Left pbbox -> ttempPageSelectPDFFromTPageBBoxMapPDF pbbox+ Left pbbox -> (gcast pbbox :: TTempPageSelectPDFBuf) Right tp -> tp - layerselect = gselectedlayer . glayers $ tpage + layerselect = gselectedlayerbuf . glayers $ tpage ls = glayers tpage+ gbuf = get g_buffer layerselect newlayerselect = - case unTEitherAlterHitted . gstrokes $ layerselect of - Left strs -> (GLayer . TEitherAlterHitted . Right) (strs :- Hitted clipstrs :- Empty)- Right alist -> (GLayer . TEitherAlterHitted . Right) + case unTEitherAlterHitted . get g_bstrokes $ layerselect of + Left strs -> (GLayerBuf gbuf . TEitherAlterHitted . Right) (strs :- Hitted clipstrs :- Empty)+ Right alist -> (GLayerBuf gbuf . TEitherAlterHitted . Right) (concat (interleave id unHitted alist) :- Hitted clipstrs :- Empty )- tpage' = tpage { glayers = ls { gselectedlayer = newlayerselect } } + tpage' = tpage { glayers = ls { gselectedlayerbuf = newlayerselect } } txoj' = updateTempXournalSelect txoj tpage' pagenum xstate' = updatePageAll (SelectState txoj') . set xournalstate (SelectState txoj') @@ -252,14 +269,15 @@ xstate <- getSt let SelectState txoj = get xournalstate xstate Just (n,tpage) = gselectSelected txoj- case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage of + slayer = gselectedlayerbuf . glayers $ tpage+ case unTEitherAlterHitted . get g_bstrokes $ slayer of Left _ -> liftIO $ putStrLn "no stroke selection 2 " Right alist -> do let alist' = fmapAL id (Hitted . map (changeStrokeColor pcolor) . unHitted) alist newlayer = Right alist' ls = glayers tpage - newpage = tpage { glayers = ls { gselectedlayer = GLayer (TEitherAlterHitted newlayer) }} + newpage = tpage { glayers = ls { gselectedlayerbuf = GLayerBuf (get g_buffer slayer) (TEitherAlterHitted newlayer) }} newtxoj = updateTempXournalSelect txoj newpage n commit . updatePageAll (SelectState newtxoj) . set xournalstate (SelectState newtxoj) @@ -272,17 +290,22 @@ xstate <- getSt let SelectState txoj = get xournalstate xstate Just (n,tpage) = gselectSelected txoj- case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage of + slayer = gselectedlayerbuf . get g_layers $ tpage+ case unTEitherAlterHitted . get g_bstrokes $ slayer of Left _ -> liftIO $ putStrLn "no stroke selection 2 " Right alist -> do let alist' = fmapAL id (Hitted . map (changeStrokeWidth pwidth) . unHitted) alist newlayer = Right alist'- ls = glayers tpage - newpage = tpage { glayers = ls { gselectedlayer = GLayer (TEitherAlterHitted newlayer) }} + ls = get g_layers tpage + newpage = tpage { glayers = ls { gselectedlayerbuf = GLayerBuf (get g_buffer slayer) (TEitherAlterHitted newlayer) }} newtxoj = updateTempXournalSelect txoj newpage n commit . updatePageAll (SelectState newtxoj) . set xournalstate (SelectState newtxoj) $ xstate invalidateAll ++++
lib/Application/HXournal/Draw.hs view
@@ -8,6 +8,7 @@ import Data.Label import Prelude hiding ((.),id) +import Data.Monoid import Data.Xournal.Simple import Data.Xournal.Generic import Data.Xournal.Map@@ -33,10 +34,10 @@ } deriving (Show) -type PageDrawF = DrawingArea -> TPageBBoxMapPDF -> ViewInfo -> Maybe BBox +type PageDrawF = DrawingArea -> TPageBBoxMapPDFBuf -> ViewInfo -> Maybe BBox -> IO () -type PageDrawFSel = DrawingArea -> TTempPageSelectPDF -> ViewInfo -> Maybe BBox +type PageDrawFSel = DrawingArea -> TTempPageSelectPDFBuf -> ViewInfo -> Maybe BBox -> IO () @@ -57,6 +58,12 @@ (fromIntegral x0,fromIntegral y0) (xorig, yorig) +visibleViewPort :: CanvasPageGeometry -> ZoomMode -> BBox +visibleViewPort cpg@(CanvasPageGeometry (ws,hs) (w',h') (w,h) (x0,y0) (xorig,yorig)) zmode = + let (xend,yend) = canvasToPageCoord cpg zmode (w',h')+ in BBox (xorig,yorig) (xend,yend)++ core2pageCoord :: CanvasPageGeometry -> ZoomMode -> (Double,Double) -> (Double,Double) core2pageCoord cpg@(CanvasPageGeometry (_ws,_hs) (_w',_h') (_w,_h) (_x0,_y0) (xorig,yorig))@@ -96,7 +103,19 @@ _ -> wacom2pageCoord cpg zmode (px,py) device2pageCoord _ _ NoPointerCoord = (-100,-100) +pageToCanvasCoord :: CanvasPageGeometry -> ZoomMode -> (Double,Double) -> (Double,Double)+pageToCanvasCoord cpg@(CanvasPageGeometry _ _ _ _ (xorig,yorig)) zmode (x,y) = + let s = getRatioFromPageToCanvas cpg zmode+ (xo,yo) = case zmode of + Original -> (xorig,yorig)+ FitWidth -> (0,yorig)+ FitHeight -> (xorig,0)+ _ -> error "not implemented yet in pageToScreenCoord"+ in ((x-xo)*s,(y-yo)*s) +canvasToPageCoord :: CanvasPageGeometry -> ZoomMode -> (Double,Double) -> (Double,Double) +canvasToPageCoord = core2pageCoord+ transformForPageCoord :: CanvasPageGeometry -> ZoomMode -> Render () transformForPageCoord cpg zmode = do let (xo,yo) = page_origin cpg@@ -104,6 +123,7 @@ scale s s translate (-xo) (-yo) +{- updateCanvas :: DrawingArea -> TXournalBBoxMapPDF -> Int -> ViewInfo -> IO () updateCanvas canvas xoj pagenum vinfo = do let zmode = get zoomMode vinfo@@ -113,12 +133,60 @@ Just p -> p geometry <- getCanvasPageGeometry canvas currpage origin win <- widgetGetDrawWindow canvas+ let viewbbox = visibleViewPort geometry zmode+ newmbbox = Just viewbbox renderWithDrawable win $ do transformForPageCoord geometry zmode- -- cairoDrawPage currpage- cairoRenderOption (DrawBuffer,DrawFull) currpage+ -- cairoRenderOption (InBBoxOption newmbbox) (InBBox currpage)+ cairoRenderOption (DrawBkgPDF,DrawFull) currpage return ()+-} +drawFuncGen :: (TPageBBoxMapPDFBuf -> Maybe BBox -> Render ()) -> PageDrawF +drawFuncGen render canvas page vinfo mbbox = do + let zmode = get zoomMode vinfo+ origin = get viewPortOrigin vinfo+ geometry <- getCanvasPageGeometry canvas page origin+ win <- widgetGetDrawWindow canvas+ let mbboxnew = adjustBBoxWithView geometry zmode mbbox+ renderWithDrawable win $ do+ transformForPageCoord geometry zmode+ render page mbboxnew + return ()+ return ()+ +drawFuncSelGen :: (TTempPageSelectPDFBuf -> Maybe BBox -> Render ()) + -> (TTempPageSelectPDFBuf -> Maybe BBox -> Render ())+ -> PageDrawFSel +drawFuncSelGen rencont rensel canvas page vinfo mbbox = do + let zmode = get zoomMode vinfo+ origin = get viewPortOrigin vinfo+ geometry <- getCanvasPageGeometry canvas page origin+ win <- widgetGetDrawWindow canvas+ let mbboxnew = adjustBBoxWithView geometry zmode mbbox+ renderWithDrawable win $ do+ transformForPageCoord geometry zmode+ rencont page mbboxnew + rensel page mbboxnew + return ()+ +++drawPageClearly :: PageDrawF+drawPageClearly = drawFuncGen $ \page _mbbox -> + cairoRenderOption (DrawBkgPDF,DrawFull) (gcast page :: TPageBBoxMapPDF)+ +drawPageSelClearly :: PageDrawFSel +drawPageSelClearly = drawFuncSelGen rendercontent renderselect + where rendercontent tpg mbbox = do+ let pg = (gcast tpg :: TPageBBoxMapPDFBuf)+ cairoRenderOption (DrawBkgPDF,DrawFull) (gcast pg :: TPageBBoxMapPDF)+ renderselect tpg mbbox = + cairoHittedBoxDraw tpg mbbox++++ drawBBoxOnly :: PageDrawF drawBBoxOnly canvas page vinfo _mbbox = do let zmode = get zoomMode vinfo@@ -127,10 +195,17 @@ win <- widgetGetDrawWindow canvas renderWithDrawable win $ do transformForPageCoord geometry zmode- -- cairoDrawPageBBoxOnly page- cairoRenderOption (DrawBuffer,DrawBoxOnly) page + cairoRenderOption (DrawWhite,DrawBoxOnly) (gcast page :: TPageBBoxMapPDF)+ -- tpageBBoxMapPDFFromTPageBBoxMapPDFBuf page ) return () +adjustBBoxWithView :: CanvasPageGeometry -> ZoomMode -> Maybe BBox + -> Maybe BBox+adjustBBoxWithView geometry zmode mbbox = + let viewbbox = visibleViewPort geometry zmode+ in toMaybe $ (fromMaybe mbbox :: IntersectBBox) + `mappend` + (Intersect (Middle viewbbox)) drawPageInBBox :: PageDrawF @@ -139,10 +214,10 @@ origin = get viewPortOrigin vinfo geometry <- getCanvasPageGeometry canvas page origin win <- widgetGetDrawWindow canvas+ let mbboxnew = adjustBBoxWithView geometry zmode mbbox renderWithDrawable win $ do transformForPageCoord geometry zmode- -- cairoDrawPageBBox mbbox page- cairoRenderOption (DrawBuffer,DrawFull) page+ cairoRenderOption (InBBoxOption mbboxnew) (InBBox page) -- (InBBox (gcast page :: TPageBBoxMapPDF)) return () return () @@ -166,7 +241,7 @@ drawBBoxSel :: PageDrawFSel drawBBoxSel _ _ _ Nothing = return () drawBBoxSel canvas tpg vinfo (Just bbox) = do - let page = tpageBBoxMapPDFFromTTempPageSelectPDF tpg+ let page = (gcast tpg :: TPageBBoxMapPDFBuf) let zmode = get zoomMode vinfo origin = get viewPortOrigin vinfo geometry <- getCanvasPageGeometry canvas page origin@@ -212,32 +287,6 @@ lineTo x y stroke -{- -showTXournalBBoxMapPDF :: DrawingArea -> TXournalBBoxMapPDF -> Int -> ViewInfo -> IO ()-showTXournalBBoxMapPDF canvas xoj pagenum vinfo = do - let zmode = get zoomMode vinfo- origin = get viewPortOrigin vinfo- let currpagebbox = case ( M.lookup pagenum . gpages) xoj of - Nothing -> error "no such page in showTXournalBBoxMapPDF"- Just p -> p - currpage = pageFromPageBBox currpagebbox- strs = do - l <- pagebbox_layers currpagebbox - s <- layerbbox_strokes l- return s - geometry <- getCanvasPageGeometry canvas currpage origin- win <- widgetGetDrawWindow canvas- renderWithDrawable win $ do- transformForPageCoord geometry zmode- setSourceRGBA 1.0 0 0 1.0 - setLineWidth 0.5 - let f str = do - let BBox (ulx,uly) (lrx,lry) = strokebbox_bbox str - rectangle ulx uly (lrx-ulx) (lry-uly)- stroke - mapM_ f strs - return ()--} showBBox :: DrawingArea -> CanvasPageGeometry -> ZoomMode -> BBox -> IO () showBBox canvas cpg zmode (BBox (ulx,uly) (lrx,lry)) = do @@ -260,34 +309,40 @@ drawSelectionInBBox canvas tpg vinfo mbbox = do let zmode = get zoomMode vinfo origin = get viewPortOrigin vinfo- page = tpageBBoxMapPDFFromTTempPageSelectPDF tpg+ page = (gcast tpg :: TPageBBoxMapPDFBuf) geometry <- getCanvasPageGeometry canvas page origin win <- widgetGetDrawWindow canvas+ let mbboxnew = adjustBBoxWithView geometry zmode mbbox renderWithDrawable win $ do transformForPageCoord geometry zmode- cairoDrawPageBBoxPDF mbbox page- cairoHittedBoxDraw tpg mbbox -- boxdrawaction --- boxdrawaction + cairoRenderOption (InBBoxOption mbboxnew) (InBBox page)+ -- (InBBox (gcast page :: TPageBBoxMapPDF))+ cairoHittedBoxDraw tpg mbboxnew +{- drawSelectionInBBoxOnly :: PageDrawFSel drawSelectionInBBoxOnly canvas tpg vinfo mbbox = do let zmode = get zoomMode vinfo origin = get viewPortOrigin vinfo- page = tpageBBoxMapPDFFromTTempPageSelectPDF tpg+ page = (gcast tpg :: TPageBBoxMapPDFBuf) geometry <- getCanvasPageGeometry canvas page origin- win <- widgetGetDrawWindow canvas+ win <- widgetGetDrawWindow canvas + let mbboxnew = adjustBBoxWithView geometry zmode mbbox renderWithDrawable win $ do transformForPageCoord geometry zmode- cairoRenderOption (DrawBuffer,DrawBoxOnly) page- -- cairoDrawPageBBoxPDF mbbox page- cairoHittedBoxDraw tpg mbbox -- boxdrawaction --+ cairoRenderOption (InBBoxOption mbboxnew) (InBBox page)+ -- (DrawWhite,DrawBoxOnly) (gcast page :: TPageBBoxMapPDF)+ -- (DrawBuffer,DrawBoxOnly) (gcast page :: TPageBBoxMapPDF)+ cairoHittedBoxDraw tpg mbbox +-} -cairoHittedBoxDraw :: TTempPageSelectPDF -> Maybe BBox -> Render () +cairoHittedBoxDraw :: TTempPageSelectPDFBuf -> Maybe BBox -> Render () cairoHittedBoxDraw tpg mbbox = do - case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpg of+ let layers = get g_layers tpg + slayer = gselectedlayerbuf layers + case unTEitherAlterHitted . get g_bstrokes $ slayer of Right alist -> do + clipBBox mbbox setSourceRGBA 0.0 0.0 1.0 1.0 let hitstrs = concatMap unHitted (getB alist) oneboxdraw str = do @@ -299,25 +354,35 @@ else return () Nothing -> drawbox mapM_ oneboxdraw hitstrs + resetClip Left _ -> return () -+---- + +drawBuf :: PageDrawF +drawBuf canvas page vinfo mbbox = do + let zmode = get zoomMode vinfo+ origin = get viewPortOrigin vinfo+ geometry <- getCanvasPageGeometry canvas page origin+ let mbboxnew = adjustBBoxWithView geometry zmode mbbox+{- let viewbbox = visibleViewPort geometry zmode+ newmbbox = toMaybe $ (fromMaybe mbbox :: IntersectBBox) `mappend` (Intersect (Middle viewbbox)) -}+ win <- widgetGetDrawWindow canvas+ renderWithDrawable win $ do+ transformForPageCoord geometry zmode+ cairoRenderOption (InBBoxOption mbboxnew) (InBBox page) + return ()+ return () - {-- boxdrawaction <- - case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpg of- Right alist -> do - return $ do - setSourceRGBA 0.0 0.0 1.0 1.0- let hitstrs = concatMap unHitted (getB alist)- oneboxdraw str = do - let bbox@(BBox (x1,y1) (x2,y2)) = strokebbox_bbox str- drawbox = do { rectangle x1 y1 (x2-x1) (y2-y1); stroke }- case mbbox of - Just bboxarg -> if hitTestBBoxBBox bbox bboxarg - then drawbox- else return () - Nothing -> drawbox - mapM_ oneboxdraw hitstrs - Left _ -> return $ return () -}+drawSelBuf :: PageDrawFSel +drawSelBuf canvas tpg vinfo mbbox = do + let zmode = get zoomMode vinfo+ origin = get viewPortOrigin vinfo+ page = (gcast tpg :: TPageBBoxMapPDFBuf)+ geometry <- getCanvasPageGeometry canvas page origin+ win <- widgetGetDrawWindow canvas+ renderWithDrawable win $ do+ transformForPageCoord geometry zmode+ cairoRenderOption (InBBoxOption mbbox) (InBBox (gcast page :: TPageBBoxMapPDF))+ cairoHittedBoxDraw tpg mbbox
lib/Application/HXournal/GUI.hs view
@@ -5,7 +5,7 @@ import Application.HXournal.Type.XournalState import Application.HXournal.Type.Event import Application.HXournal.Type.Canvas-+import Application.HXournal.Type.Undo import qualified Data.IntMap as M import Application.HXournal.Coroutine.Callback@@ -23,6 +23,7 @@ import Control.Monad.Trans import Data.IORef+import Data.Maybe import Control.Category import Data.Label@@ -37,8 +38,11 @@ cfg <- loadConfigFile devlst <- initDevice cfg (tref,sref) <- initCoroutine devlst window- st1 <- readIORef sref -+ st0 <- readIORef sref + maxundo <- getMaxUndo cfg >>= + \mmax -> maybe (return 50) (return . id) mmax+ let st1 = set undoTable (emptyUndo maxundo) st0 + -- let st1 = set gtkUIManager ui st0 st2 <- getFileContent mfname st1 let ui = get gtkUIManager st2 @@ -49,6 +53,7 @@ setTitleFromFileName st2 vbox <- vBoxNew False 0 + let st3 = set frameState wconf . set rootWindow winCvsArea
lib/Application/HXournal/GUI/Menu.hs view
@@ -483,7 +483,7 @@ let disabledActions = [ recenta, printa, exporta- , undoa, redoa, cuta, copya, pastea, deletea+ , {- undoa, redoa, -} cuta, copya, pastea, deletea , fscra, zmina, zmouta, setzma , shwlayera, hidlayera , newpgba, newpgaa, newpgea, delpga, newlyra, dellyra, ppsizea, ppclra@@ -491,7 +491,6 @@ , shpreca, rulera , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- {- , uxinputa -} , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa
lib/Application/HXournal/ModelAction/File.hs view
@@ -8,6 +8,7 @@ import qualified Text.Xournal.Parse as P import qualified Data.IntMap as M +import Control.Monad import Control.Category import Data.Label import Prelude hiding ((.),id)@@ -27,7 +28,7 @@ #ifdef POPPLER import qualified Graphics.UI.Gtk.Poppler.Document as Poppler import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage-#endif +#endif -- | get file content from xournal file and update xournal state @@ -39,7 +40,8 @@ nxstate <- constructNewHXournalStateFromXournal xojcontent xstate return $ set currFileName (Just fname) nxstate getFileContent Nothing xstate = do - newxoj <- mkTXournalBBoxMapPDF defaultXournal + newxoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF + $ defaultXournal let newxojstate = ViewAppendState newxoj xstate' = set currFileName Nothing . set xournalstate newxojstate@@ -56,7 +58,7 @@ constructNewHXournalStateFromXournal xoj xstate = do let currcid = get currentCanvas xstate cmap = get canvasInfoMap xstate - xoj <- mkTXournalBBoxMapPDF xoj+ xoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF $ xoj let Dim width height = case M.lookup 0 (gpages xoj) of Nothing -> error "no first page in getFileContent" Just p -> gdimension p @@ -75,8 +77,8 @@ makeNewXojWithPDF :: FilePath -> IO (Maybe Xournal) makeNewXojWithPDF fp = do - let fname = C.pack fp #ifdef POPPLER+ let fname = C.pack fp mdoc <- popplerGetDocFromFile fname case mdoc of Nothing -> do @@ -94,8 +96,9 @@ putStrLn $ "size = " ++ show (w,h) return (Just xoj) #else- error "makeNewXojWithPDF : this cannot be done without poppler lib." -#endif + error "makeNewXojWithPDF should not be used without poppler lib"+#endif+ createPage :: Dimension -> B.ByteString -> Int -> Page createPage dim fn n
lib/Application/HXournal/ModelAction/Page.hs view
@@ -16,21 +16,39 @@ updatePageAll :: XournalState -> HXournalState -> HXournalState-updatePageAll xst xstate = let cmap = get canvasInfoMap xstate- cmap' = fmap (updatePage xst) cmap- in set canvasInfoMap cmap' xstate +updatePageAll xst xstate = + let cmap = get canvasInfoMap xstate+ cmap' = fmap (updatePage xst . adjustPage xst) cmap+ in set canvasInfoMap cmap' xstate +adjustPage :: XournalState -> CanvasInfo -> CanvasInfo+adjustPage xojstate cinfo =+ let cpn = get currentPageNum cinfo + pagemap = case xojstate of + ViewAppendState xoj -> get g_pages xoj + SelectState txoj -> get g_selectAll txoj + in adjustwork cpn pagemap + where adjustwork cpn pagemap = + if M.notMember cpn pagemap + then let (minp,_) = M.findMin pagemap + (maxp,_) = M.findMax pagemap + in if cpn > maxp + then set currentPageNum maxp cinfo+ else set currentPageNum minp cinfo+ else cinfo+ -getPageFromXojBBoxMapPDF :: Int -> TXournalBBoxMapPDF -> TPageBBoxMapPDF-getPageFromXojBBoxMapPDF pagenum xoj = - case M.lookup pagenum (gpages xoj) of - Nothing -> error "something wrong in updatePage"++getPageFromGXournalMap :: Int -> GXournal M.IntMap a -> a+getPageFromGXournalMap pagenum xoj = + case M.lookup pagenum (get g_pages xoj) of + Nothing -> error "something wrong in getPageFromGXournalMap" Just p -> p updatePage :: XournalState -> CanvasInfo -> CanvasInfo updatePage (ViewAppendState xojbbox) cinfo = let pagenum = get currentPageNum cinfo - pg = getPageFromXojBBoxMapPDF pagenum xojbbox + pg = getPageFromGXournalMap pagenum xojbbox Dim w h = gdimension pg in set currentPageNum pagenum . set (pageDimension.viewInfo) (w,h) @@ -56,7 +74,9 @@ setPage :: XournalState -> Int -> CanvasInfo -> CanvasInfo setPage (ViewAppendState xojbbox) pagenum cinfo = - let pg = getPageFromXojBBoxMapPDF pagenum xojbbox + let pg = getPageFromGXournalMap pagenum xojbbox+ -- getPageFromXojBBoxMapPDF pagenum xojbbox + Dim w h = gdimension pg in set currentPageNum pagenum . set (viewPortOrigin.viewInfo) (0,0) @@ -65,7 +85,6 @@ $ cinfo setPage (SelectState txoj) pagenum cinfo = let mspage = gselectSelected txoj - -- tx_selectpage pageFromArg = case M.lookup pagenum (gselectAll txoj) of Nothing -> error "no such page in setPage" Just p -> p@@ -82,11 +101,11 @@ . set currentPage newpage $ cinfo -getPage :: CanvasInfo -> TPageBBoxMapPDF-getPage cinfo = case get currentPage cinfo of - Right tpgs -> tpageBBoxMapPDFFromTTempPageSelectPDF tpgs- - -- pageBBoxMapFromTempPageSelect tpgs- Left pg -> pg +getPage :: CanvasInfo -> TPageBBoxMapPDFBuf+getPage cinfo = + case get currentPage cinfo of + Right tpgs -> gcast tpgs :: TPageBBoxMapPDFBuf + -- tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf tpgs+ Left pg -> pg
lib/Application/HXournal/ModelAction/Pen.hs view
@@ -23,14 +23,14 @@ import Data.Xournal.Map -addPDraw :: PenInfo -> TXournalBBoxMapPDF -> Int -> Seq (Double,Double) - -> (TXournalBBoxMapPDF,BBox)-addPDraw pinfo xoj pgnum pdraw = +addPDraw :: PenInfo -> TXournalBBoxMapPDFBuf -> Int -> Seq (Double,Double) + -> IO (TXournalBBoxMapPDFBuf,BBox)+addPDraw pinfo xoj pgnum pdraw = do let pcolor = get penColor pinfo pcolname = fromJust (M.lookup pcolor penColorNameMap) pwidth = get penWidth pinfo- currpage = getPageFromXojBBoxMapPDF pgnum xoj- currlayer = case IM.lookup 0 (glayers currpage) of+ currpage = getPageFromGXournalMap pgnum xoj+ currlayer = case IM.lookup 0 (get g_layers currpage) of Nothing -> error "something wrong in addPDraw" Just l -> l newstroke = Stroke { stroke_tool = "pen" @@ -39,10 +39,14 @@ , stroke_data = map (uncurry (:!:)) . toList $ pdraw } newstrokebbox = mkStrokeBBoxFromStroke newstroke- newlayerbbox = set g_strokes (get g_strokes currlayer ++ [newstrokebbox]) currlayer- newpagebbox = set g_layers (IM.adjust (const newlayerbbox) 0 (get g_layers currpage)) currpage + bbox = strokebbox_bbox newstrokebbox+ + newlayerbbox <- updateLayerBuf (Just bbox)+ . set g_bstrokes (get g_bstrokes currlayer ++ [newstrokebbox]) + $ currlayer+ let newpagebbox = set g_layers (IM.adjust (const newlayerbbox) 0 (get g_layers currpage)) currpage newxojbbox = set g_pages (IM.adjust (const newpagebbox) pgnum (get g_pages xoj) ) xoj - in (newxojbbox,strokebbox_bbox newstrokebbox)+ return (newxojbbox,strokebbox_bbox newstrokebbox)
lib/Application/HXournal/ModelAction/Select.hs view
@@ -1,6 +1,8 @@ module Application.HXournal.ModelAction.Select where import Application.HXournal.Type.Enum+import Application.HXournal.Type.Canvas+import Application.HXournal.Draw import Data.Xournal.Simple import Data.Xournal.Generic@@ -19,6 +21,19 @@ import Data.Label import Prelude hiding ((.),id) + +isBBoxDeltaSmallerThan :: Double ->CanvasPageGeometry -> ZoomMode + -> BBox -> BBox -> Bool +isBBoxDeltaSmallerThan delta cpg zmode + (BBox (x11,y11) (x12,y12)) (BBox (x21,y21) (x22,y22)) = + let (x11',y11') = pageToCanvasCoord cpg zmode (x11,y11)+ (x12',y12') = pageToCanvasCoord cpg zmode (x12,y12)+ (x21',y21') = pageToCanvasCoord cpg zmode (x21,y21)+ (x22',y22') = pageToCanvasCoord cpg zmode (x22,y22)+ in (x11'-x21' > (-delta) && x11'-x21' < delta) + && (y11'-y21' > (-delta) && y11'-y21' < delta) + && (x12'-x22' > (-delta) && x12'-x22' < delta)+ && (y11'-y21' > (-delta) && y12'-y22' < delta) changeStrokeByOffset :: (Double,Double) -> StrokeBBox -> StrokeBBox changeStrokeByOffset (offx,offy) (StrokeBBox t c w ds bbox) = @@ -28,25 +43,29 @@ newbbox = BBox (x1+offx,y1+offy) (x2+offx,y2+offy) in StrokeBBox t c w newds newbbox -changeSelectionByOffset :: TTempPageSelectPDF -> (Double,Double) -> TTempPageSelectPDF+changeSelectionByOffset :: TTempPageSelectPDFBuf -> (Double,Double) + -> TTempPageSelectPDFBuf changeSelectionByOffset tpage off = let ls = glayers tpage- activelayer = unTEitherAlterHitted . gstrokes . gselectedlayer $ ls+ slayer = gselectedlayerbuf ls+ buf = get g_buffer slayer + activelayer = unTEitherAlterHitted . get g_bstrokes $ slayer in case activelayer of Left _ -> tpage Right alist -> let alist' =fmapAL id (Hitted . map (changeStrokeByOffset off) . unHitted) alist - layer' = GLayer . TEitherAlterHitted . Right $ alist'- in tpage { glayers = ls { gselectedlayer = layer' }}+ layer' = GLayerBuf buf . TEitherAlterHitted . Right $ alist'+ in tpage { glayers = ls { gselectedlayerbuf = layer' }} -updateTempXournalSelect :: TTempXournalSelectPDF -> TTempPageSelectPDF -> Int - -> TTempXournalSelectPDF+updateTempXournalSelect :: TTempXournalSelectPDFBuf + -> TTempPageSelectPDFBuf+ -> Int + -> TTempXournalSelectPDFBuf updateTempXournalSelect txoj tpage pagenum = let pgs = gselectAll txoj - pgs' = M.adjust (const (tpageBBoxMapPDFFromTTempPageSelectPDF tpage))- pagenum pgs+ pgs' = M.adjust (const (gcast tpage)) pagenum pgs in set g_selectAll pgs' . set g_selectSelected (Just (pagenum,tpage)) $ txoj @@ -54,9 +73,9 @@ -hitInSelection :: TTempPageSelectPDF -> (Double,Double) -> Bool +hitInSelection :: TTempPageSelectPDFBuf -> (Double,Double) -> Bool hitInSelection tpage point = - let activelayer = unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage+ let activelayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . glayers $ tpage in case activelayer of Left _ -> False Right alist ->
lib/Application/HXournal/Type/Canvas.hs view
@@ -9,7 +9,6 @@ import Prelude hiding ((.), id) import Graphics.Xournal.Render.BBoxMapPDF import Data.Xournal.Map--- import Data.Xournal.Select import Graphics.UI.Gtk hiding (get,set) type CanvasId = Int @@ -38,7 +37,7 @@ , _scrolledWindow :: ScrolledWindow , _viewInfo :: ViewInfo , _currentPageNum :: Int- , _currentPage :: Either TPageBBoxMapPDF TTempPageSelectPDF + , _currentPage :: Either TPageBBoxMapPDFBuf TTempPageSelectPDFBuf , _horizAdjustment :: Adjustment , _vertAdjustment :: Adjustment }
+ lib/Application/HXournal/Type/Undo.hs view
@@ -0,0 +1,84 @@+module Application.HXournal.Type.Undo where++import Data.Sequence+import Control.Monad++type SeqZipper a = (a, (Seq a,Seq a))++data UndoTable a = UndoTable { undo_allowednum :: Int+ , undo_totalnum :: Int + , undo_zipper :: Maybe (SeqZipper a)+ }+ ++singletonSZ :: a -> SeqZipper a +singletonSZ x = (x, (empty,empty))++appendGoLast :: SeqZipper a -> a -> SeqZipper a+appendGoLast (y,(y1s,y2s)) x = (x, ((y1s |> y) >< y2s, empty))++chopFirst :: SeqZipper a -> Maybe (SeqZipper a)+chopFirst (y,(y1s,y2s)) = + case viewl y1s of+ EmptyL -> case viewl y2s of + EmptyL -> Nothing + z :< zs -> Just (z,(empty,zs))+ z :< zs -> Just (y,(zs,y2s))+ +moveLeft :: SeqZipper a -> Maybe (SeqZipper a)+moveLeft (x,(x1s,x2s)) = + case viewr x1s of+ EmptyR -> Nothing + zs :> z -> Just (z,(zs,x<|x2s))++moveRight :: SeqZipper a -> Maybe (SeqZipper a) +moveRight (x,(x1s,x2s)) = + case viewl x2s of + EmptyL -> Nothing+ z :< zs -> Just (z,(x1s|>x,zs)) +++current :: SeqZipper a -> a +current (x,(_,_)) = x++prev :: SeqZipper a -> Maybe a +prev = fmap current . moveLeft++next :: SeqZipper a -> Maybe a +next = fmap current . moveRight++ +emptyUndo :: Int -> UndoTable a+emptyUndo n | n > 0 = UndoTable n 0 Nothing+ | otherwise = error "undo table must be larger than 0" ++singletonUndo :: Int -> a -> UndoTable a +singletonUndo n e = addToUndo (emptyUndo n) e++addToUndo :: UndoTable a -> a -> UndoTable a +addToUndo utable e = + let tn = undo_totalnum utable + an = undo_allowednum utable + mzs = undo_zipper utable + in case mzs of + Nothing -> UndoTable an 1 . Just . singletonSZ $ e+ Just zs -> + if tn < an+ then UndoTable an (tn+1) . Just . appendGoLast zs $ e+ else UndoTable an an . chopFirst . appendGoLast zs $ e++getCurrentUndoItem :: UndoTable a -> Maybe a+getCurrentUndoItem = fmap current . undo_zipper++getPrevUndo :: UndoTable a -> Maybe (a, UndoTable a)+getPrevUndo t = do + newzs <- moveLeft =<< undo_zipper t + return (current newzs, t {undo_zipper = Just newzs})+ +getNextUndo :: UndoTable a -> Maybe (a, UndoTable a)+getNextUndo t = do + newzs <- moveRight =<< undo_zipper t + return (current newzs, t {undo_zipper = Just newzs})++numOfUndo :: UndoTable a -> Int +numOfUndo = undo_totalnum
lib/Application/HXournal/Type/XournalState.hs view
@@ -8,12 +8,12 @@ import Application.HXournal.Type.Canvas import Application.HXournal.Type.Clipboard import Application.HXournal.Type.Window ---- import Graphics.Xournal.Render.Select+import Application.HXournal.Type.Undo import Data.Xournal.Map import Graphics.Xournal.Render.BBoxMapPDF +import Control.Category import Control.Monad.State import Data.Xournal.Simple import Data.Xournal.Predefined @@ -24,26 +24,28 @@ type XournalStateIO = StateT HXournalState IO -data XournalState = ViewAppendState { unView :: TXournalBBoxMapPDF }- | SelectState { tempSelect :: TTempXournalSelectPDF }+data XournalState = ViewAppendState { unView :: TXournalBBoxMapPDFBuf }+ | SelectState { tempSelect :: TTempXournalSelectPDFBuf } -data HXournalState = HXournalState { _xournalstate :: XournalState- , _currFileName :: Maybe FilePath- , _canvasInfoMap :: CanvasInfoMap - , _currentCanvas :: Int- , _frameState :: WindowConfig - , _rootWindow :: Widget- , _rootContainer :: Box- , _rootOfRootWindow :: Window- , _currentPenDraw :: PenDraw- , _clipboard :: Clipboard- , _callBack :: MyEvent -> IO ()- , _deviceList :: DeviceList- , _penInfo :: PenInfo- , _selectInfo :: SelectInfo - , _gtkUIManager :: UIManager - , _isSaved :: Bool - } +data HXournalState = + HXournalState { _xournalstate :: XournalState+ , _currFileName :: Maybe FilePath+ , _canvasInfoMap :: CanvasInfoMap + , _currentCanvas :: Int+ , _frameState :: WindowConfig + , _rootWindow :: Widget+ , _rootContainer :: Box+ , _rootOfRootWindow :: Window+ , _currentPenDraw :: PenDraw+ , _clipboard :: Clipboard+ , _callBack :: MyEvent -> IO ()+ , _deviceList :: DeviceList+ , _penInfo :: PenInfo+ , _selectInfo :: SelectInfo + , _gtkUIManager :: UIManager + , _isSaved :: Bool + , _undoTable :: UndoTable XournalState+ } $(mkLabels [''HXournalState]) @@ -51,8 +53,7 @@ emptyHXournalState :: HXournalState emptyHXournalState = HXournalState - { _xournalstate = ViewAppendState emptyTXournalBBoxMapPDF- -- (mkXournalBBoxMapFromXournal emptyXournal)+ { _xournalstate = ViewAppendState emptyGXournalMap , _currFileName = Nothing , _canvasInfoMap = error "emptyHXournalState.canvasInfoMap" , _currentCanvas = error "emtpyHxournalState.currentCanvas"@@ -68,6 +69,12 @@ , _selectInfo = SelectInfo SelectRectangleWork , _gtkUIManager = error "emptyHXournalState.gtkUIManager" , _isSaved = False + , _undoTable = emptyUndo 1 } - +resetXournalStateBuffers :: XournalState -> IO XournalState +resetXournalStateBuffers xojstate1 = + case xojstate1 of + ViewAppendState xoj -> liftIO . liftM ViewAppendState . resetXournalBuffers $ xoj+ _ -> return xojstate1+