hxournal 0.6.1.0 → 0.6.2
raw patch · 31 files changed
+557/−171 lines, 31 filesdep +TypeComposedep +timedep ~configuratordep ~xournal-parserdep ~xournal-render
Dependencies added: TypeCompose, time
Dependency ranges changed: configurator, xournal-parser, xournal-render, xournal-types
Files
- CHANGES +3/−0
- LICENSE +1/−1
- hxournal.cabal +36/−12
- lib/Application/HXournal/Accessor.hs +27/−8
- lib/Application/HXournal/Config.hs +9/−1
- lib/Application/HXournal/Coroutine/Commit.hs +4/−4
- lib/Application/HXournal/Coroutine/Default.hs +19/−28
- lib/Application/HXournal/Coroutine/Draw.hs +9/−9
- lib/Application/HXournal/Coroutine/Eraser.hs +20/−15
- lib/Application/HXournal/Coroutine/EventConnect.hs +5/−5
- lib/Application/HXournal/Coroutine/File.hs +6/−7
- lib/Application/HXournal/Coroutine/Highlighter.hs +1/−1
- lib/Application/HXournal/Coroutine/Layer.hs +142/−0
- lib/Application/HXournal/Coroutine/Mode.hs +1/−1
- lib/Application/HXournal/Coroutine/Page.hs +31/−6
- lib/Application/HXournal/Coroutine/Pen.hs +16/−2
- lib/Application/HXournal/Coroutine/Scroll.hs +2/−2
- lib/Application/HXournal/Coroutine/Select.hs +23/−24
- lib/Application/HXournal/Coroutine/Window.hs +2/−2
- lib/Application/HXournal/Draw.hs +4/−2
- lib/Application/HXournal/GUI.hs +5/−1
- lib/Application/HXournal/GUI/Menu.hs +19/−11
- lib/Application/HXournal/ModelAction/Layer.hs +62/−0
- lib/Application/HXournal/ModelAction/Page.hs +41/−7
- lib/Application/HXournal/ModelAction/Pen.hs +15/−9
- lib/Application/HXournal/Type/Clipboard.hs +1/−8
- lib/Application/HXournal/Type/Coroutine.hs +1/−0
- lib/Application/HXournal/Type/Event.hs +5/−0
- lib/Application/HXournal/Type/Undo.hs +7/−5
- lib/Application/HXournal/Type/XournalState.hs +4/−0
- lib/Application/HXournal/Util.hs +36/−0
CHANGES view
@@ -13,3 +13,6 @@ 0.6.1: 25 Dec 2011 * undo/redo support, double buffer rendering while scrolling++0.6.2: 15 Jan 2012+ * layer support
LICENSE view
@@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2011, Ian-Woo Kim. All rights reserved.+Copyright 2011, 2012, Ian-Woo Kim. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
hxournal.cabal view
@@ -1,5 +1,5 @@ Name: hxournal-Version: 0.6.1.0+Version: 0.6.2 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal@@ -26,7 +26,7 @@ Executable hxournal Main-is: hxournal.hs hs-source-dirs: exe- ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-options: -Wall -threaded -funbox-strict-fields -fno-warn-unused-do-bind ghc-prof-options: -caf-all -auto-all Build-Depends: base>4, @@ -35,7 +35,7 @@ Library hs-source-dirs: lib- ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind ghc-prof-options: -caf-all -auto-all if flag(poppler) @@ -48,9 +48,9 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types == 0.2.*,- xournal-parser == 0.3.*,- xournal-render >= 0.4.0.0 && < 0.5,+ xournal-types == 0.3.*,+ xournal-parser >= 0.3.0.1 && < 0.4,+ xournal-render == 0.5.*, xournal-builder == 0.1.*, containers == 0.4.*, template-haskell == 2.*,@@ -58,8 +58,18 @@ double-conversion == 0.2.*, fclabels == 1.0.*, cmdargs >= 0.7 && <= 0.10,- configurator == 0.1.*, - poppler == 0.12.*+ configurator == 0.2.*,+ poppler == 0.12.*, + time == 1.2.*, + TypeCompose == 0.9.*+ -- attoparsec == 0.10.*,+ -- uuid == 1.2.*, + -- hxournalclip-type == 0.0.*, + -- http-enumerator == 0.7.*, + -- http-types == 0.6.*, + -- aeson == 0.4.*, + -- hxournalclip-client == 0.0.*+ else Build-Depends: base == 4.*, mtl == 2.*,@@ -70,9 +80,9 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types == 0.2.*,- xournal-parser == 0.3.*,- xournal-render >= 0.4.0.0 && < 0.5,+ xournal-types == 0.3.*,+ xournal-parser >= 0.3.0.1 && < 0.4,+ xournal-render == 0.5, xournal-builder == 0.1.*, containers == 0.4.*, template-haskell == 2.*,@@ -80,8 +90,18 @@ double-conversion == 0.2.*, fclabels == 1.0.*, cmdargs >= 0.7 && <= 0.10,- configurator == 0.1.*+ configurator == 0.2.*, + time == 1.2.*, + TypeCompose == 0.9.*+ -- attoparsec == 0.10.*,+ -- uuid == 1.2.*, + -- http-enumerator == 0.7.*, + -- http-types == 0.6.*, + -- aeson == 0.4.*, + -- hxournalclip-type == 0.0.*,+ -- hxournalclip-client == 0.0.*, + Exposed-Modules: Application.HXournal.ProgType Application.HXournal.Job@@ -102,6 +122,8 @@ Application.HXournal.ModelAction.Select Application.HXournal.ModelAction.File Application.HXournal.ModelAction.Window+ -- Application.HXournal.ModelAction.Network+ Application.HXournal.ModelAction.Layer Application.HXournal.Coroutine.Callback Application.HXournal.GUI Application.HXournal.GUI.Menu@@ -119,6 +141,8 @@ Application.HXournal.Coroutine.Mode Application.HXournal.Coroutine.Window Application.HXournal.Coroutine.Commit+ -- Application.HXournal.Coroutine.Network+ Application.HXournal.Coroutine.Layer Application.HXournal.Util Application.HXournal.Util.Verbatim Application.HXournal.Draw
lib/Application/HXournal/Accessor.hs view
@@ -17,14 +17,21 @@ import Prelude hiding ((.),id) import Graphics.UI.Gtk hiding (get,set) +import Control.Compose+import Graphics.Xournal.Render.BBoxMapPDF import Data.Xournal.BBox- import Data.Xournal.Generic+import Data.Xournal.Buffer+import Data.Xournal.Select -getSt :: Iteratee MyEvent XournalStateIO HXournalState+import Application.HXournal.Util+import Application.HXournal.ModelAction.Layer +++getSt :: MainCoroutine HXournalState -- Iteratee MyEvent XournalStateIO HXournalState getSt = lift St.get -putSt :: HXournalState -> Iteratee MyEvent XournalStateIO ()+putSt :: HXournalState -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () putSt = lift . St.put @@ -35,7 +42,7 @@ getPenType :: Iteratee MyEvent XournalStateIO PenType getPenType = get (penType.penInfo) <$> lift (St.get) -getAllStrokeBBoxInCurrentPage :: Iteratee MyEvent XournalStateIO [StrokeBBox]+getAllStrokeBBoxInCurrentPage :: MainCoroutine [StrokeBBox] getAllStrokeBBoxInCurrentPage = do xstate <- getSt let currCvsInfo = getCurrentCanvasInfo xstate @@ -45,6 +52,15 @@ s <- get g_bstrokes l return s return strs ++getAllStrokeBBoxInCurrentLayer :: MainCoroutine [StrokeBBox] +getAllStrokeBBoxInCurrentLayer = do + xstate <- getSt + let currCvsInfo = getCurrentCanvasInfo xstate + let pagebbox = getPage currCvsInfo+ (mcurrlayer, currpage) = getCurrentLayerOrSet pagebbox+ currlayer = maybe (error "getAllStrokeBBoxInCurrentLayer") id mcurrlayer+ return (get g_bstrokes currlayer) updateCanvasInfo :: CanvasInfo -> HXournalState -> HXournalState@@ -58,7 +74,7 @@ otherCanvas :: HXournalState -> [Int] otherCanvas = M.keys . get canvasInfoMap -changeCurrentCanvasId :: CanvasId -> Iteratee MyEvent XournalStateIO HXournalState+changeCurrentCanvasId :: CanvasId -> MainCoroutine HXournalState -- Iteratee MyEvent XournalStateIO HXournalState changeCurrentCanvasId cid = do xstate1 <- getSt let xstate = set currentCanvas cid xstate1 putSt xstate@@ -68,17 +84,20 @@ getCanvasInfo cid xstate = let cinfoMap = get canvasInfoMap xstate maybeCvs = M.lookup cid cinfoMap- in case maybeCvs of + in maybeError ("no canvas with id = " ++ show cid) maybeCvs+{- in case maybeCvs of Nothing -> error $ "no canvas with id = " ++ show cid - Just cvsInfo -> cvsInfo+ Just cvsInfo -> cvsInfo -} getCurrentCanvasInfo :: HXournalState -> CanvasInfo getCurrentCanvasInfo xstate = getCanvasInfo (get currentCanvas xstate) xstate -getCanvasGeometry :: CanvasInfo -> Iteratee MyEvent XournalStateIO CanvasPageGeometry+getCanvasGeometry :: CanvasInfo -> MainCoroutine CanvasPageGeometry -- Iteratee MyEvent XournalStateIO CanvasPageGeometry getCanvasGeometry cinfo = do let canvas = get drawArea cinfo page = getPage cinfo (x0,y0) = get (viewPortOrigin.viewInfo) cinfo liftIO (getCanvasPageGeometry canvas page (x0,y0))++
lib/Application/HXournal/Config.hs view
@@ -9,6 +9,8 @@ import System.Directory import System.FilePath import Control.Concurrent +import Control.Applicative+-- import Application.HXournal.NetworkClipboard.Client.Config emptyConfigString :: String emptyConfigString = "\n#config file for hxournal \n " @@ -44,4 +46,10 @@ "false" -> return False _ -> error "cannot understand xinput in configfile" -+{-+getNetworkInfo :: Config -> IO (Maybe HXournalClipClientConfiguration)+getNetworkInfo c = do + (mserver :: Maybe String) <- C.lookup c "network.server"+ (mclient :: Maybe String) <- C.lookup c "network.client"+ return (HXournalClipClientConfiguration <$> mserver <*> mclient)+-}
lib/Application/HXournal/Coroutine/Commit.hs view
@@ -16,7 +16,7 @@ -commit :: HXournalState -> Iteratee MyEvent XournalStateIO ()+commit :: HXournalState -> MainCoroutine () commit xstate = do let ui = get gtkUIManager xstate liftIO $ toggleSave ui True@@ -28,7 +28,7 @@ $ xstate putSt xstate' -undo :: Iteratee MyEvent XournalStateIO ()+undo :: MainCoroutine () undo = do liftIO $ putStrLn "undo is called" xstate <- getSt@@ -41,12 +41,11 @@ . set undoTable newtable . updatePageAll xojstate $ xstate - -- commit xstate' putSt xstate' invalidateAll -redo :: Iteratee MyEvent XournalStateIO ()+redo :: MainCoroutine () redo = do liftIO $ putStrLn "redo is called" xstate <- getSt@@ -61,6 +60,7 @@ $ xstate putSt xstate' invalidateAll +
lib/Application/HXournal/Coroutine/Default.hs view
@@ -23,8 +23,8 @@ import Application.HXournal.Coroutine.File import Application.HXournal.Coroutine.Mode import Application.HXournal.Coroutine.Window--+-- import Application.HXournal.Coroutine.Network+import Application.HXournal.Coroutine.Layer import Application.HXournal.ModelAction.Window import Application.HXournal.Type.Window @@ -43,7 +43,7 @@ import Data.Xournal.Generic -guiProcess :: Iteratee MyEvent XournalStateIO () +guiProcess :: MainCoroutine () guiProcess = do initialize changePage (const 0)@@ -88,7 +88,7 @@ writeIORef sref startingXstate return (tref,sref) -initialize :: Iteratee MyEvent XournalStateIO ()+initialize :: MainCoroutine () initialize = do ev <- await liftIO $ putStrLn $ show ev case ev of @@ -96,14 +96,14 @@ _ -> initialize -dispatchMode :: Iteratee MyEvent XournalStateIO ()+dispatchMode :: MainCoroutine () dispatchMode = do xojstate <- return . get xournalstate =<< lift St.get case xojstate of ViewAppendState _ -> viewAppendMode SelectState _ -> selectMode -viewAppendMode :: Iteratee MyEvent XournalStateIO ()+viewAppendMode :: MainCoroutine () viewAppendMode = do r1 <- await case r1 of @@ -116,7 +116,7 @@ _ -> return () _ -> defaultEventProcess r1 -selectMode :: Iteratee MyEvent XournalStateIO ()+selectMode :: MainCoroutine () selectMode = do r1 <- await case r1 of @@ -131,7 +131,7 @@ -defaultEventProcess :: MyEvent -> Iteratee MyEvent XournalStateIO () +defaultEventProcess :: MyEvent -> MainCoroutine () defaultEventProcess (UpdateCanvas cid) = invalidate cid defaultEventProcess (Menu m) = menuEventProcess m defaultEventProcess (HScrollBarMoved cid v) = do @@ -164,27 +164,11 @@ invalidate cid defaultEventProcess (VScrollBarStart cid _v) = vscrollStart cid 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- zmode = get (zoomMode.viewInfo) cvsInfo- cpg <- liftIO (getCanvasPageGeometry canvas page (0,0))- let factor = getRatioFromPageToCanvas cpg zmode- (hadj,vadj) = get adjustments cvsInfo- liftIO $ setAdjustments (hadj,vadj) (w,h) (0,0) (0,0)- (w'/factor,h'/factor)- -- invalidate cid -} defaultEventProcess ToViewAppendMode = modeChange ToViewAppendMode defaultEventProcess ToSelectMode = modeChange ToSelectMode defaultEventProcess _ = return () -askQuitProgram :: Iteratee MyEvent XournalStateIO () +askQuitProgram :: MainCoroutine () askQuitProgram = do dialog <- liftIO $ messageDialogNew Nothing [DialogModal] MessageQuestion ButtonsOkCancel @@ -198,7 +182,7 @@ liftIO $ widgetDestroy dialog return () -menuEventProcess :: MenuEvent -> Iteratee MyEvent XournalStateIO ()+menuEventProcess :: MenuEvent -> MainCoroutine () menuEventProcess MenuQuit = do xstate <- getSt liftIO $ putStrLn "MenuQuit called"@@ -214,6 +198,7 @@ ViewAppendState xoj -> M.size . get g_pages $ xoj SelectState txoj -> M.size . gselectAll $ txoj changePage (const (totalnumofpages-1))+menuEventProcess MenuNewPageBefore = newPageBefore menuEventProcess MenuNew = askIfSave fileNew menuEventProcess MenuAnnotatePDF = askIfSave fileAnnotatePDF menuEventProcess MenuUndo = undo @@ -225,14 +210,21 @@ menuEventProcess MenuCopy = copySelection menuEventProcess MenuPaste = pasteToSelection menuEventProcess MenuDelete = deleteSelection+-- menuEventProcess MenuNetCopy = clipCopyToNetworkClipboard+-- menuEventProcess MenuNetPaste = clipPasteFromNetworkClipboard menuEventProcess MenuNormalSize = pageZoomChange Original menuEventProcess MenuPageWidth = pageZoomChange FitWidth menuEventProcess MenuPageHeight = pageZoomChange FitHeight menuEventProcess MenuHSplit = eitherSplit SplitHorizontal menuEventProcess MenuVSplit = eitherSplit SplitVertical menuEventProcess MenuDelCanvas = deleteCanvas+menuEventProcess MenuNewLayer = makeNewLayer +menuEventProcess MenuNextLayer = gotoNextLayer +menuEventProcess MenuPrevLayer = gotoPrevLayer+menuEventProcess MenuGotoLayer = startGotoLayerAt +menuEventProcess MenuDeleteLayer = deleteCurrentLayer+ menuEventProcess MenuUseXInput = do - -- putStrLn "Use X Input clicked" xstate <- getSt let ui = get gtkUIManager xstate agr <- liftIO ( uiManagerGetActionGroups ui >>= \x ->@@ -242,7 +234,6 @@ uxinputa <- liftIO (actionGroupGetAction agr "UXINPUTA" >>= \(Just x) -> return (castToToggleAction x) ) b <- liftIO $ toggleActionGetActive uxinputa- -- liftIO $ putStrLn $ "bool = " ++ show b let cmap = get canvasInfoMap xstate canvases = map (get drawArea) . M.elems $ cmap
lib/Application/HXournal/Coroutine/Draw.hs view
@@ -21,7 +21,7 @@ invalidateSelSingle :: CanvasId -> Maybe BBox -> PageDrawF -> PageDrawFSel - -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateSelSingle cid mbbox drawf drawfsel = do xstate <- lift St.get let maybeCvs = M.lookup cid (get canvasInfoMap xstate)@@ -41,7 +41,7 @@ $ cvsInfo ) invalidateGenSingle :: CanvasId -> Maybe BBox -> PageDrawF- -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateGenSingle cid mbbox drawf = do xstate <- lift St.get let maybeCvs = M.lookup cid (get canvasInfoMap xstate)@@ -58,14 +58,14 @@ $ cvsInfo ) -invalidateAll :: Iteratee MyEvent XournalStateIO ()+invalidateAll :: MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateAll = do xstate <- getSt let cinfoMap = get canvasInfoMap xstate keys = M.keys cinfoMap forM_ keys invalidate -invalidateOther :: Iteratee MyEvent XournalStateIO ()+invalidateOther :: MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateOther = do xstate <- getSt let currCvsId = get currentCanvas xstate@@ -76,29 +76,29 @@ -- | invalidate clear -invalidate :: CanvasId -> Iteratee MyEvent XournalStateIO () +invalidate :: CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidate cid = invalidateSelSingle cid Nothing drawPageClearly drawPageSelClearly -- | Drawing objects only in BBox -invalidateInBBox :: CanvasId -> BBox -> Iteratee MyEvent XournalStateIO ()+invalidateInBBox :: CanvasId -> BBox -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateInBBox cid bbox = invalidateSelSingle cid (Just bbox) drawPageInBBox drawSelectionInBBox -- | Drawing BBox -invalidateDrawBBox :: CanvasId -> BBox -> Iteratee MyEvent XournalStateIO () +invalidateDrawBBox :: CanvasId -> BBox -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateDrawBBox cid bbox = invalidateSelSingle cid (Just bbox) drawBBox drawBBoxSel -- | Drawing using layer buffer -invalidateWithBuf :: CanvasId -> Iteratee MyEvent XournalStateIO () +invalidateWithBuf :: CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateWithBuf = invalidateWithBufInBBox Nothing -- | Drawing using layer buffer in BBox -invalidateWithBufInBBox :: Maybe BBox -> CanvasId -> Iteratee MyEvent XournalStateIO () +invalidateWithBufInBBox :: Maybe BBox -> CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () invalidateWithBufInBBox mbbox cid = invalidateSelSingle cid mbbox drawBuf drawSelectionInBBox
lib/Application/HXournal/Coroutine/Eraser.hs view
@@ -13,6 +13,7 @@ import Application.HXournal.Accessor import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Eraser+import Application.HXournal.ModelAction.Layer import Data.Xournal.Generic @@ -28,9 +29,14 @@ import qualified Data.IntMap as IM import Prelude hiding ((.), id) +-- for test+import Control.Compose+import Data.Xournal.Select+import qualified Data.Sequence as Seq+ eraserStart :: CanvasId -> PointerCoord - -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () eraserStart cid pcoord = do xstate <- changeCurrentCanvasId cid let cvsInfo = getCanvasInfo cid xstate@@ -39,7 +45,7 @@ let (x,y) = device2pageCoord geometry zmode pcoord connidup <- connectPenUp cvsInfo connidmove <- connectPenMove cvsInfo - strs <- getAllStrokeBBoxInCurrentPage+ strs <- getAllStrokeBBoxInCurrentLayer eraserProcess cid geometry connidup connidmove strs (x,y) eraserProcess :: CanvasId@@ -47,7 +53,7 @@ -> ConnectId DrawingArea -> ConnectId DrawingArea -> [StrokeBBox] -> (Double,Double)- -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () eraserProcess cid cpg connidmove connidup strs (x0,y0) = do r <- await xstate <- getSt@@ -64,30 +70,29 @@ then do let currxoj = unView . get xournalstate $ xstate pgnum = get currentPageNum cvsInfo- currpage = getPage cvsInfo- currlayer = case IM.lookup 0 (glayers currpage) of- Nothing -> error "something wrong in eraserProcess"- Just l -> l- - (newstrokes,maybebbox1) = St.runState (eraseHitted hitteststroke) Nothing+ (mcurrlayer, currpage) = getCurrentLayerOrSet . getPage $ cvsInfo+ currlayer = maybe (error "eraserProcess") id mcurrlayer++ -- for test+ -- let Select (O (Just ll)) = get g_layers currpage+ -- SZ (_,(x1,x2)) = ll + -- liftIO$ print (Seq.length x1, Seq.length x2)++ let (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) } + let newpagebbox = adjustCurrentLayer newlayerbbox currpage newxojbbox = currxoj { gpages= IM.adjust (const newpagebbox) pgnum (gpages currxoj) } newxojstate = ViewAppendState newxojbbox commit . set xournalstate newxojstate . updatePageAll newxojstate $ xstate invalidateWithBufInBBox maybebbox cid - {- case maybebbox of - Just bbox -> -- invalidateWithBufInBBox m-- invalidateDrawBBox cid bbox- Nothing -> return () -}- newstrs <- getAllStrokeBBoxInCurrentPage+ newstrs <- getAllStrokeBBoxInCurrentLayer 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/EventConnect.hs view
@@ -16,16 +16,16 @@ import Prelude hiding ((.), id) disconnect :: (WidgetClass w) => ConnectId w - -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () disconnect = liftIO . signalDisconnect -connectPenUp :: CanvasInfo -> Iteratee MyEvent XournalStateIO (ConnectId DrawingArea)+connectPenUp :: CanvasInfo -> MainCoroutine (ConnectId DrawingArea) -- Iteratee MyEvent XournalStateIO (ConnectId DrawingArea) connectPenUp cinfo = do let cid = get canvasId cinfo canvas = get drawArea cinfo connPenUp canvas cid -connectPenMove :: CanvasInfo -> Iteratee MyEvent XournalStateIO (ConnectId DrawingArea)+connectPenMove :: CanvasInfo -> MainCoroutine (ConnectId DrawingArea) -- Iteratee MyEvent XournalStateIO (ConnectId DrawingArea) connectPenMove cinfo = do let cid = get canvasId cinfo canvas = get drawArea cinfo @@ -34,7 +34,7 @@ connPenMove :: (WidgetClass w) => w -> CanvasId - -> Iteratee MyEvent XournalStateIO (ConnectId w) + -> MainCoroutine (ConnectId w) -- Iteratee MyEvent XournalStateIO (ConnectId w) connPenMove c cid = do callbk <- get callBack <$> lift St.get dev <- get deviceList <$> lift St.get @@ -45,7 +45,7 @@ connPenUp :: (WidgetClass w) => w -> CanvasId- -> Iteratee MyEvent XournalStateIO (ConnectId w) + -> MainCoroutine (ConnectId w) -- Iteratee MyEvent XournalStateIO (ConnectId w) connPenUp c cid = do callbk <- get callBack <$> lift St.get dev <- get deviceList <$> lift St.get
lib/Application/HXournal/Coroutine/File.hs view
@@ -24,8 +24,7 @@ import System.Directory -askIfSave :: Iteratee MyEvent XournalStateIO ()- -> Iteratee MyEvent XournalStateIO ()+askIfSave :: MainCoroutine () -> MainCoroutine () askIfSave action = do xstate <- getSt if not (get isSaved xstate)@@ -41,7 +40,7 @@ return () else action -fileNew :: Iteratee MyEvent XournalStateIO ()+fileNew :: MainCoroutine () fileNew = do xstate <- getSt xstate' <- liftIO $ getFileContent Nothing xstate @@ -50,7 +49,7 @@ invalidateAll -fileSave :: Iteratee MyEvent XournalStateIO () +fileSave :: MainCoroutine () fileSave = do xstate <- getSt case get currFileName xstate of@@ -65,7 +64,7 @@ let ui = get gtkUIManager xstate liftIO $ toggleSave ui False -fileOpen :: Iteratee MyEvent XournalStateIO ()+fileOpen :: MainCoroutine () fileOpen = do liftIO $ putStrLn "file open clicked" cwd <- liftIO getCurrentDirectory@@ -94,7 +93,7 @@ _ -> error "??? in fileOpen " return () -fileSaveAs :: Iteratee MyEvent XournalStateIO ()+fileSaveAs :: MainCoroutine () fileSaveAs = do liftIO $ putStrLn "file save as clicked" cwd <- liftIO getCurrentDirectory@@ -133,7 +132,7 @@ -fileAnnotatePDF :: Iteratee MyEvent XournalStateIO ()+fileAnnotatePDF :: MainCoroutine () fileAnnotatePDF = do xstate <- getSt liftIO $ putStrLn "file annotate PDf clicked"
lib/Application/HXournal/Coroutine/Highlighter.hs view
@@ -6,7 +6,7 @@ import Application.HXournal.Type.XournalState import Control.Monad.Trans -highlighterStart :: PointerCoord -> Iteratee MyEvent XournalStateIO ()+highlighterStart :: PointerCoord -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () highlighterStart _pcoord = do liftIO $ putStrLn "highlighter started"
+ lib/Application/HXournal/Coroutine/Layer.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Application.HXournal.Coroutine.Layer where++import Application.HXournal.Type.Canvas+import Application.HXournal.Type.XournalState+import Application.HXournal.Type.Coroutine+import Application.HXournal.Accessor+import Application.HXournal.Util+import Application.HXournal.ModelAction.Layer+import Application.HXournal.ModelAction.Page+import Application.HXournal.Coroutine.Commit+import Control.Monad.Trans++import qualified Data.IntMap as M+import Data.Xournal.Generic+import Data.Xournal.Select+import Graphics.Xournal.Render.BBoxMapPDF+import Control.Compose+import Control.Category+import Data.Label+import Prelude hiding ((.),id)++import Data.Xournal.Simple++import Data.IORef++import qualified Data.Sequence as Seq+import Graphics.UI.Gtk hiding (get,set)++layerAction :: (XournalState -> Int -> TPageBBoxMapPDFBuf -> MainCoroutine XournalState) -> MainCoroutine HXournalState+layerAction action = do + xstate <- getSt+ let epage = get currentPage . getCurrentCanvasInfo $ xstate+ cpn = get currentPageNum . getCurrentCanvasInfo $ xstate+ xojstate = get xournalstate xstate+ newxojstate <- either (action xojstate cpn) (action xojstate cpn . gcast) epage + return . updatePageAll newxojstate + . set xournalstate newxojstate + $ xstate++makeNewLayer :: MainCoroutine () +makeNewLayer = layerAction newlayeraction >>= commit + where newlayeraction xojstate cpn page = do + let (_,currpage) = getCurrentLayerOrSet page+ Select (O (Just lyrzipper)) = get g_layers currpage + emptylyr <- liftIO emptyTLayerBBoxBufLyBuf + let nlyrzipper = appendGoLast lyrzipper emptylyr + npage = set g_layers (Select (O (Just nlyrzipper))) currpage+ return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate + ++gotoNextLayer :: MainCoroutine ()+gotoNextLayer = layerAction nextlayeraction >>= putSt+ where nextlayeraction xojstate cpn page = do + let (_,currpage) = getCurrentLayerOrSet page+ Select (O (Just lyrzipper)) = get g_layers currpage + let mlyrzipper = moveRight lyrzipper + + npage = maybe currpage (\x-> set g_layers (Select (O (Just x))) currpage) mlyrzipper+ case mlyrzipper of + Nothing -> liftIO $ putStrLn "Nothing"+ Just _ -> liftIO $ putStrLn "Just"+ let Select (O (Just ll)) = get g_layers npage+ SZ (_,(x1,x2)) = ll + liftIO$ print (Seq.length x1, Seq.length x2)++ return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate ++gotoPrevLayer :: MainCoroutine ()+gotoPrevLayer = layerAction prevlayeraction >>= putSt+ where prevlayeraction xojstate cpn page = do + let (_,currpage) = getCurrentLayerOrSet page+ Select (O (Just lyrzipper)) = get g_layers currpage + let mlyrzipper = moveLeft lyrzipper + npage = maybe currpage (\x -> set g_layers (Select (O (Just x))) currpage) mlyrzipper+ let Select (O (Just ll)) = get g_layers npage+ SZ (_,(x1,x2)) = ll + case mlyrzipper of + Nothing -> liftIO $ putStrLn "Nothing"+ Just _ -> liftIO $ putStrLn "Just"+ liftIO$ print (Seq.length x1, Seq.length x2)++ return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate +++gotoLayerAt :: Int -> MainCoroutine ()+gotoLayerAt n = layerAction gotoaction >>= putSt+ where gotoaction xojstate cpn page = do + let (_,currpage) = getCurrentLayerOrSet page+ Select (O (Just lyrzipper)) = get g_layers currpage + let mlyrzipper = moveTo n lyrzipper + npage = maybe currpage (\x -> set g_layers (Select (O (Just x))) currpage) mlyrzipper+ let Select (O (Just ll)) = get g_layers npage+ SZ (_,(x1,x2)) = ll + liftIO $ print (Seq.length x1, Seq.length x2)+ return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate +++deleteCurrentLayer :: MainCoroutine ()+deleteCurrentLayer = layerAction deletelayeraction >>= commit+ where deletelayeraction xojstate cpn page = do + let (mcurrlayer,currpage) = getCurrentLayerOrSet page+ case mcurrlayer of + Nothing -> return xojstate + Just currlayer -> do + let Select (O (Just lyrzipper)) = get g_layers currpage + mlyrzipper = deleteCurrent lyrzipper + npage = maybe currpage + (\x -> set g_layers (Select (O (Just x))) currpage) + mlyrzipper+ return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate ++startGotoLayerAt :: MainCoroutine ()+startGotoLayerAt = do + liftIO $ putStrLn "startGotoLayerAt"+ xstate <- getSt + let epage = get currentPage . getCurrentCanvasInfo $ xstate + cpn = get currentPageNum . getCurrentCanvasInfo $ xstate+ xojstate = get xournalstate xstate + page = either id gcast epage + (_,currpage) = getCurrentLayerOrSet page+ Select (O (Just lyrzipper)) = get g_layers currpage+ cidx = currIndex lyrzipper+ len = lengthSZ lyrzipper + + lref <- liftIO $ newIORef cidx++ dialog <- liftIO (layerChooseDialog lref cidx len)++ res <- liftIO $ dialogRun dialog+ case res of + ResponseDeleteEvent -> liftIO $ widgetDestroy dialog+ ResponseOk -> do+ liftIO $ widgetDestroy dialog+ newnum <- liftIO (readIORef lref)+ liftIO $ putStrLn (show (newnum))+ gotoLayerAt newnum+ ResponseCancel -> liftIO $ widgetDestroy dialog+ _ -> error "??? in fileOpen " + return ()+
lib/Application/HXournal/Coroutine/Mode.hs view
@@ -21,7 +21,7 @@ import Prelude hiding ((.),id, mapM_, mapM) -modeChange :: MyEvent -> Iteratee MyEvent XournalStateIO ()+modeChange :: MyEvent -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () modeChange ToViewAppendMode = do xstate <- getSt let xojstate = get xournalstate xstate
lib/Application/HXournal/Coroutine/Page.hs view
@@ -1,5 +1,7 @@ module Application.HXournal.Coroutine.Page where +import Control.Applicative +import Control.Compose import Application.HXournal.Type.Event import Application.HXournal.Type.Coroutine import Application.HXournal.Type.Canvas@@ -12,6 +14,7 @@ import Graphics.Xournal.Render.BBoxMapPDF import Data.Xournal.Generic+import Data.Xournal.Select import Graphics.UI.Gtk hiding (get,set) import Application.HXournal.ModelAction.Page@@ -23,7 +26,7 @@ import Data.Xournal.Simple import qualified Data.IntMap as IM -changePage :: (Int -> Int) -> Iteratee MyEvent XournalStateIO () +changePage :: (Int -> Int) -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () changePage modifyfn = do xstate <- getSt let currCvsId = get currentCanvas xstate@@ -40,7 +43,7 @@ (xstate',xoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) then do - let npage = lpage { glayers = IM.insert 0 (GLayerBuf (LyBuf Nothing) []) IM.empty } + let npage = newSinglePageFromOld lpage npages = IM.insert totalnumofpages npage pgs newxoj = xoj { gpages = npages } xstate' = set xournalstate (ViewAppendState newxoj) xstate@@ -71,8 +74,9 @@ Just p -> p (xstate',txoj',_pages',_totalnumofpages',newpage) <- if (modifyfn oldpage >= totalnumofpages) - then do - let npage = lpage { glayers = IM.insert 0 (GLayerBuf (LyBuf Nothing) []) IM.empty } + then do+ nlyr <- liftIO emptyTLayerBBoxBufLyBuf + let npage = set g_layers (Select . O . Just . singletonSZ $ nlyr) lpage npages = IM.insert totalnumofpages npage pgs newtxoj = txoj { gselectAll = npages } xstate' = set xournalstate (SelectState newtxoj) xstate@@ -95,7 +99,7 @@ putSt xstate'' invalidate currCvsId -canvasZoomUpdate :: Maybe ZoomMode -> CanvasId -> Iteratee MyEvent XournalStateIO ()+canvasZoomUpdate :: Maybe ZoomMode -> CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () canvasZoomUpdate mzmode cid = do xstate <- getSt let cinfoMap = get canvasInfoMap xstate@@ -121,8 +125,29 @@ invalidate cid -pageZoomChange :: ZoomMode -> Iteratee MyEvent XournalStateIO () +pageZoomChange :: ZoomMode -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () pageZoomChange zmode = do xstate <- getSt let currCvsId = get currentCanvas xstate canvasZoomUpdate (Just zmode) currCvsId ++newPageBefore :: MainCoroutine () -- Iteratee MyEvent XournalStateIO () +newPageBefore = do + liftIO $ putStrLn "newPageBefore called"+ xstate <- getSt+ let xojstate = get xournalstate xstate+ case xojstate of + ViewAppendState xoj -> do + liftIO $ putStrLn " In View " + let currCvsId = get currentCanvas xstate + mcurrCvsInfo = IM.lookup currCvsId (get canvasInfoMap xstate)+ xoj' <- maybe (error $ "something wrong in newPageBefore")+ (liftIO . newPageBeforeAction xoj)+ $ (,) <$> pure currCvsId <*> mcurrCvsInfo + let xstate' = updatePageAll (ViewAppendState xoj')+ . set xournalstate (ViewAppendState xoj') + $ xstate + commit xstate'+ invalidate currCvsId + SelectState txoj -> liftIO $ putStrLn " In Select State, this is not implemented yet."+
lib/Application/HXournal/Coroutine/Pen.hs view
@@ -11,11 +11,13 @@ import Application.HXournal.Coroutine.EventConnect import Application.HXournal.Coroutine.Commit import Application.HXournal.Accessor+import Application.HXournal.Util import Application.HXournal.ModelAction.Pen import Application.HXournal.ModelAction.Page import Application.HXournal.Draw import Control.Monad.Trans +import Data.Xournal.Generic import Control.Monad.Coroutine.SuspensionFunctors import Data.Sequence hiding (filter) import qualified Data.Map as M@@ -26,7 +28,7 @@ import Graphics.Xournal.Render.BBox -penStart :: CanvasId -> PointerCoord -> Iteratee MyEvent XournalStateIO ()+penStart :: CanvasId -> PointerCoord -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () penStart cid pcoord = do xstate <- changeCurrentCanvasId cid let cvsInfo = getCanvasInfo cid xstate @@ -38,6 +40,17 @@ let (x,y) = device2pageCoord geometry zmode pcoord connidup <- connectPenUp cvsInfo connidmove <- connectPenMove cvsInfo + + {-+ -- just for test+ xstate2 <- getSt+ let epg2 = get currentPage . getCurrentCanvasInfo $ xstate2++ liftIO $ putStrLn "before pen start"+ liftIO $ either testPage (testPage . gcast) epg2 + liftIO $ putStrLn "from currxoj" + liftIO $ testPage (getPageFromGXournalMap pagenum currxoj) -}+ pdraw <-penProcess cid geometry connidmove connidup (empty |> (x,y)) (x,y) (newxoj,bbox) <- liftIO $ addPDraw pinfo currxoj pagenum pdraw let bbox' = inflate bbox (get (penWidth.penInfo) xstate) @@ -52,7 +65,8 @@ -> CanvasPageGeometry -> ConnectId DrawingArea -> ConnectId DrawingArea -> Seq (Double,Double) -> (Double,Double) - -> Iteratee MyEvent XournalStateIO (Seq (Double,Double))+ -> MainCoroutine (Seq (Double,Double))+ -- Iteratee MyEvent XournalStateIO (Seq (Double,Double)) penProcess cid cpg connidmove connidup pdraw (x0,y0) = do r <- await xstate <- getSt
lib/Application/HXournal/Coroutine/Scroll.hs view
@@ -13,10 +13,10 @@ import Data.Label import Prelude hiding ((.), id) -vscrollStart :: CanvasId -> Iteratee MyEvent XournalStateIO () +vscrollStart :: CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () vscrollStart cid = vscrollMove cid -vscrollMove :: CanvasId -> Iteratee MyEvent XournalStateIO () +vscrollMove :: CanvasId -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () vscrollMove cid = do ev <- await case ev of
lib/Application/HXournal/Coroutine/Select.hs view
@@ -10,25 +10,30 @@ import Application.HXournal.Accessor import Application.HXournal.Device import Application.HXournal.Draw+import Application.HXournal.Util import Application.HXournal.Coroutine.EventConnect import Application.HXournal.Coroutine.Draw import Application.HXournal.Coroutine.Mode import Application.HXournal.Coroutine.Commit import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Select+import Application.HXournal.ModelAction.Layer import Control.Monad.Trans import Control.Monad.Coroutine.SuspensionFunctors+import Control.Compose import Control.Category import Data.Label import Prelude hiding ((.), id) import Data.Xournal.Generic import Data.Xournal.BBox+import Data.Xournal.Select import Graphics.Xournal.Render.Type import Graphics.Xournal.Render.BBoxMapPDF import Graphics.Xournal.Render.HitTest import Graphics.Xournal.Render.BBox +import System.IO.Unsafe import qualified Data.IntMap as IM import Data.Maybe@@ -37,7 +42,7 @@ -- choose either starting new rectangular selection or move previously -- selected selection. -selectRectStart :: CanvasId -> PointerCoord -> Iteratee MyEvent XournalStateIO () +selectRectStart :: CanvasId -> PointerCoord -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () selectRectStart cid pcoord = do xstate <- changeCurrentCanvasId cid let cvsInfo = getCanvasInfo cid xstate@@ -46,7 +51,7 @@ let (x,y) = device2pageCoord geometry zmode pcoord connidup <- connectPenUp cvsInfo connidmove <- connectPenMove cvsInfo- strs <- getAllStrokeBBoxInCurrentPage+ strs <- getAllStrokeBBoxInCurrentLayer case get currentPage cvsInfo of Right tpage -> if hitInSelection tpage (x,y) then do @@ -83,7 +88,7 @@ -> [StrokeBBox] -> (Double,Double) -> (Double,Double)- -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () newSelectRectangle cinfo geometry zmode connidmove connidup strs orig prev = do let cid = get canvasId cinfo r <- await @@ -98,8 +103,6 @@ then do flip invalidateWithBufInBBox cid . Just $ (inflate (fromJust (Just bbox `merge` Just prevbbox)) 5.0) invalidateDrawBBox cid bbox- -- for the time being - -- mapM_ (invalidateDrawBBox cid . strokebbox_bbox) hittedstrs else return () newSelectRectangle cinfo geometry zmode connidmove connidup strs orig (x,y) PenUp _cid' pcoord -> do @@ -112,24 +115,21 @@ selectstrs = fmapAL unNotHitted id hittestbbox xstate <- getSt let SelectState txoj = get xournalstate xstate- newpage = case epage of Left pagebbox -> - let currlayer = case IM.lookup 0 (get g_layers pagebbox) of- Nothing -> error "something wrong in newSelectRectangle"- Just l -> l+ let (mcurrlayer,npagebbox) = getCurrentLayerOrSet pagebbox+ currlayer = maybe (error "newSelectRectangle") id mcurrlayer newlayer = GLayerBuf (get g_buffer currlayer) (TEitherAlterHitted (Right selectstrs))- - - tpg = gcast pagebbox- ls = glayers tpg - in tpg { glayers = ls { gselectedlayerbuf = newlayer} }+ tpg = gcast npagebbox + ls = get g_layers tpg + npg = tpg { glayers = ls { gselectedlayerbuf = newlayer} }+ in npg Right tpage -> let ls = glayers tpage currlayer = gselectedlayerbuf ls newlayer = GLayerBuf (get g_buffer currlayer) (TEitherAlterHitted (Right selectstrs))-- in tpage { glayers = ls { gselectedlayerbuf = newlayer } } + npage = tpage { glayers = ls { gselectedlayerbuf = newlayer } } + in npage newtxoj = txoj { gselectSelected = Just (cpn,newpage) } let ui = get gtkUIManager xstate liftIO $ toggleCutCopyDelete ui (isAnyHitted selectstrs)@@ -148,7 +148,7 @@ -> ConnectId DrawingArea -> (Double,Double) -> (Double,Double)- -> Iteratee MyEvent XournalStateIO ()+ -> MainCoroutine () moveSelectRectangle cinfo geometry zmode connidmove connidup orig@(x0,y0) _prev = do xstate <- getSt r <- await @@ -175,7 +175,7 @@ invalidateAll _ -> return () -deleteSelection :: Iteratee MyEvent XournalStateIO () +deleteSelection :: MainCoroutine () deleteSelection = do liftIO $ putStrLn "delete selection is called" xstate <- getSt@@ -197,13 +197,13 @@ liftIO $ toggleCutCopyDelete ui False invalidateAll -cutSelection :: Iteratee MyEvent XournalStateIO () +cutSelection :: MainCoroutine () cutSelection = do liftIO $ putStrLn "cutSelection called" copySelection deleteSelection -copySelection :: Iteratee MyEvent XournalStateIO ()+copySelection :: MainCoroutine () copySelection = do liftIO $ putStrLn "copySelection called" xstate <- getSt@@ -222,13 +222,12 @@ else do let newclip = Clipboard strs xstate' = set clipboard newclip xstate - liftIO $ putStrLn $ "newclipboard with " ++ show strs let ui = get gtkUIManager xstate' liftIO $ togglePaste ui True putSt xstate' invalidateAll -pasteToSelection :: Iteratee MyEvent XournalStateIO () +pasteToSelection :: MainCoroutine () pasteToSelection = do liftIO $ putStrLn "pasteToSelection called" modeChange ToSelectMode @@ -260,7 +259,7 @@ liftIO $ toggleCutCopyDelete ui True invalidateAll -selectPenColorChanged :: PenColor -> Iteratee MyEvent XournalStateIO () +selectPenColorChanged :: PenColor -> MainCoroutine () selectPenColorChanged pcolor = do liftIO $ putStrLn "selectPenColorChanged called" xstate <- getSt@@ -281,7 +280,7 @@ $ xstate invalidateAll -selectPenWidthChanged :: Double -> Iteratee MyEvent XournalStateIO () +selectPenWidthChanged :: Double -> MainCoroutine () selectPenWidthChanged pwidth = do liftIO $ putStrLn "selectPenWidthChanged called" xstate <- getSt
lib/Application/HXournal/Coroutine/Window.hs view
@@ -14,7 +14,7 @@ import Graphics.UI.Gtk hiding (get,set) import qualified Data.IntMap as M -eitherSplit :: SplitType -> Iteratee MyEvent XournalStateIO ()+eitherSplit :: SplitType -> MainCoroutine () -- Iteratee MyEvent XournalStateIO () eitherSplit stype = do xstate <- getSt let cmap = get canvasInfoMap xstate@@ -52,7 +52,7 @@ liftIO $ widgetShowAll rtcntr -deleteCanvas :: Iteratee MyEvent XournalStateIO ()+deleteCanvas :: MainCoroutine () -- Iteratee MyEvent XournalStateIO () deleteCanvas = do liftIO $ putStrLn "deleteCanvas" xstate <- getSt
lib/Application/HXournal/Draw.hs view
@@ -133,7 +133,9 @@ let mbboxnew = adjustBBoxWithView geometry zmode mbbox renderWithDrawable win $ do transformForPageCoord geometry zmode+ clipBBox mbboxnew render page mbboxnew + resetClip return () return () @@ -148,8 +150,10 @@ let mbboxnew = adjustBBoxWithView geometry zmode mbbox renderWithDrawable win $ do transformForPageCoord geometry zmode+ clipBBox mbboxnew rencont page mbboxnew rensel page mbboxnew + resetClip return () @@ -347,8 +351,6 @@ 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
lib/Application/HXournal/GUI.hs view
@@ -41,7 +41,11 @@ st0 <- readIORef sref maxundo <- getMaxUndo cfg >>= \mmax -> maybe (return 50) (return . id) mmax- let st1 = set undoTable (emptyUndo maxundo) st0 + -- ncconf <- getNetworkInfo cfg+ + let st1 = -- set networkClipboardInfo ncconf+ set undoTable (emptyUndo maxundo) + $ st0 -- let st1 = set gtkUIManager ui st0 st2 <- getFileContent mfname st1
lib/Application/HXournal/GUI/Menu.hs view
@@ -58,7 +58,10 @@ <menuitem action="CUTA" /> <menuitem action="COPYA" /> <menuitem action="PASTEA" /> - <menuitem action="DELETEA" /> + <menuitem action="DELETEA" />+ <separator />+ <menuitem action="NETCOPYA" />+ <menuitem action="NETPASTEA" /> </menu> <menu action="VMA"> <menuitem action="CONTA" />@@ -94,6 +97,9 @@ <menuitem action="DELPGA" /> <separator /> <menuitem action="NEWLYRA" />+ <menuitem action="NEXTLAYERA" />+ <menuitem action="PREVLAYERA" />+ <menuitem action="GOTOLAYERA" /> <menuitem action="DELLYRA" /> <separator /> <menuitem action="PPSIZEA" />@@ -368,6 +374,9 @@ copya <- actionNewAndRegister "COPYA" "Copy" (Just "Just a Stub") (Just stockCopy) (justMenu MenuCopy) pastea <- actionNewAndRegister "PASTEA" "Paste" (Just "Just a Stub") (Just stockPaste) (justMenu MenuPaste) deletea <- actionNewAndRegister "DELETEA" "Delete" (Just "Just a Stub") (Just stockDelete) (justMenu MenuDelete)+ -- netcopya <- actionNewAndRegister "NETCOPYA" "Copy to NetworkClipboard" (Just "Just a Stub") Nothing (justMenu MenuNetCopy)+ -- netpastea <- actionNewAndRegister "NETPASTEA" "Paste from NetworkClipboard" (Just "Just a Stub") Nothing (justMenu MenuNetPaste)+ -- view menu @@ -396,6 +405,9 @@ newpgea <- actionNewAndRegister "NEWPGEA" "New Page At End" (Just "Just a Stub") Nothing (justMenu MenuNewPageAtEnd) delpga <- actionNewAndRegister "DELPGA" "Delete Page" (Just "Just a Stub") Nothing (justMenu MenuDeletePage) newlyra <- actionNewAndRegister "NEWLYRA" "New Layer" (Just "Just a Stub") Nothing (justMenu MenuNewLayer)+ nextlayera <- actionNewAndRegister "NEXTLAYERA" "Next Layer" (Just "Just a Stub") Nothing (justMenu MenuNextLayer)+ prevlayera <- actionNewAndRegister "PREVLAYERA" "Prev Layer" (Just "Just a Stub") Nothing (justMenu MenuPrevLayer)+ gotolayera <- actionNewAndRegister "GOTOLAYERA" "Goto Layer" (Just "Just a Stub") Nothing (justMenu MenuGotoLayer) dellyra <- actionNewAndRegister "DELLYRA" "Delete Layer" (Just "Just a Stub") Nothing (justMenu MenuDeleteLayer) ppsizea <- actionNewAndRegister "PPSIZEA" "Paper Size" (Just "Just a Stub") Nothing (justMenu MenuPaperSize) ppclra <- actionNewAndRegister "PPCLRA" "Paper Color" (Just "Just a Stub") Nothing (justMenu MenuPaperColor)@@ -456,16 +468,15 @@ [fma,ema,vma,jma,tma,oma,hma] mapM_ (\act -> actionGroupAddActionWithAccel agr act Nothing) [ newa, annpdfa, opena, savea, saveasa, recenta, printa, exporta, quita- , undoa, redoa, cuta, copya, pastea, deletea+ , undoa, redoa, cuta, copya, pastea, deletea {- , netcopya, netpastea -} , fscra, zooma, zmina, zmouta, nrmsizea, pgwdtha, pgheighta, setzma , fstpagea, prvpagea, nxtpagea, lstpagea, shwlayera, hidlayera , hsplita, vsplita, delcvsa- , newpgba, newpgaa, newpgea, delpga, newlyra, dellyra, ppsizea, ppclra+ , newpgba, newpgaa, newpgea, delpga, newlyra, nextlayera, prevlayera, gotolayera, dellyra, ppsizea, ppclra , ppstya, apallpga, ldbkga, bkgscrshta, defppa, setdefppa- , shpreca, rulera, clra, penopta {- selregna, selrecta, vertspa, handa, -}+ , shpreca, rulera, clra, penopta , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- {- , uxinputa, -} , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa @@ -478,15 +489,13 @@ actionGroupAddRadioActions agr pointmods 0 (assignPoint sref) actionGroupAddRadioActions agr penmods 0 (assignPenMode tref sref) actionGroupAddRadioActions agr colormods 0 (assignColor sref) -- let disabledActions = [ recenta, printa, exporta- , {- undoa, redoa, -} cuta, copya, pastea, deletea+ , cuta, copya, pastea, deletea , fscra, zmina, zmouta, setzma , shwlayera, hidlayera- , newpgba, newpgaa, newpgea, delpga, newlyra, dellyra, ppsizea, ppclra+ , newpgaa, newpgea, delpga, {- newlyra, dellyra, -} ppsizea, ppclra , ppstya, apallpga, ldbkga, bkgscrshta, defppa, setdefppa , shpreca, rulera , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta@@ -499,8 +508,7 @@ ] enabledActions = [ opena, savea, saveasa, quita, fstpagea, prvpagea, nxtpagea, lstpagea- , clra, penopta, zooma, nrmsizea, pgwdtha -- , selrecta- -- , uxinputa + , clra, penopta, zooma, nrmsizea, pgwdtha ] mapM_ (\x->actionSetSensitive x True) enabledActions
+ lib/Application/HXournal/ModelAction/Layer.hs view
@@ -0,0 +1,62 @@+module Application.HXournal.ModelAction.Layer where++import Application.HXournal.Util++import Control.Compose+import Control.Category+import Data.Label+import Prelude hiding ((.),id)++import Data.Xournal.BBox+import Data.Xournal.Generic+import Data.Xournal.Buffer+import Data.Xournal.Select+import Graphics.Xournal.Render.BBoxMapPDF++import Graphics.UI.Gtk hiding (get,set)+import qualified Graphics.UI.Gtk as Gtk (get,set)++import Data.IORef++getCurrentLayerOrSet :: TPageBBoxMapPDFBuf -> (Maybe (TLayerBBoxBuf LyBuf),TPageBBoxMapPDFBuf)+getCurrentLayerOrSet pg = + let olayers = get g_layers pg+ nlayers = case olayers of + NoSelect _ -> selectFirst olayers+ Select _ -> olayers + in case nlayers of+ NoSelect _ -> (Nothing, set g_layers nlayers pg)+ Select osz -> (return . current =<< unO osz, set g_layers nlayers pg)+++adjustCurrentLayer :: TLayerBBoxBuf LyBuf -> TPageBBoxMapPDFBuf -> TPageBBoxMapPDFBuf+adjustCurrentLayer nlayer pg = + let (molayer,pg') = getCurrentLayerOrSet pg+ layerzipper = pg'+ in maybe (set g_layers (Select .O . Just . singletonSZ $ nlayer) pg')+ (const $ let layerzipper = maybe (error "adjustCurrentLayer") id . unO . zipper . get g_layers $ pg'+ in set g_layers (Select . O . Just . replace nlayer $ layerzipper) pg' )+ molayer ++layerChooseDialog :: IORef Int -> Int -> Int -> IO Dialog+layerChooseDialog layernumref cidx len = do + dialog <- dialogNew + layerentry <- entryNew+ entrySetText layerentry (show (succ cidx))+ label <- labelNew (Just (" / " ++ show len))+ -- button <- buttonNewWithLabel "test"+ hbox <- hBoxNew False 0 + upper <- dialogGetUpper dialog+ boxPackStart upper hbox PackNatural 0 + boxPackStart hbox layerentry PackNatural 0 + boxPackStart hbox label PackGrow 0 + widgetShowAll upper+ buttonOk <- dialogAddButton dialog stockOk ResponseOk+ buttonCancel <- dialogAddButton dialog stockCancel ResponseCancel++ buttonOk `on` buttonActivated $ do + txt <- Gtk.get layerentry entryText+ maybe (return ()) (modifyIORef layernumref . const . pred) . maybeRead $ txt+ return dialog++
lib/Application/HXournal/ModelAction/Page.hs view
@@ -3,8 +3,8 @@ import Application.HXournal.Type.XournalState import Application.HXournal.Type.Canvas import Data.Xournal.Simple- import Data.Xournal.Generic+import Data.Xournal.Select import Graphics.Xournal.Render.BBoxMapPDF @@ -13,6 +13,29 @@ import Prelude hiding ((.),id) import qualified Data.IntMap as M +getPageMap :: XournalState -> M.IntMap TPageBBoxMapPDFBuf+getPageMap xojstate = case xojstate of + ViewAppendState xoj -> get g_pages xoj + SelectState txoj -> get g_selectAll txoj ++setPageMap :: M.IntMap TPageBBoxMapPDFBuf -> XournalState -> XournalState+setPageMap nmap xojstate = + case xojstate of + ViewAppendState xoj -> ViewAppendState (set g_pages nmap xoj)+ SelectState txoj -> let ntxoj = set g_selectSelected Nothing+ . set g_selectAll nmap + $ txoj + in SelectState ntxoj+ -- SelectState (set g_selectAll nmap txoj)+ +updatePageFromCanvasToXournal :: CanvasInfo -> XournalState -> XournalState +updatePageFromCanvasToXournal cinfo xojstate = + let cpn = get currentPageNum cinfo + epg = get currentPage cinfo+ page = either id gcast epg+ in setPageMap (M.adjust (const page) cpn . getPageMap $ xojstate) xojstate ++ updatePageAll :: XournalState -> HXournalState -> HXournalState@@ -24,9 +47,7 @@ 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 + pagemap = getPageMap xojstate in adjustwork cpn pagemap where adjustwork cpn pagemap = if M.notMember cpn pagemap @@ -75,8 +96,6 @@ setPage :: XournalState -> Int -> CanvasInfo -> CanvasInfo setPage (ViewAppendState xojbbox) pagenum cinfo = let pg = getPageFromGXournalMap pagenum xojbbox- -- getPageFromXojBBoxMapPDF pagenum xojbbox - Dim w h = gdimension pg in set currentPageNum pagenum . set (viewPortOrigin.viewInfo) (0,0) @@ -105,7 +124,22 @@ getPage cinfo = case get currentPage cinfo of Right tpgs -> gcast tpgs :: TPageBBoxMapPDFBuf - -- tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf tpgs Left pg -> pg ++newSinglePageFromOld :: TPageBBoxMapPDFBuf -> TPageBBoxMapPDFBuf +newSinglePageFromOld = + set g_layers (NoSelect [GLayerBuf (LyBuf Nothing) []]) ++newPageBeforeAction :: TXournalBBoxMapPDFBuf -> (CanvasId, CanvasInfo) -> IO TXournalBBoxMapPDFBuf+newPageBeforeAction xoj (cid,cinfo) = do + let cpn = get currentPageNum cinfo+ let pagelst = M.elems . get g_pages $ xoj + pagekeylst = M.keys . get g_pages $ xoj + (pagesbefore,pagesafter) = splitAt cpn pagelst+ npage = newSinglePageFromOld (head pagesafter)+ npagelst = pagesbefore ++ (npage : pagesafter)+ nxoj = set g_pages (M.fromList . zip [0..] $ npagelst) xoj + putStrLn . show $ pagekeylst + return nxoj
lib/Application/HXournal/ModelAction/Pen.hs view
@@ -2,7 +2,9 @@ module Application.HXournal.ModelAction.Pen where +import Application.HXournal.Accessor import Application.HXournal.ModelAction.Page+import Application.HXournal.ModelAction.Layer import Application.HXournal.Type.Canvas import Application.HXournal.Type.Enum import Data.Foldable@@ -17,11 +19,13 @@ import Data.Xournal.Simple import Data.Xournal.Generic import Data.Xournal.BBox--import Graphics.Xournal.Render.BBoxMapPDF+import Data.Xournal.Select +import Application.HXournal.Util+import System.IO.Unsafe +import Graphics.Xournal.Render.BBoxMapPDF addPDraw :: PenInfo -> TXournalBBoxMapPDFBuf -> Int -> Seq (Double,Double) -> IO (TXournalBBoxMapPDFBuf,BBox)@@ -29,10 +33,9 @@ let pcolor = get penColor pinfo pcolname = fromJust (M.lookup pcolor penColorNameMap) pwidth = get penWidth pinfo- currpage = getPageFromGXournalMap pgnum xoj- currlayer = case IM.lookup 0 (get g_layers currpage) of- Nothing -> error "something wrong in addPDraw"- Just l -> l+ (mcurrlayer,currpage) = getCurrentLayerOrSet (getPageFromGXournalMap pgnum xoj)+ currlayer = maybe (error "something wrong in addPDraw") id mcurrlayer + newstroke = Stroke { stroke_tool = "pen" , stroke_color = pcolname , stroke_width = pwidth@@ -40,14 +43,17 @@ } newstrokebbox = mkStrokeBBoxFromStroke newstroke 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 + let newpagebbox = adjustCurrentLayer newlayerbbox currpage ++ -- unsafePerformIO (do { putStrLn "currpage" ; testPage currpage ; return (adjustCurrentLayer newlayerbbox currpage)}) newxojbbox = set g_pages (IM.adjust (const newpagebbox) pgnum (get g_pages xoj) ) xoj - return (newxojbbox,bbox) -- strokebbox_bbox newstrokebbox)+ return (newxojbbox,bbox)++ -- (unsafePerformIO (do { putStrLn "newpage" ; testPage newpagebbox ; return (newxojbbox,bbox)}))
lib/Application/HXournal/Type/Clipboard.hs view
@@ -1,13 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Application.HXournal.Type.Clipboard --- ( Clipboard--- , emptyClipboard--- , isEmpty--- , getClipContents --- , replaceClipContents--- ) - where+module Application.HXournal.Type.Clipboard where import Control.Category import Data.Label
lib/Application/HXournal/Type/Coroutine.hs view
@@ -15,3 +15,4 @@ type TRef = IORef SusAwait type SRef = IORef HXournalState +type MainCoroutine a = Iteratee MyEvent XournalStateIO a
lib/Application/HXournal/Type/Event.hs view
@@ -36,6 +36,8 @@ | MenuCopy | MenuPaste | MenuDelete+ -- | MenuNetCopy+ -- | MenuNetPaste | MenuFullScreen | MenuZoom | MenuZoomIn@@ -58,6 +60,9 @@ | MenuNewPageAtEnd | MenuDeletePage | MenuNewLayer+ | MenuNextLayer+ | MenuPrevLayer + | MenuGotoLayer | MenuDeleteLayer | MenuPaperSize | MenuPaperColor
lib/Application/HXournal/Type/Undo.hs view
@@ -1,14 +1,11 @@ module Application.HXournal.Type.Undo where import Data.Sequence-+import Data.Xournal.Select +{- 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 @@ -46,7 +43,12 @@ next :: SeqZipper a -> Maybe a next = fmap current . moveRight+-} +data UndoTable a = UndoTable { undo_allowednum :: Int+ , undo_totalnum :: Int + , undo_zipper :: Maybe (SeqZipper a)+ } emptyUndo :: Int -> UndoTable a emptyUndo n | n > 0 = UndoTable n 0 Nothing
lib/Application/HXournal/Type/XournalState.hs view
@@ -9,6 +9,8 @@ import Application.HXournal.Type.Clipboard import Application.HXournal.Type.Window import Application.HXournal.Type.Undo++-- import Application.HXournal.NetworkClipboard.Client.Config import Data.Xournal.Map import Graphics.Xournal.Render.BBoxMapPDF@@ -45,6 +47,7 @@ , _gtkUIManager :: UIManager , _isSaved :: Bool , _undoTable :: UndoTable XournalState+-- , _networkClipboardInfo :: Maybe HXournalClipClientConfiguration } @@ -70,6 +73,7 @@ , _gtkUIManager = error "emptyHXournalState.gtkUIManager" , _isSaved = False , _undoTable = emptyUndo 1 +-- , _networkClipboardInfo = Nothing } resetXournalStateBuffers :: XournalState -> IO XournalState
lib/Application/HXournal/Util.hs view
@@ -1,6 +1,42 @@ module Application.HXournal.Util where +import Graphics.Xournal.Render.BBoxMapPDF++import Data.Maybe++import Data.Xournal.Generic+ import Data.Xournal.Simple++import Graphics.Xournal.Render.PDFBackground+import qualified Data.ByteString.Lazy as L+ +-- for test+-- import Blaze.ByteString.Builder+-- import Text.Xournal.Builder ++{-+testPage :: TPageBBoxMapPDFBuf -> IO () +testPage page = do+ let pagesimple = toPage bkgFromBkgPDF . tpageBBoxMapPDFFromTPageBBoxMapPDFBuf $ page + L.putStrLn . toLazyByteString . Text.Xournal.Builder.fromPage $ pagesimple +-}++ +{-+testXournal :: XournalState -> IO () +testXournal xojstate = do+ let xojsimple :: Xournal = case xojstate of+ ViewAppendState xoj -> xournalFromTXournalSimple (gcast xoj :: TXournalSimple)+ SelectState txoj -> xournalFromTXournalSimple (gcast txoj :: TXournalSimple)+ L.putStrLn (builder xojsimple)+-}++maybeRead :: Read a => String -> Maybe a +maybeRead = fmap fst . listToMaybe . reads ++maybeError :: String -> Maybe a -> a+maybeError str = maybe (error str) id getLargestWidth :: Xournal -> Double getLargestWidth xoj =