hxournal 0.6 → 0.6.0
raw patch · 17 files changed
+145/−108 lines, 17 files
Files
- CHANGES +3/−0
- hxournal.cabal +2/−5
- lib/Application/HXournal/Coroutine/Default.hs +30/−12
- lib/Application/HXournal/Coroutine/Draw.hs +0/−3
- lib/Application/HXournal/Coroutine/Eraser.hs +4/−2
- lib/Application/HXournal/Coroutine/File.hs +26/−8
- lib/Application/HXournal/Coroutine/Page.hs +28/−31
- lib/Application/HXournal/Coroutine/Pen.hs +3/−1
- lib/Application/HXournal/Coroutine/Select.hs +28/−18
- lib/Application/HXournal/Coroutine/Window.hs +0/−2
- lib/Application/HXournal/GUI.hs +5/−1
- lib/Application/HXournal/ModelAction/Common.hs +11/−0
- lib/Application/HXournal/ModelAction/File.hs +0/−23
- lib/Application/HXournal/ModelAction/Page.hs +1/−0
- lib/Application/HXournal/ModelAction/Select.hs +1/−1
- lib/Application/HXournal/ModelAction/Window.hs +1/−1
- lib/Application/HXournal/Type/XournalState.hs +2/−0
CHANGES view
@@ -8,4 +8,7 @@ 0.6: 18 Dec 2011 * pdf background support. Annotate PDF menu is activated. preloading pdf background images +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. +
hxournal.cabal view
@@ -1,5 +1,5 @@ Name: hxournal-Version: 0.6+Version: 0.6.0 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal@@ -57,8 +57,6 @@ configurator == 0.1.*, poppler == 0.12.* - -- >= 0.1 && < 0.3- -- blaze-builder == 0.3.*, Exposed-Modules: Application.HXournal.ProgType Application.HXournal.Job@@ -78,6 +76,7 @@ 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@@ -100,8 +99,6 @@ Application.HXournal.Device Application.HXournal.Accessor Application.HXournal.Config-- -- Application.HXournal.Builder Other-Modules:
lib/Application/HXournal/Coroutine/Default.hs view
@@ -162,12 +162,13 @@ lift . St.put $ xstate' invalidate cid defaultEventProcess (VScrollBarStart cid _v) = vscrollStart cid -defaultEventProcess (CanvasConfigure cid w' h') = do - xstate <- getSt- let cinfoMap = get canvasInfoMap xstate- case M.lookup cid cinfoMap of - Nothing -> return () - Just cvsInfo -> do +defaultEventProcess (CanvasConfigure cid w' h') = canvasZoomUpdate Nothing cid +-- xstate <- getSt+-- let cinfoMap = get canvasInfoMap xstate+++{- + let canvas = get drawArea cvsInfo let page = getPage cvsInfo (w,h) = get (pageDimension.viewInfo) cvsInfo@@ -177,15 +178,32 @@ (hadj,vadj) = get adjustments cvsInfo liftIO $ setAdjustments (hadj,vadj) (w,h) (0,0) (0,0) (w'/factor,h'/factor)- invalidate cid+ -- invalidate cid -} defaultEventProcess ToViewAppendMode = modeChange ToViewAppendMode defaultEventProcess ToSelectMode = modeChange ToSelectMode defaultEventProcess _ = return () -+askQuitProgram :: Iteratee MyEvent XournalStateIO () +askQuitProgram = do + dialog <- liftIO $ messageDialogNew Nothing [DialogModal] + MessageQuestion ButtonsOkCancel + "Current canvas is not saved yet. Will you close hxournal?" + res <- liftIO $ dialogRun dialog+ case res of+ ResponseOk -> do + liftIO $ widgetDestroy dialog+ liftIO $ mainQuit+ _ -> do + liftIO $ widgetDestroy dialog+ return () menuEventProcess :: MenuEvent -> Iteratee MyEvent XournalStateIO ()-menuEventProcess MenuQuit = liftIO $ mainQuit+menuEventProcess MenuQuit = do + xstate <- getSt+ liftIO $ putStrLn "MenuQuit called"+ if get isSaved xstate + then liftIO $ mainQuit+ else askQuitProgram menuEventProcess MenuPreviousPage = changePage (\x->x-1) menuEventProcess MenuNextPage = changePage (+1) menuEventProcess MenuFirstPage = changePage (const 0)@@ -195,9 +213,9 @@ ViewAppendState xoj -> M.size . get g_pages $ xoj SelectState txoj -> M.size . gselectAll $ txoj changePage (const (totalnumofpages-1))-menuEventProcess MenuNew = fileNew -menuEventProcess MenuAnnotatePDF = fileAnnotatePDF-menuEventProcess MenuOpen = fileOpen+menuEventProcess MenuNew = askIfSave fileNew +menuEventProcess MenuAnnotatePDF = askIfSave fileAnnotatePDF+menuEventProcess MenuOpen = askIfSave fileOpen menuEventProcess MenuSave = fileSave menuEventProcess MenuSaveAs = fileSaveAs menuEventProcess MenuCut = cutSelection
lib/Application/HXournal/Coroutine/Draw.hs view
@@ -78,9 +78,6 @@ keys = M.keys cinfoMap invalidateGen (filter (/=currCvsId) keys) Nothing drawPageInBBox --- invalidate :: CanvasId -> Iteratee MyEvent XournalStateIO () --- invalidate cid = invalidateGenSingle cid Nothing drawPageInBBox - invalidate :: CanvasId -> Iteratee MyEvent XournalStateIO () invalidate cid = invalidateSelSingle cid Nothing drawPageInBBox drawSelectionInBBox
lib/Application/HXournal/Coroutine/Eraser.hs view
@@ -10,6 +10,7 @@ import Application.HXournal.Coroutine.EventConnect import Application.HXournal.Coroutine.Draw import Application.HXournal.Accessor+import Application.HXournal.ModelAction.Common import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Eraser import Data.Xournal.Simple@@ -71,9 +72,10 @@ newpagebbox = currpage { glayers = IM.adjust (const newlayerbbox) 0 (glayers currpage) } newxojbbox = currxoj { gpages= IM.adjust (const newpagebbox) pgnum (gpages currxoj) } newxojstate = ViewAppendState newxojbbox- xstate' = set xournalstate newxojstate + xstate' = commitChange+ . set xournalstate newxojstate . updatePageAll newxojstate $ xstate - lift $ St.put xstate' + putSt xstate' case maybebbox of Just bbox -> invalidateDrawBBox cid bbox Nothing -> return ()
lib/Application/HXournal/Coroutine/File.hs view
@@ -4,6 +4,7 @@ import Application.HXournal.Type.Coroutine import Application.HXournal.Type.XournalState import Application.HXournal.Accessor+import Application.HXournal.ModelAction.Common import Application.HXournal.ModelAction.File import Application.HXournal.Coroutine.Draw import Application.HXournal.ModelAction.Window@@ -21,16 +22,32 @@ import Data.Xournal.Simple import Data.Xournal.Map +askIfSave :: Iteratee MyEvent XournalStateIO ()+ -> Iteratee MyEvent XournalStateIO ()+askIfSave action = do + xstate <- getSt + if not (get isSaved xstate)+ then do + dialog <- liftIO $ messageDialogNew Nothing [DialogModal] + MessageQuestion ButtonsOkCancel + "Current canvas is not saved yet. Will you proceed without save?" + res <- liftIO $ dialogRun dialog+ case res of+ ResponseOk -> do liftIO $ widgetDestroy dialog+ action+ _ -> do liftIO $ widgetDestroy dialog+ return () + else action fileNew :: Iteratee MyEvent XournalStateIO ()-fileNew = do - liftIO $ putStrLn "fileNew called"- xstate <- getSt +fileNew = do + xstate <- getSt xstate' <- liftIO $ getFileContent Nothing xstate - putSt xstate' + putSt . commitChange $ xstate' liftIO $ setTitleFromFileName xstate' invalidateAll + fileSave :: Iteratee MyEvent XournalStateIO () fileSave = do xstate <- getSt @@ -42,6 +59,7 @@ ViewAppendState xojmap -> Xournal <$> get g_title <*> gToList . fmap (toPage gToBackground) . get g_pages $ xojmap SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPage gToBackground) . gselectAll $ txoj liftIO . L.writeFile filename . builder $ xoj+ putSt . set isSaved True $ xstate fileOpen :: Iteratee MyEvent XournalStateIO () fileOpen = do @@ -61,7 +79,8 @@ liftIO $ putStrLn $ show filename xstate <- getSt xstateNew <- liftIO $ getFileContent (Just filename) xstate- putSt xstateNew + putSt . set isSaved True + $ xstateNew liftIO $ setTitleFromFileName xstateNew invalidateAll liftIO $ widgetDestroy dialog@@ -77,7 +96,6 @@ [ ("OK", ResponseOk) , ("Cancel", ResponseCancel) ] res <- liftIO $ dialogRun dialog- -- liftIO $ putStrLn $ show response case res of ResponseDeleteEvent -> liftIO $ widgetDestroy dialog ResponseOk -> do@@ -96,7 +114,7 @@ $ xojmap SelectState txoj -> Xournal <$> gselectTitle <*> gToList . fmap (toPage gToBackground) . gselectAll $ txoj liftIO . L.writeFile filename . builder $ xoj- putSt xstateNew + putSt . set isSaved True $ xstateNew liftIO $ setTitleFromFileName xstateNew liftIO $ widgetDestroy dialog ResponseCancel -> liftIO $ widgetDestroy dialog@@ -126,7 +144,7 @@ flip (maybe (return ())) mxoj $ \xoj -> do xstateNew <- return . set currFileName Nothing =<< (liftIO $ constructNewHXournalStateFromXournal xoj xstate)- putSt xstateNew + putSt . commitChange $ xstateNew liftIO $ setTitleFromFileName xstateNew invalidateAll liftIO $ widgetDestroy dialog
lib/Application/HXournal/Coroutine/Page.hs view
@@ -25,7 +25,6 @@ changePage modifyfn = do xstate <- getSt let currCvsId = get currentCanvas xstate- -- cinfoMap = get canvasInfoMap xstate currCvsInfo = getCanvasInfo currCvsId xstate let xojst = get xournalstate $ xstate case xojst of @@ -39,11 +38,7 @@ (xstate',xoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) then do - let npage = -- mkPageBBoxMapFromPageBBox - -- . mkPageBBoxFromPage- -- . newPageFromOld - -- . pageFromPageBBoxMap $ lpage- lpage { glayers = IM.insert 0 (GLayer []) IM.empty } + let npage = lpage { glayers = IM.insert 0 (GLayer []) IM.empty } npages = IM.insert totalnumofpages npage pgs newxoj = xoj { gpages = npages } xstate' = set xournalstate (ViewAppendState newxoj) xstate@@ -75,12 +70,7 @@ (xstate',txoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) then do - let npage = -- mkPageBBoxMapFromPageBBox - -- . mkPageBBoxFromPage- -- . newPageFromOld - -- . pageFromPageBBoxMap $ lpage- lpage { glayers = IM.insert 0 (GLayer []) IM.empty } - + let npage = lpage { glayers = IM.insert 0 (GLayer []) IM.empty } npages = IM.insert totalnumofpages npage pgs newtxoj = txoj { gselectAll = npages } xstate' = set xournalstate (SelectState newtxoj) xstate@@ -103,27 +93,34 @@ lift . St.put $ xstate'' invalidate currCvsId +canvasZoomUpdate :: Maybe ZoomMode -> CanvasId -> Iteratee MyEvent XournalStateIO ()+canvasZoomUpdate mzmode cid = do + xstate <- getSt + let cinfoMap = get canvasInfoMap xstate+ case IM.lookup cid cinfoMap of + Nothing -> do+ liftIO $ putStrLn $ "canvasZoomUpdate : no cid = " ++ show cid + return () + Just cvsInfo -> do + let zmode = maybe (get (zoomMode.viewInfo) cvsInfo) id mzmode+ let canvas = get drawArea cvsInfo+ let page = getPage cvsInfo + let Dim w h = gdimension page+ cpg <- liftIO (getCanvasPageGeometry canvas page (0,0)) + let (w',h') = canvas_size cpg + let (hadj,vadj) = get adjustments cvsInfo + s = 1.0 / getRatioFromPageToCanvas cpg zmode+ liftIO $ setAdjustments (hadj,vadj) (w,h) (0,0) (0,0) (w'*s,h'*s)+ let cvsInfo' = set (zoomMode.viewInfo) zmode+ . set (viewPortOrigin.viewInfo) (0,0)+ $ cvsInfo + xstate' = updateCanvasInfo cvsInfo' xstate+ putSt xstate' + invalidate cid + pageZoomChange :: ZoomMode -> Iteratee MyEvent XournalStateIO () pageZoomChange zmode = do xstate <- getSt let currCvsId = get currentCanvas xstate- cinfoMap = get canvasInfoMap xstate- currCvsInfo = case IM.lookup currCvsId cinfoMap of - Nothing -> error " no such cvsinfo in pageZoomChange" - Just cinfo -> cinfo - let canvas = get drawArea currCvsInfo- let page = getPage currCvsInfo - let Dim w h = gdimension page- cpg <- liftIO (getCanvasPageGeometry canvas page (0,0)) - let (w',h') = canvas_size cpg - let (hadj,vadj) = get adjustments currCvsInfo - s = 1.0 / getRatioFromPageToCanvas cpg zmode- liftIO $ setAdjustments (hadj,vadj) (w,h) (0,0) (0,0) (w'*s,h'*s)- let currCvsInfo' = set (zoomMode.viewInfo) zmode- . set (viewPortOrigin.viewInfo) (0,0)- $ currCvsInfo - xstate' = updateCanvasInfo currCvsInfo' xstate- putSt xstate' - invalidate currCvsId -+ canvasZoomUpdate (Just zmode) currCvsId
lib/Application/HXournal/Coroutine/Pen.hs view
@@ -10,6 +10,7 @@ import Application.HXournal.Coroutine.Draw import Application.HXournal.Coroutine.EventConnect import Application.HXournal.Accessor+import Application.HXournal.ModelAction.Common import Application.HXournal.ModelAction.Pen import Application.HXournal.ModelAction.Page import Application.HXournal.Draw@@ -42,7 +43,8 @@ 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) - xstate' = set xournalstate (ViewAppendState newxoj) + xstate' = commitChange+ . set xournalstate (ViewAppendState newxoj) . updatePageAll (ViewAppendState newxoj) $ xstate putSt xstate'
lib/Application/HXournal/Coroutine/Select.hs view
@@ -13,6 +13,7 @@ import Application.HXournal.Coroutine.EventConnect import Application.HXournal.Coroutine.Draw import Application.HXournal.Coroutine.Mode+import Application.HXournal.ModelAction.Common import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Select import Control.Monad.Trans@@ -28,6 +29,8 @@ import Graphics.Xournal.Render.HitTest import Graphics.Xournal.Render.BBox ++ import Data.Maybe -- | main mouse pointer click entrance in rectangular selection mode. @@ -103,10 +106,8 @@ cpn = get currentPageNum cinfo let bbox = BBox orig (x,y)- -- prevbbox = BBox orig prev hittestbbox = mkHitTestInsideBBox bbox strs selectstrs = fmapAL unNotHitted id hittestbbox- xstate <- getSt let SelectState txoj = get xournalstate xstate newlayer = GLayer (TEitherAlterHitted (Right selectstrs))@@ -139,7 +140,6 @@ -> Iteratee MyEvent XournalStateIO () moveSelectRectangle cinfo geometry zmode connidmove connidup orig@(x0,y0) _prev = do xstate <- getSt- -- let cid = get canvasId cinfo r <- await case r of PenMove _cid' pcoord -> do @@ -155,9 +155,10 @@ Right tpage -> do let newtpage = changeSelectionByOffset tpage offset newtxoj = updateTempXournalSelect txoj newtpage pagenum - putSt (set xournalstate (SelectState newtxoj)+ putSt . commitChange+ . set xournalstate (SelectState newtxoj) . updatePageAll (SelectState newtxoj) - $ xstate )+ $ xstate Left _ -> error "this is impossible, in moveSelectRectangle" disconnect connidmove disconnect connidup @@ -168,8 +169,7 @@ deleteSelection = do liftIO $ putStrLn "delete selection is called" xstate <- getSt- let -- cinfo = getCurrentCanvasInfo xstate - SelectState txoj = get xournalstate xstate + let SelectState txoj = get xournalstate xstate Just (n,tpage) = gselectSelected txoj case unTEitherAlterHitted . gstrokes . gselectedlayer . glayers $ tpage of Left _ -> liftIO $ putStrLn "no stroke selection 2 "@@ -178,10 +178,13 @@ oldlayers = glayers tpage newpage = tpage { glayers = oldlayers { gselectedlayer = GLayer (TEitherAlterHitted newlayer) } } newtxoj = updateTempXournalSelect txoj newpage n - newxstate = set xournalstate (SelectState newtxoj) xstate- newxstate' = updatePageAll (SelectState newtxoj) newxstate - putSt newxstate' - let ui = get gtkUIManager newxstate'+ -- newxstate = xstate+ newxstate = commitChange+ . updatePageAll (SelectState newtxoj) + . set xournalstate (SelectState newtxoj)+ $ xstate + putSt newxstate + let ui = get gtkUIManager newxstate liftIO $ toggleCutCopyDelete ui False invalidateAll @@ -238,7 +241,8 @@ :- Empty ) tpage' = tpage { glayers = ls { gselectedlayer = newlayerselect } } txoj' = updateTempXournalSelect txoj tpage' pagenum - xstate' = updatePageAll (SelectState txoj') + xstate' = commitChange+ . updatePageAll (SelectState txoj') . set xournalstate (SelectState txoj') $ xstate putSt xstate' @@ -261,9 +265,12 @@ ls = glayers tpage newpage = tpage { glayers = ls { gselectedlayer = GLayer (TEitherAlterHitted newlayer) }} newtxoj = updateTempXournalSelect txoj newpage n- newxstate = set xournalstate (SelectState newtxoj) xstate- newxstate' = updatePageAll (SelectState newtxoj) newxstate - putSt newxstate' + -- newxstate = + newxstate = commitChange+ . updatePageAll (SelectState newtxoj) + . set xournalstate (SelectState newtxoj) + $ xstate + putSt newxstate invalidateAll selectPenWidthChanged :: Double -> Iteratee MyEvent XournalStateIO () @@ -281,8 +288,11 @@ ls = glayers tpage newpage = tpage { glayers = ls { gselectedlayer = GLayer (TEitherAlterHitted newlayer) }} newtxoj = updateTempXournalSelect txoj newpage n - newxstate = set xournalstate (SelectState newtxoj) xstate- newxstate' = updatePageAll (SelectState newtxoj) newxstate - putSt newxstate' + -- newxstate = xstate+ newxstate = commitChange+ . updatePageAll (SelectState newtxoj) + . set xournalstate (SelectState newtxoj)+ $ xstate + putSt newxstate invalidateAll
lib/Application/HXournal/Coroutine/Window.hs view
@@ -21,7 +21,6 @@ currcid = get currentCanvas xstate newcid = newCanvasId cmap fstate = get frameState xstate- -- xojstate = get xournalstate xstate enewfstate = splitWindow currcid (newcid,stype) fstate case enewfstate of Left _ -> return ()@@ -60,7 +59,6 @@ let cmap = get canvasInfoMap xstate currcid = get currentCanvas xstate fstate = get frameState xstate- -- xojstate = get xournalstate xstate enewfstate = removeWindow currcid fstate case enewfstate of Left _ -> return ()
lib/Application/HXournal/GUI.hs view
@@ -20,6 +20,7 @@ import Graphics.UI.Gtk hiding (get,set) import Control.Applicative +import Control.Monad.Trans import Data.IORef @@ -89,7 +90,10 @@ boxPackStart vbox toolbar2 PackNatural 0 boxPackEnd vbox winCvsArea PackGrow 0 -- cursorDot <- cursorNew BlankCursor - onDestroy window mainQuit+ window `on` deleteEvent $ do+ liftIO $ bouncecallback tref sref (Menu MenuQuit)+ return True+ -- mainQuit widgetShowAll window -- initialized
+ lib/Application/HXournal/ModelAction/Common.hs view
@@ -0,0 +1,11 @@+module Application.HXournal.ModelAction.Common where++import Application.HXournal.Type.XournalState++import Control.Category+import Data.Label +import Prelude hiding ((.),id)++commitChange :: HXournalState -> HXournalState+commitChange old = set isSaved False old +
lib/Application/HXournal/ModelAction/File.hs view
@@ -97,26 +97,3 @@ in Page dim bkg [emptyLayer] -{- let currcid = get currentCanvas xstate - cmap = get canvasInfoMap xstate - xoj <- mkTXournalBBoxMapPDF xojcontent - let Dim width height = case M.lookup 0 (gpages xoj) of - Nothing -> error "no first page in getFileContent" - Just p -> gdimension p - startingxojstate = ViewAppendState xoj- -- cids = M.keys cmap - -- update x _cinfo = - let changefunc c = - setPage startingxojstate 0 - . set viewInfo (ViewInfo OnePage Original (0,0) (width,height))- . set currentPageNum 0 - $ c - -- in M.adjust changefunc x cmap - cmap' = fmap changefunc cmap- -- foldr update cmap cids - let newxstate = set xournalstate startingxojstate- . set currFileName (Just fname)- . set canvasInfoMap cmap'- . set currentCanvas currcid - $ xstate - return newxstate -}
lib/Application/HXournal/ModelAction/Page.hs view
@@ -89,3 +89,4 @@ -- pageBBoxMapFromTempPageSelect tpgs Left pg -> pg +
lib/Application/HXournal/ModelAction/Select.hs view
@@ -51,7 +51,7 @@ . set g_selectSelected (Just (pagenum,tpage)) $ txoj --- GSelect { gselectAll = pgs', gselectSelected = Just (pagenum,tpage) } + hitInSelection :: TTempPageSelectPDF -> (Double,Double) -> Bool
lib/Application/HXournal/ModelAction/Window.hs view
@@ -39,7 +39,7 @@ vadj <- adjustmentNew 0 0 500 100 200 200 scrolledWindowSetHAdjustment scrwin hadj scrolledWindowSetVAdjustment scrwin vadj - scrolledWindowSetPolicy scrwin PolicyAutomatic PolicyAutomatic + -- scrolledWindowSetPolicy scrwin PolicyAutomatic PolicyAutomatic canvas `on` sizeRequest $ return (Requisition 480 400) canvas `on` buttonPressEvent $ tryEvent $ do
lib/Application/HXournal/Type/XournalState.hs view
@@ -42,6 +42,7 @@ , _penInfo :: PenInfo , _selectInfo :: SelectInfo , _gtkUIManager :: UIManager + , _isSaved :: Bool } @@ -66,6 +67,7 @@ , _penInfo = PenInfo PenWork predefined_medium ColorBlack , _selectInfo = SelectInfo SelectRectangleWork , _gtkUIManager = error "emptyHXournalState.gtkUIManager"+ , _isSaved = False }