hxournal 0.6.4.3 → 0.6.5
raw patch · 32 files changed
+563/−338 lines, 32 filesdep ~xournal-builderdep ~xournal-parserdep ~xournal-render
Dependency ranges changed: xournal-builder, xournal-parser, xournal-render, xournal-types
Files
- hxournal.cabal +9/−10
- lib/Application/HXournal/Accessor.hs +10/−17
- lib/Application/HXournal/Coroutine/Commit.hs +0/−1
- lib/Application/HXournal/Coroutine/Default.hs +26/−10
- lib/Application/HXournal/Coroutine/Draw.hs +4/−7
- lib/Application/HXournal/Coroutine/Eraser.hs +1/−2
- lib/Application/HXournal/Coroutine/EventConnect.hs +2/−2
- lib/Application/HXournal/Coroutine/File.hs +0/−1
- lib/Application/HXournal/Coroutine/Layer.hs +6/−9
- lib/Application/HXournal/Coroutine/Mode.hs +19/−11
- lib/Application/HXournal/Coroutine/Page.hs +58/−11
- lib/Application/HXournal/Coroutine/Pen.hs +23/−20
- lib/Application/HXournal/Coroutine/Scroll.hs +1/−1
- lib/Application/HXournal/Coroutine/Select.hs +45/−36
- lib/Application/HXournal/Coroutine/Window.hs +76/−16
- lib/Application/HXournal/Device.hsc +43/−19
- lib/Application/HXournal/GUI.hs +2/−6
- lib/Application/HXournal/GUI/Menu.hs +21/−5
- lib/Application/HXournal/ModelAction/Eraser.hs +2/−2
- lib/Application/HXournal/ModelAction/File.hs +21/−28
- lib/Application/HXournal/ModelAction/Page.hs +18/−16
- lib/Application/HXournal/ModelAction/Pen.hs +20/−10
- lib/Application/HXournal/ModelAction/Select.hs +29/−15
- lib/Application/HXournal/ModelAction/Window.hs +27/−12
- lib/Application/HXournal/Type/Canvas.hs +16/−10
- lib/Application/HXournal/Type/Event.hs +4/−1
- lib/Application/HXournal/Type/PageArrangement.hs +2/−2
- lib/Application/HXournal/Type/Predefined.hs +10/−0
- lib/Application/HXournal/Type/Window.hs +1/−1
- lib/Application/HXournal/Type/XournalState.hs +12/−1
- lib/Application/HXournal/View/Coordinate.hs +6/−24
- lib/Application/HXournal/View/Draw.hs +49/−32
hxournal.cabal view
@@ -1,5 +1,5 @@ Name: hxournal-Version: 0.6.4.3+Version: 0.6.5 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal@@ -48,10 +48,10 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types >= 0.3.2 && < 0.4,- xournal-parser >= 0.3.0.2 && < 0.4,- xournal-render >= 0.5.1 && < 0.6,- xournal-builder >= 0.1.0.2 && < 0.2,+ xournal-types == 0.4.*,+ xournal-parser == 0.4.*,+ xournal-render == 0.6.*,+ xournal-builder >= 0.1.1 && < 0.2, containers == 0.4.*, template-haskell == 2.*, bytestring == 0.9.*, @@ -63,7 +63,6 @@ time == 1.2.*, TypeCompose == 0.9.*, Diff == 0.1.*- else Build-Depends: base == 4.*, mtl == 2.*,@@ -74,10 +73,10 @@ cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-types >= 0.3.1.999 && < 0.4,- xournal-parser >= 0.3.0.2 && < 0.4,- xournal-render >= 0.5.1 && < 0.6,- xournal-builder >= 0.1.0.2 && < 0.2,+ xournal-types == 0.4.*,+ xournal-parser == 0.4.*,+ xournal-render == 0.6.*,+ xournal-builder >= 0.1.1 && < 0.2, containers == 0.4.*, template-haskell == 2.*, bytestring == 0.9.*,
lib/Application/HXournal/Accessor.hs view
@@ -15,8 +15,6 @@ module Application.HXournal.Accessor where import Application.HXournal.Type-import Application.HXournal.View.Draw -import Application.HXournal.ModelAction.Page import Control.Applicative import Control.Monad import qualified Control.Monad.State as St@@ -26,20 +24,15 @@ import Data.Label import Prelude hiding ((.),id) import Graphics.UI.Gtk hiding (get,set)-import qualified Graphics.UI.Gtk as Gtk (get,set)+import qualified Graphics.UI.Gtk as Gtk (set) import Data.Xournal.BBox import Data.Xournal.Generic-import Application.HXournal.Util import Application.HXournal.ModelAction.Layer import Application.HXournal.Type.Alias-import Application.HXournal.Type.Event import Application.HXournal.Type.PageArrangement-import Application.HXournal.Type.Coroutine import Application.HXournal.View.Coordinate-import Application.HXournal.Type.XournalState-import Control.Monad.Coroutine -import Control.Monad.Coroutine.SuspensionFunctors + -- | get HXournalState getSt :: MainCoroutine HXournalState @@ -58,7 +51,7 @@ -- | -getPenType :: MainCoroutine PenType -- Iteratee MyEvent XournalStateIO PenType+getPenType :: MainCoroutine PenType getPenType = get (penType.penInfo) <$> lift (St.get) -- | @@ -92,7 +85,7 @@ let cpn = get currentPageNum cinfo page = getCurrentPageFromXojState cinfo xojstate in case xojstate of - ViewAppendState xoj -> Left page+ ViewAppendState _xoj -> Left page SelectState txoj -> case get g_selectSelected txoj of Nothing -> Left page@@ -147,15 +140,15 @@ liftIO $ maybe (return ()) signalBlock mconnid agr <- liftIO $ uiManagerGetActionGroups ui Just ra1 <- liftIO $ actionGroupGetAction (head agr) "ONEPAGEA"- let wra1 = castToRadioAction ra1 + -- let wra1 = castToRadioAction ra1 selectBoxAction (fsingle ra1) (fcont ra1) cinfobox liftIO $ maybe (return ()) signalUnblock mconnid return ()- where fsingle ra1 cinfo = do+ where fsingle ra1 _cinfo = do let wra1 = castToRadioAction ra1 liftIO $ Gtk.set wra1 [radioActionCurrentValue := 1 ] - fcont ra1 cinfo = do- let wra1 = castToRadioAction ra1 + fcont ra1 _cinfo = do+ -- let wra1 = castToRadioAction ra1 -- liftIO $ wra1 `on` radioActionChanged $ const (putStrLn "hellowworld2" >> return ()) liftIO $ Gtk.set (castToRadioAction ra1) [radioActionCurrentValue := 0 ] @@ -239,7 +232,7 @@ let cinfobox = getCanvasInfo cid xstate cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox- xojstate = get xournalstate xstate + -- xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo) @@ -252,7 +245,7 @@ let cinfobox = get currentCanvasInfo xstate cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox- xojstate = get xournalstate xstate + -- xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo)
lib/Application/HXournal/Coroutine/Commit.hs view
@@ -14,7 +14,6 @@ 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
lib/Application/HXournal/Coroutine/Default.hs view
@@ -38,7 +38,6 @@ -- import Application.HXournal.Coroutine.Network import Application.HXournal.Coroutine.Layer import Application.HXournal.ModelAction.Window -import Application.HXournal.ModelAction.Page import Application.HXournal.Type.Window import Application.HXournal.Device import Control.Applicative ((<$>))@@ -54,7 +53,6 @@ import Data.IORef import Application.HXournal.Type.PageArrangement import Data.Xournal.Simple (Dimension(..))-import Data.Xournal.BBox import Data.Xournal.Generic -- | @@ -122,7 +120,7 @@ st2 = set frameState (Node 1) . updateFromCanvasInfoAsCurrentCanvas initcvsbox $ st1 { _cvsInfoMap = M.empty } - (st3,cvs,wconf) <- constructFrame st2 (get frameState st2)+ (st3,cvs,_wconf) <- constructFrame st2 (get frameState st2) (st4,wconf') <- eventConnect st3 (get frameState st3) let startingXstate = set frameState wconf' . set rootWindow cvs $ st4 @@ -154,12 +152,17 @@ viewAppendMode = do r1 <- await case r1 of - PenDown cid pcoord -> do + PenDown cid pbtn pcoord -> do ptype <- getPenType - case ptype of - PenWork -> penStart cid pcoord - EraserWork -> eraserStart cid pcoord - HighlighterWork -> highlighterStart cid pcoord+ case (ptype,pbtn) of + (PenWork,PenButton1) -> penStart cid pcoord + (PenWork,PenButton2) -> eraserStart cid pcoord + (PenWork,PenButton3) -> do + updateXState (return . set isOneTimeSelectMode YesBeforeSelect)+ modeChange ToSelectMode+ selectLassoStart cid pcoord+ (EraserWork,_) -> eraserStart cid pcoord + (HighlighterWork,_) -> highlighterStart cid pcoord _ -> return () _ -> defaultEventProcess r1 @@ -167,7 +170,7 @@ selectMode = do r1 <- await case r1 of - PenDown cid pcoord -> do + PenDown cid _pbtn pcoord -> do ptype <- return . get (selectType.selectInfo) =<< lift St.get case ptype of SelectRectangleWork -> selectRectStart cid pcoord @@ -185,8 +188,9 @@ defaultEventProcess (HScrollBarMoved cid v) = hscrollBarMoved cid v defaultEventProcess (VScrollBarMoved cid v) = vscrollBarMoved cid v defaultEventProcess (VScrollBarStart cid _v) = vscrollStart cid +defaultEventProcess PaneMoveStart = paneMoveStart defaultEventProcess (CanvasConfigure cid w' h') = - canvasConfigure cid (CanvasDimension (Dim w' h'))+ doCanvasConfigure cid (CanvasDimension (Dim w' h')) defaultEventProcess ToViewAppendMode = modeChange ToViewAppendMode defaultEventProcess ToSelectMode = modeChange ToSelectMode @@ -265,6 +269,18 @@ then mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsAll]) canvases else mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsNone] ) canvases +menuEventProcess MenuPressureSensitivity = updateXState pressSensAction + where pressSensAction xstate = do + let ui = get gtkUIManager xstate + agr <- liftIO ( uiManagerGetActionGroups ui >>= \x ->+ case x of + [] -> error "No action group? "+ y:_ -> return y )+ pressrsensa <- liftIO (actionGroupGetAction agr "PRESSRSENSA") + >>= maybe (error "MenuPressureSensitivity") + (return . castToToggleAction)+ b <- liftIO $ toggleActionGetActive pressrsensa+ return (set (variableWidthPen.penInfo) b xstate) menuEventProcess m = liftIO $ putStrLn $ "not implemented " ++ show m
lib/Application/HXournal/Coroutine/Draw.hs view
@@ -28,12 +28,9 @@ import Control.Category import Data.Label import Prelude hiding ((.),id)-import Data.Xournal.Generic import Graphics.Rendering.Cairo import Graphics.UI.Gtk hiding (get,set)-import Application.HXournal.View.Coordinate import Application.HXournal.Type.Alias-import Application.HXournal.ModelAction.Page data DrawingFunctionSet = DrawingFunctionSet { singleEditDraw :: DrawingFunction SinglePage EditMode@@ -134,9 +131,9 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - page <- getCurrentPageCvsId cid + -- page <- getCurrentPageCvsId cid let canvas = get drawArea cvsInfo- vinfo = get viewInfo cvsInfo + -- vinfo = get viewInfo cvsInfo pnum = PageNum . get currentPageNum $ cvsInfo geometry <- liftIO $ getCanvasGeometry xstate win <- liftIO $ widgetGetDrawWindow canvas@@ -157,9 +154,9 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - page <- getCurrentPageCvsId cid + -- page <- getCurrentPageCvsId cid let canvas = get drawArea cvsInfo- vinfo = get viewInfo cvsInfo + -- vinfo = get viewInfo cvsInfo geometry <- liftIO $ getCanvasGeometry xstate win <- liftIO $ widgetGetDrawWindow canvas let xformfunc = cairoXform4PageCoordinate geometry pnum
lib/Application/HXournal/Coroutine/Eraser.hs view
@@ -33,7 +33,6 @@ 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@@ -69,7 +68,7 @@ (moveact xstate cvsInfo) upact defact = eraserProcess cid pnum geometry connidup connidmove strs (x0,y0) upact _ = disconnect connidmove >> disconnect connidup >> invalidateAll- moveact xstate cvsInfo (x,y) = do + moveact xstate cvsInfo (_pcoord,(x,y)) = do let line = ((x0,y0),(x,y)) hittestbbox = mkHitTestBBox line strs (hitteststroke,hitState) =
lib/Application/HXournal/Coroutine/EventConnect.hs view
@@ -46,7 +46,7 @@ callbk <- get callBack <$> getSt dev <- get deviceList <$> getSt liftIO (c `on` motionNotifyEvent $ tryEvent $ do - p <- getPointer dev+ (_,p) <- getPointer dev liftIO (callbk (PenMove cid p))) connPenUp :: (WidgetClass w) => w -> CanvasId -> MainCoroutine (ConnectId w)@@ -54,5 +54,5 @@ callbk <- get callBack <$> getSt dev <- get deviceList <$> getSt liftIO (c `on` buttonReleaseEvent $ tryEvent $ do - p <- getPointer dev+ (_,p) <- getPointer dev liftIO (callbk (PenMove cid p)))
lib/Application/HXournal/Coroutine/File.hs view
@@ -12,7 +12,6 @@ module Application.HXournal.Coroutine.File where -import Application.HXournal.Type.Event import Application.HXournal.Type.Coroutine import Application.HXournal.Type.XournalState import Application.HXournal.Accessor
lib/Application/HXournal/Coroutine/Layer.hs view
@@ -24,7 +24,6 @@ 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@@ -34,7 +33,6 @@ import Data.Label import Prelude hiding ((.),id) import Data.IORef-import qualified Data.Sequence as Seq import Graphics.UI.Gtk hiding (get,set) layerAction :: (XournalState -> Int -> Page EditMode -> MainCoroutine XournalState) @@ -44,7 +42,6 @@ selectBoxAction (fsingle xst) (fsingle xst) . get currentCanvasInfo $ xst where fsingle xstate cvsInfo = do- let xojstate = get xournalstate xstate let epage = getCurrentPageEitherFromXojState cvsInfo xojstate cpn = get currentPageNum cvsInfo xojstate = get xournalstate xstate@@ -75,8 +72,8 @@ case mlyrzipper of Nothing -> liftIO $ putStrLn "Nothing" Just _ -> liftIO $ putStrLn "Just"- let Select (O (Just ll)) = get g_layers npage- SZ (_,(x1,x2)) = ll + -- let Select (O (Just ll)) = get g_layers npage+ -- SZ (_,(x1,x2)) = ll return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate gotoPrevLayer :: MainCoroutine ()@@ -86,8 +83,8 @@ 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 + -- let Select (O (Just ll)) = get g_layers npage+ -- SZ (_,(x1,x2)) = ll case mlyrzipper of Nothing -> liftIO $ putStrLn "Nothing" Just _ -> liftIO $ putStrLn "Just"@@ -101,8 +98,8 @@ 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 + -- let Select (O (Just ll)) = get g_layers npage+ -- SZ (_,(_x1,_x2)) = ll return . setPageMap (M.adjust (const npage) cpn . getPageMap $ xojstate) $ xojstate
lib/Application/HXournal/Coroutine/Mode.hs view
@@ -22,25 +22,23 @@ import Application.HXournal.Type.Canvas import Application.HXournal.View.Coordinate import Application.HXournal.Accessor-import Application.HXournal.ModelAction.Page import Application.HXournal.Coroutine.Scroll import Application.HXournal.Coroutine.Draw-import Data.Traversable import Control.Applicative import Control.Monad.Trans import Control.Category import Data.Label-import Data.Xournal.Simple (Dimension(..))+import qualified Data.IntMap as M import Data.Xournal.BBox import Data.Xournal.Generic import Graphics.Xournal.Render.BBoxMapPDF-import Graphics.UI.Gtk (adjustmentSetUpper,adjustmentGetValue,adjustmentSetValue)+import Graphics.UI.Gtk (adjustmentGetValue) import Prelude hiding ((.),id, mapM_, mapM) modeChange :: MyEvent -> MainCoroutine () modeChange command = case command of - ToViewAppendMode -> updateXState select2edit- ToSelectMode -> updateXState edit2select + ToViewAppendMode -> updateXState select2edit >> invalidateAll + ToSelectMode -> updateXState edit2select >> invalidateAll _ -> return () where select2edit xst = either (noaction xst) (whenselect xst) . xojstateEither . get xournalstate $ xst@@ -49,15 +47,25 @@ noaction :: HXournalState -> a -> MainCoroutine HXournalState noaction xstate = const (return xstate) whenselect :: HXournalState -> Xournal SelectMode -> MainCoroutine HXournalState- whenselect xstate txoj = return . flip (set xournalstate) xstate - . ViewAppendState . GXournal (get g_selectTitle txoj)- =<< liftIO (mapM resetPageBuffers (get g_selectAll txoj)) + whenselect xstate txoj = do + let pages = get g_selectAll txoj+ mselect = get g_selectSelected txoj+ npages <- maybe (return pages) + (\(spgn,spage) -> do + npage <- liftIO $ resetPageBuffers (gcast spage) + return $ M.adjust (const npage) spgn pages )+ mselect+ return . flip (set xournalstate) xstate + . ViewAppendState . GXournal (get g_selectTitle txoj) $ npages whenedit :: HXournalState -> Xournal EditMode -> MainCoroutine HXournalState whenedit xstate xoj = return . flip (set xournalstate) xstate . SelectState $ GSelect (get g_title xoj) (gpages xoj) Nothing +-- M.adjust (const ( +-- =<< liftIO (mapM resetPageBuffers (get g_selectAll txoj)) +-- | viewModeChange :: MyEvent -> MainCoroutine () viewModeChange command = do @@ -102,7 +110,7 @@ whensing xstate cinfo = do cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate - page <- getCurrentPageCurr + -- page <- getCurrentPageCurr let zmode = get (zoomMode.viewInfo) cinfo canvas = get drawArea cinfo cpn = PageNum . get currentPageNum $ cinfo @@ -111,7 +119,7 @@ let arr = makeContinuousSingleArrangement zmode cdim (getXournal xstate) (cpn, PageCoord (xpos,ypos))- ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr + -- ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr geometry <- liftIO $ makeCanvasGeometry cpn arr canvas let DeskCoord (nxpos,nypos) = page2Desktop geometry (cpn,PageCoord (xpos,ypos)) let vinfo = get viewInfo cinfo
lib/Application/HXournal/Coroutine/Page.hs view
@@ -18,7 +18,6 @@ import Application.HXournal.Type.PageArrangement import Application.HXournal.Type.XournalState import Application.HXournal.Util-import Application.HXournal.View.Draw import Application.HXournal.View.Coordinate import Application.HXournal.Accessor import Application.HXournal.Coroutine.Draw@@ -27,15 +26,11 @@ -- import Application.HXournal.ModelAction.Adjustment import Application.HXournal.ModelAction.Page import Application.HXournal.Type.Alias-import Graphics.Xournal.Render.BBoxMapPDF import Data.Xournal.Generic-import Graphics.UI.Gtk hiding (get,set) import Control.Monad.Trans import Control.Category import Data.Label import Prelude hiding ((.), id)-import Data.Xournal.Simple (Dimension(..))-import Data.Xournal.BBox import qualified Data.IntMap as M -- | change page of current canvas using a modify function@@ -50,8 +45,8 @@ let xojst = get xournalstate $ xstate npgnum = modifyfn (get currentPageNum cvsInfo) cid = get canvasId cvsInfo- (b,npgnum',selectedpage,xojst') = changePageInXournalState npgnum xojst- Dim w h = get g_dimension selectedpage+ (b,npgnum',_selectedpage,xojst') = changePageInXournalState npgnum xojst+ -- Dim w h = get g_dimension selectedpage xstate' <- liftIO $ updatePageAll xojst' xstate ncvsInfo <- liftIO $ setPage xstate' (PageNum npgnum') cid xstatefinal <- return . modifyCurrentCanvasInfo (const ncvsInfo) $ xstate'@@ -62,8 +57,8 @@ let xojst = get xournalstate $ xstate npgnum = modifyfn (get currentPageNum cvsInfo) cid = get canvasId cvsInfo- (b,npgnum',selectedpage,xojst') = changePageInXournalState npgnum xojst- Dim w h = get g_dimension selectedpage+ (b,npgnum',_selectedpage,xojst') = changePageInXournalState npgnum xojst+ -- Dim w h = get g_dimension selectedpage xstate' <- liftIO $ updatePageAll xojst' xstate ncvsInfo <- liftIO $ setPage xstate' (PageNum npgnum') cid xstatefinal <- return . modifyCurrentCanvasInfo (const ncvsInfo) $ xstate'@@ -90,11 +85,53 @@ in (False,npg,pg,exoj) in (isChanged,npgnum',npage',either ViewAppendState SelectState exoj') +-- | +canvasZoomUpdateGenRenderCvsId :: MainCoroutine () + -> CanvasId + -> Maybe ZoomMode + -> MainCoroutine ()+canvasZoomUpdateGenRenderCvsId renderfunc cid mzmode + = updateXState zoomUpdateAction + >> adjustScrollbarWithGeometryCvsId cid+ >> renderfunc+ where zoomUpdateAction xst = + selectBoxAction (fsingle xst) (fcont xst) . getCanvasInfo cid $ xst + fsingle xstate cinfo = do + geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo + page <- getCurrentPageCvsId cid+ let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode + pdim = PageDimension $ get g_dimension page+ cdim = canvasDim geometry + narr = makeSingleArrangement zmode pdim cdim (0,0)+ ncinfobox = CanvasInfoBox+ . set (pageArrangement.viewInfo) narr+ . set (zoomMode.viewInfo) zmode $ cinfo+ return . modifyCanvasInfo cid (const ncinfobox) $ xstate+ fcont xstate cinfo = do + geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo + -- page <- getCurrentPageCvsId cid + let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode + cpn = PageNum $ get currentPageNum cinfo + -- pdim = PageDimension $ get g_dimension page+ cdim = canvasDim geometry + xoj = getXournal xstate + narr = makeContinuousSingleArrangement zmode cdim xoj (cpn,PageCoord (0,0))+ ncinfobox = CanvasInfoBox+ . set (pageArrangement.viewInfo) narr+ . set (zoomMode.viewInfo) zmode $ cinfo+ return . modifyCanvasInfo cid (const ncinfobox) $ xstate++ -- | -canvasZoomUpdateCvsId :: CanvasId -> Maybe ZoomMode -> MainCoroutine ()-canvasZoomUpdateCvsId cid mzmode = updateXState zoomUpdateAction +canvasZoomUpdateCvsId :: CanvasId + -> Maybe ZoomMode + -> MainCoroutine ()+canvasZoomUpdateCvsId = canvasZoomUpdateGenRenderCvsId invalidateAll+ +{- + cid mzmode = updateXState zoomUpdateAction >> adjustScrollbarWithGeometryCvsId cid >> invalidateAll where zoomUpdateAction xst = @@ -125,7 +162,17 @@ . set (pageArrangement.viewInfo) narr . set (zoomMode.viewInfo) zmode $ cinfo return . modifyCanvasInfo cid (const ncinfobox) $ xstate+-} +-- | ++canvasZoomUpdateBufAll :: MainCoroutine () +canvasZoomUpdateBufAll = do + klst <- liftM (M.keys . getCanvasInfoMap) getSt+ mapM_ updatefunc klst + where + updatefunc cid + = canvasZoomUpdateGenRenderCvsId (invalidateWithBuf cid) cid Nothing -- | canvasZoomUpdateAll :: MainCoroutine ()
lib/Application/HXournal/Coroutine/Pen.hs view
@@ -30,18 +30,14 @@ import Application.HXournal.ModelAction.Page import Application.HXournal.View.Coordinate import Application.HXournal.View.Draw-import Application.HXournal.Type.Alias import Application.HXournal.Util import Control.Monad import Control.Monad.Trans import Control.Monad.Coroutine.SuspensionFunctors import Data.Xournal.Predefined-import Data.Xournal.Generic import Data.Xournal.BBox-import Graphics.Xournal.Render.BBox import Data.Sequence hiding (filter) import qualified Data.Map as M-import qualified Data.IntMap as IM import Data.Maybe import Control.Category import Data.Label@@ -56,7 +52,7 @@ putSt xst return cinfo' where switchact xst = do - let xoj = getXournal xst+ let -- xoj = getXournal xst ncinfo = set currentPageNum (unPageNum pgn) cinfo mfunc = const (return . CanvasInfoBox $ ncinfo) return . (,ncinfo) =<< modifyCurrCvsInfoM mfunc xst@@ -95,13 +91,14 @@ -- | enter pen drawing mode penStart :: CanvasId -> PointerCoord -> MainCoroutine () -penStart cid = commonPenStart penAction cid +penStart cid pcoord = commonPenStart penAction cid pcoord where penAction :: forall b. (ViewMode b) => CanvasInfo b -> PageNum -> CanvasGeometry -> (ConnectId DrawingArea, ConnectId DrawingArea) -> (Double,Double) -> MainCoroutine ()- penAction cinfo pnum geometry (cidmove,cidup) (x,y) = do + penAction _cinfo pnum geometry (cidmove,cidup) (x,y) = do xstate <- getSt+ let PointerCoord _ _ _ z = pcoord let currxoj = unView . get xournalstate $ xstate pinfo = get penInfo xstate- pdraw <-penProcess cid pnum geometry cidmove cidup (empty |> (x,y)) (x,y) + pdraw <-penProcess cid pnum geometry cidmove cidup (empty |> (x,y,z)) ((x,y),z) (newxoj,bbox) <- liftIO $ addPDraw pinfo currxoj pnum pdraw commit . set xournalstate (ViewAppendState newxoj) =<< (liftIO (updatePageAll (ViewAppendState newxoj) xstate))@@ -119,19 +116,21 @@ penProcess :: CanvasId -> PageNum -> CanvasGeometry -> ConnectId DrawingArea -> ConnectId DrawingArea - -> Seq (Double,Double) -> (Double,Double) - -> MainCoroutine (Seq (Double,Double))-penProcess cid pnum geometry connidmove connidup pdraw (x0,y0) = do + -> Seq (Double,Double,Double) -> ((Double,Double),Double) + -> MainCoroutine (Seq (Double,Double,Double))+penProcess cid pnum geometry connidmove connidup pdraw ((x0,y0),z0) = do r <- await xst <- getSt - selectBoxAction (fsingle r xst) (fsingle r xst) . getCanvasInfo cid $ xst+ boxAction (fsingle r xst) . getCanvasInfo cid $ xst where fsingle :: forall b. (ViewMode b) => - MyEvent -> HXournalState -> CanvasInfo b -> MainCoroutine (Seq (Double,Double))+ MyEvent -> HXournalState -> CanvasInfo b + -> MainCoroutine (Seq (Double,Double,Double)) fsingle r xstate cvsInfo = penMoveAndUpOnly r pnum geometry - (penProcess cid pnum geometry connidmove connidup pdraw (x0,y0))- (\(x,y) -> do + (penProcess cid pnum geometry connidmove connidup pdraw ((x0,y0),z0))+ (\(pcoord,(x,y)) -> do + let PointerCoord _ _ _ z = pcoord let canvas = get drawArea cvsInfo ptype = get (penType.penInfo) xstate pcolor = get (penColor.currentTool.penInfo) xstate @@ -141,8 +140,12 @@ HighlighterWork -> predefined_highlighter_opacity _ -> 1.0 pcolRGBA = (pcr,pcg,pcb,pca*opacity) - liftIO $ drawCurvebit canvas geometry pwidth pcolRGBA pnum (x0,y0) (x,y)- penProcess cid pnum geometry connidmove connidup (pdraw |> (x,y)) (x,y) )+ let pressureType = case get (variableWidthPen.penInfo) xstate of + True -> Pressure+ False -> NoPressure+ liftIO $ drawCurvebitGen pressureType canvas geometry + pwidth pcolRGBA pnum ((x0,y0),z0) ((x,y),z)+ penProcess cid pnum geometry connidmove connidup (pdraw |> (x,y,z)) ((x,y),z) ) (\_ -> disconnect connidmove >> disconnect connidup >> return pdraw ) -- | @@ -150,11 +153,11 @@ skipIfNotInSamePage :: Monad m => PageNum -> CanvasGeometry -> PointerCoord -> m a - -> ((Double,Double) -> m a)+ -> ((PointerCoord,(Double,Double)) -> m a) -> m a skipIfNotInSamePage pgn geometry pcoord skipaction ordaction = switchActionEnteringDiffPage pgn geometry pcoord - skipaction (\_ _ -> skipaction ) (\_ (_,PageCoord xy)->ordaction xy) + skipaction (\_ _ -> skipaction ) (\_ (_,PageCoord xy)->ordaction (pcoord,xy)) -- | @@ -178,7 +181,7 @@ -> PageNum -> CanvasGeometry -> m a - -> ((Double,Double) -> m a) + -> ((PointerCoord,(Double,Double)) -> m a) -> (PointerCoord -> m a) -> m a penMoveAndUpOnly r pgn geometry defact moveaction upaction =
lib/Application/HXournal/Coroutine/Scroll.hs view
@@ -98,7 +98,7 @@ xst <- getSt geometry <- liftIO (getCanvasGeometry xst) case ev of- VScrollBarMoved cid' v -> do + VScrollBarMoved _cid' v -> do updateXState $ return.modifyCurrentCanvasInfo (selectBox (scrollmovecanvas v) (scrollmovecanvasCont geometry v)) invalidateWithBuf cid
lib/Application/HXournal/Coroutine/Select.hs view
@@ -33,13 +33,11 @@ import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Select import Application.HXournal.ModelAction.Layer -import Application.HXournal.Util import Control.Monad import Control.Monad.Identity import Control.Monad.Trans import Control.Monad.Coroutine.SuspensionFunctors import Control.Category-import Control.Applicative import Data.Label import Prelude hiding ((.), id) import Data.Xournal.Simple (Dimension(..))@@ -56,7 +54,6 @@ import Graphics.Xournal.Render.BBoxMapPDF import Graphics.Xournal.Render.HitTest import Graphics.Xournal.Render.BBox-import Graphics.Xournal.Render.Simple import Graphics.Xournal.Render.Generic -- |@@ -77,6 +74,19 @@ return tempselection +-- | For Selection mode from pen mode with 2nd pen button+ +dealWithOneTimeSelectMode :: MainCoroutine () -> MainCoroutine ()+dealWithOneTimeSelectMode action = do + xstate <- getSt + case get isOneTimeSelectMode xstate of + NoOneTimeSelectMode -> action + YesBeforeSelect -> + action >> updateXState (return . set isOneTimeSelectMode YesAfterSelect)+ YesAfterSelect -> do + updateXState (return . set isOneTimeSelectMode NoOneTimeSelectMode) + modeChange ToViewAppendMode+ -- | main mouse pointer click entrance in rectangular selection mode. -- choose either starting new rectangular selection or move previously -- selected selection. @@ -86,11 +96,12 @@ where rectaction cinfo pnum geometry (cidup,cidmove) (x,y) = do strs <- getAllStrokeBBoxInCurrentLayer ctime <- liftIO $ getCurrentTime- let newSelectAction page = do - tsel <- createTempSelectRender pnum geometry page [] - newSelectRectangle cid pnum geometry cidmove cidup strs - (x,y) ((x,y),ctime) tsel- surfaceFinish (tempSurface tsel) + let newSelectAction page = + dealWithOneTimeSelectMode $ do + tsel <- createTempSelectRender pnum geometry page [] + newSelectRectangle cid pnum geometry cidmove cidup strs + (x,y) ((x,y),ctime) tsel+ surfaceFinish (tempSurface tsel) let action (Right tpage) | hitInHandle tpage (x,y) = case getULBBoxFromSelected tpage of @@ -131,7 +142,7 @@ (moveact xstate cinfo) (upact xstate cinfo) defact = newSelectRectangle cid pnum geometry connidmove connidup strs orig (prev,otime) tempselection - moveact xstate cinfo (x,y) = do + moveact _xstate _cinfo (_pcoord,(x,y)) = do let bbox = BBox orig (x,y) hittestbbox = mkHitTestInsideBBox bbox strs hittedstrs = concat . map unHitted . getB $ hittestbbox@@ -162,14 +173,15 @@ (ncoord,ntime) tempselection { tempSelectInfo = hittedstrs } upact xstate cinfo pcoord = do - let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord - (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord + (_,(x,y)) = runIdentity $ + skipIfNotInSamePage pnum geometry pcoord + (return (pcoord,prev)) return let epage = getCurrentPageEitherFromXojState cinfo (get xournalstate xstate) cpn = get currentPageNum cinfo let bbox = BBox orig (x,y) hittestbbox = mkHitTestInsideBBox bbox strs selectstrs = fmapAL unNotHitted id hittestbbox- xstate <- getSt let SelectState txoj = get xournalstate xstate newpage = case epage of Left pagebbox -> makePageSelectMode pagebbox selectstrs @@ -229,7 +241,7 @@ penMoveAndUpInterPage r pnum geometry defact (moveact xstate cinfo) (upact xstate cinfo) defact = moveSelect cid pnum geometry connidmove connidup orig (prev,otime) tempselection- moveact xstate cinfo oldpgn pcpair@(newpgn,pgxy@(PageCoord (px,py))) = do + moveact _xstate _cinfo oldpgn pcpair@(newpgn,PageCoord (px,py)) = do let (x,y) | oldpgn == newpgn = (px,py) | otherwise = @@ -248,17 +260,12 @@ (b1',b2') = xform (sfunc (0,1)) (b1,b2) = (b1'-c1,b2'-c2) xformmat = Mat.Matrix a1 a2 b1 b2 c1 c2 -{- (c1,c2) = (x-x0,y-y0)- (a1,a2) = (1,0)- (b1,b2) = (0,1)- xformmat = Mat.Matrix a1 a2 b1 b2 c1 c2 -} invalidateTempBasePage cid (tempSurface tempselection) pnum (drawTempSelectImage geometry tempselection xformmat) - -- (translate (x-x0) (y-y0))) moveSelect cid pnum geometry connidmove connidup orig (ncoord,ntime) tempselection upact :: (ViewMode a) => HXournalState -> CanvasInfo a -> PointerCoord -> MainCoroutine () - upact xst cinfo pcoord = + upact xst cinfo pcoord = switchActionEnteringDiffPage pnum geometry pcoord (return ()) (chgaction xst cinfo) (ordaction xst cinfo)@@ -360,7 +367,7 @@ fsingle r xstate cinfo = penMoveAndUpOnly r pnum geometry defact (moveact xstate cinfo) (upact xstate cinfo) defact = resizeSelect handle cid pnum geometry connidmove connidup origbbox (prev,otime) tempselection- moveact xstate cinfo (x,y) = do + moveact _xstate _cinfo (_pcoord,(x,y)) = do (willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y) when willUpdate $ do let newbbox = getNewBBoxFromHandlePos handle origbbox (x,y) @@ -379,8 +386,10 @@ resizeSelect handle cid pnum geometry connidmove connidup origbbox (ncoord,ntime) tempselection upact xstate cinfo pcoord = do - let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord - (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord + (_,(x,y)) = runIdentity $ + skipIfNotInSamePage pnum geometry pcoord + (return (pcoord,prev)) return newbbox = getNewBBoxFromHandlePos handle origbbox (x,y) xojstate@(SelectState txoj) = get xournalstate xstate epage = getCurrentPageEitherFromXojState cinfo xojstate@@ -528,11 +537,12 @@ where lassoAction cinfo pnum geometry (cidup,cidmove) (x,y) = do strs <- getAllStrokeBBoxInCurrentLayer ctime <- liftIO $ getCurrentTime- let newSelectAction page = do - tsel <- createTempSelectRender pnum geometry page [] - newSelectLasso cinfo pnum geometry cidmove cidup strs - (x,y) ((x,y),ctime) (Sq.empty |> (x,y)) tsel- surfaceFinish (tempSurface tsel) + let newSelectAction page = + dealWithOneTimeSelectMode $ do + tsel <- createTempSelectRender pnum geometry page [] + newSelectLasso cinfo pnum geometry cidmove cidup strs + (x,y) ((x,y),ctime) (Sq.empty |> (x,y)) tsel+ surfaceFinish (tempSurface tsel) let action (Right tpage) | hitInSelection tpage (x,y) = startMoveSelect cid pnum geometry cidmove cidup ((x,y),ctime) tpage action (Right tpage) | hitInHandle tpage (x,y) = @@ -551,8 +561,6 @@ let epage = getCurrentPageEitherFromXojState cinfo xojstate action epage - - -- | newSelectLasso :: (ViewMode a) => CanvasInfo a@@ -573,7 +581,7 @@ (moveact cinfo) (upact cinfo) defact = newSelectLasso cvsInfo pnum geometry cidmove cidup strs orig (prev,otime) lasso tsel- moveact cinfo (x,y) = do + moveact cinfo (_pcoord,(x,y)) = do let nlasso = lasso |> (x,y) (willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y) when willUpdate $ do @@ -582,16 +590,17 @@ (ncoord,ntime) nlasso tsel upact cinfo pcoord = do xstate <- getSt - let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord - (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return+ let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord + (_,(x,y)) = runIdentity $ + skipIfNotInSamePage pnum geometry pcoord + (return (pcoord,prev)) return nlasso = lasso |> (x,y) xojstate = get xournalstate xstate - let epage = getCurrentPageEitherFromXojState cinfo xojstate+ epage = getCurrentPageEitherFromXojState cinfo xojstate cpn = get currentPageNum cinfo - let hittestlasso = mkHitTestAL (hitLassoStroke (nlasso |> orig)) strs+ hittestlasso = mkHitTestAL (hitLassoStroke (nlasso |> orig)) strs selectstrs = fmapAL unNotHitted id hittestlasso- xstate <- getSt - let SelectState txoj = get xournalstate xstate+ SelectState txoj = get xournalstate xstate newpage = case epage of Left pagebbox -> let (mcurrlayer,npagebbox) = getCurrentLayerOrSet pagebbox
lib/Application/HXournal/Coroutine/Window.hs view
@@ -15,10 +15,12 @@ module Application.HXournal.Coroutine.Window where import Application.HXournal.Type.Canvas+import Application.HXournal.Type.Event import Application.HXournal.Type.Window import Application.HXournal.Type.XournalState import Application.HXournal.Type.Coroutine import Application.HXournal.Type.PageArrangement+import Application.HXournal.Type.Predefined import Application.HXournal.Util import Control.Monad.Trans import Application.HXournal.ModelAction.Window@@ -26,39 +28,74 @@ import Application.HXournal.Coroutine.Page import Application.HXournal.Coroutine.Draw import Application.HXournal.Accessor+import Control.Monad.Coroutine.SuspensionFunctors import Control.Category import Data.Label import Graphics.UI.Gtk hiding (get,set)-import Graphics.Rendering.Cairo import qualified Data.IntMap as M import Data.Maybe+import Data.Time.Clock import Data.Xournal.Simple (Dimension(..)) import Data.Xournal.Generic import Prelude hiding ((.),id) --- | +-- | canvas configure with general zoom update func -canvasConfigure :: CanvasId -> CanvasDimension -> MainCoroutine () -canvasConfigure cid cdim@(CanvasDimension (Dim w' h')) = do - xstate <- getSt - let cinfobox = getCanvasInfo cid xstate- xstate' <- selectBoxAction (fsingle xstate) (fcont xstate) cinfobox- putSt xstate'- canvasZoomUpdateAll - where cdim = CanvasDimension (Dim w' h')- fsingle :: HXournalState -> CanvasInfo SinglePage -> MainCoroutine HXournalState- fsingle xstate cinfo = do +canvasConfigureGenUpdate :: MainCoroutine () + -> CanvasId + -> CanvasDimension + -> MainCoroutine () +canvasConfigureGenUpdate updatefunc cid cdim + = (updateXState $ selectBoxAction fsingle fcont . getCanvasInfo cid )+ >> updatefunc + -- canvasZoomUpdateAll + where -- cdim = CanvasDimension (Dim w' h')+ fsingle cinfo = do + xstate <- getSt let cinfo' = updateCanvasDimForSingle cdim cinfo return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate- fcont xstate cinfo = do + fcont cinfo = do + xstate <- getSt page <- getCurrentPageCvsId cid let pdim = PageDimension (get g_dimension page) let cinfo' = updateCanvasDimForContSingle pdim cdim cinfo return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate + +-- | +doCanvasConfigure :: CanvasId + -> CanvasDimension + -> MainCoroutine () +doCanvasConfigure = canvasConfigureGenUpdate canvasZoomUpdateAll ++ -- fsingle :: CanvasInfo SinglePage -> MainCoroutine HXournalState+ {- xstate <- getSt + let cinfobox = getCanvasInfo cid xstate -}+ {- xstate' <- -} + -- putSt xstate' + + -- | +canvasConfigure' :: CanvasId -> CanvasDimension -> MainCoroutine () +canvasConfigure' cid cdim = do -- @(CanvasDimension (Dim w' h')) = do + xstate <- getSt + ctime <- liftIO getCurrentTime + maybe defaction (chkaction ctime) (get lastTimeCanvasConfigure xstate) + where defaction = do + ntime <- liftIO getCurrentTime+ doCanvasConfigure cid cdim + updateXState (return . set lastTimeCanvasConfigure (Just ntime)) + chkaction ctime otime = do + let dtime = diffUTCTime ctime otime + if dtime > predefinedWinReconfTimeBound+ then defaction + else return ()+++-- | + eitherSplit :: SplitType -> MainCoroutine () eitherSplit stype = do xstate <- getSt@@ -84,7 +121,7 @@ putSt xstate3 liftIO $ boxPackEnd rtcntr win PackGrow 0 liftIO $ widgetShowAll rtcntr - (xstate4,wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)+ (xstate4,_wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3) xstate5 <- liftIO $ updatePageAll (get xournalstate xstate4) xstate4 putSt xstate5 canvasZoomUpdateAll@@ -105,7 +142,7 @@ Right Nothing -> return () Right (Just fstate') -> do case maybeError "deleteCanvas" (M.lookup currcid cmap) of- CanvasInfoBox oldcinfo -> do + CanvasInfoBox _oldcinfo -> do let cmap' = M.delete currcid cmap newcurrcid = maximum (M.keys cmap') xstate0 <- changeCurrentCanvasId newcurrcid @@ -121,9 +158,32 @@ putSt xstate3 liftIO $ boxPackEnd rtcntr win PackGrow 0 liftIO $ widgetShowAll rtcntr - (xstate4,wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3)+ (xstate4,_wconf) <- liftIO $ eventConnect xstate3 (get frameState xstate3) canvasZoomUpdateAll xstate5 <- liftIO $ updatePageAll (get xournalstate xstate4) xstate4 putSt xstate5 invalidateAll +-- | ++paneMoveStart :: MainCoroutine () +paneMoveStart = do + ev <- await + case ev of + UpdateCanvas cid -> invalidateWithBuf cid >> paneMoveStart + PaneMoveEnd -> return () + CanvasConfigure cid w' h'-> + canvasConfigureGenUpdate canvasZoomUpdateBufAll cid (CanvasDimension (Dim w' h')) + >> paneMoveStart+ _ -> paneMoveStart+ +++-- | ++paneMoved :: MainCoroutine () +paneMoved = do + liftIO $ putStrLn "pane moved called"+ + +
lib/Application/HXournal/Device.hsc view
@@ -19,38 +19,49 @@ import Application.HXournal.Config import Data.Configurator.Types- import Control.Applicative import Control.Monad.Reader- import Foreign.Marshal.Utils import Foreign.Ptr import Foreign.C import Foreign.Storable- import Graphics.UI.Gtk-- import Data.Int +-- | + data PointerType = Core | Stylus | Eraser deriving (Show,Eq,Ord) +-- |++data PenButton = PenButton1 | PenButton2 | PenButton3 + deriving (Show,Eq,Ord)++-- | + data DeviceList = DeviceList { dev_core :: CInt , dev_stylus :: CInt , dev_eraser :: CInt } deriving Show +-- | + data PointerCoord = PointerCoord { pointerType :: PointerType , pointerX :: Double - , pointerY :: Double } + , pointerY :: Double + , pointerZ :: Double+ } | NoPointerCoord deriving (Show,Eq,Ord) +-- | foreign import ccall "c_initdevice.h initdevice" c_initdevice :: Ptr CInt -> Ptr CInt -> Ptr CInt -> CString -> CString -> CString -> IO () +-- | + initDevice :: Config -> IO DeviceList initDevice cfg = do (mcore,mstylus,meraser) <- getPenDevConfig cfg @@ -75,16 +86,22 @@ eraser_val <- peek peraser return $ DeviceList core_val stylus_val eraser_val +-- | -getPointer :: DeviceList -> EventM t PointerCoord+getPointer :: DeviceList -> EventM t (Maybe PenButton,PointerCoord) getPointer devlst = do ptr <- ask - (_ty,x,y,mdev,maxf) <- liftIO (getInfo ptr)+ (_ty,btn,x,y,mdev,maxf) <- liftIO (getInfo ptr)+ let rbtn | btn == 0 = Nothing + | btn == 1 = Just PenButton1+ | btn == 2 = Just PenButton2 + | btn == 3 = Just PenButton3+ | otherwise = Nothing case mdev of - Nothing -> return (PointerCoord Core x y)+ Nothing -> return (rbtn,PointerCoord Core x y 1.0) Just dev -> case maxf of - Nothing -> return (PointerCoord Core x y)- Just axf -> liftIO $ coord ptr x y dev axf + Nothing -> return (rbtn,PointerCoord Core x y 1.0)+ Just axf -> (,) rbtn <$> (liftIO $ coord ptr x y dev axf) where getInfo ptr = do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr)@@ -95,44 +112,49 @@ then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventButton, y} ptr+ (btn :: #{gtk2hs_type gint}) <- #{peek GdkEventButton, button} ptr (dev :: CInt) <- #{peek GdkEventButton, device} ptr let axisfunc = #{peek GdkEventButton, axes}- return (ty,realToFrac x,realToFrac y,Just dev,Just axisfunc)+ return (ty,btn,realToFrac x,realToFrac y,Just dev,Just axisfunc) else if ty `elem` [ #{const GDK_SCROLL} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventScroll, y} ptr (dev :: CInt) <- #{peek GdkEventScroll, device} ptr- return (ty,realToFrac x, realToFrac y,Just dev,Nothing)+ return (ty,0,realToFrac x, realToFrac y,Just dev,Nothing) else if ty `elem` [ #{const GDK_MOTION_NOTIFY} ] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventMotion, y} ptr (dev :: CInt) <- #{peek GdkEventMotion, device} ptr let axisfunc = #{peek GdkEventMotion, axes} - return (ty,realToFrac x, realToFrac y,Just dev,Just axisfunc)+ return (ty,0,realToFrac x, realToFrac y,Just dev,Just axisfunc) else if ty `elem` [ #{const GDK_ENTER_NOTIFY}, #{const GDK_LEAVE_NOTIFY}] then do (x :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, x} ptr (y :: #{gtk2hs_type gdouble}) <- #{peek GdkEventCrossing, y} ptr- return (ty, realToFrac x, realToFrac y,Nothing,Nothing)+ return (ty,0,realToFrac x, realToFrac y,Nothing,Nothing) else error ("eventCoordinates: none for event type "++show ty) coord ptr x y device axf - | device == dev_core devlst = return $ PointerCoord Core x y + | device == dev_core devlst = return $ PointerCoord Core x y 1.0 | device == dev_stylus devlst = do (ptrax :: Ptr CDouble ) <- axf ptr (wacomx :: Double) <- peekByteOff ptrax 0 (wacomy :: Double) <- peekByteOff ptrax 8- return $ PointerCoord Stylus wacomx wacomy + (wacomz :: Double) <- peekByteOff ptrax 16+ return $ PointerCoord Stylus wacomx wacomy wacomz | device == dev_eraser devlst = do (ptrax :: Ptr CDouble ) <- axf ptr (wacomx :: Double) <- peekByteOff ptrax 0 (wacomy :: Double) <- peekByteOff ptrax 8- return $ PointerCoord Eraser wacomx wacomy - | otherwise = return $ PointerCoord Core x y+ (wacomz :: Double) <- peekByteOff ptrax 16 + return $ PointerCoord Eraser wacomx wacomy wacomz + | otherwise = return $ PointerCoord Core x y 1.0 +-- | + wacomCoordConvert :: WidgetClass self => self -> (Double,Double) -> IO (Double,Double)@@ -142,6 +164,8 @@ screen <- widgetGetScreen canvas (ws,hs) <- (,) <$> screenGetWidth screen <*> screenGetHeight screen return (fromIntegral ws*x-fromIntegral x0,fromIntegral hs*y-fromIntegral y0)+ +-- | wacomPConvert :: WidgetClass self => self -> PointerCoord
lib/Application/HXournal/GUI.hs view
@@ -10,6 +10,7 @@ -- Stability : experimental -- Portability : GHC --+----------------------------------------------------------------------------- module Application.HXournal.GUI where @@ -26,21 +27,16 @@ import Application.HXournal.Coroutine -- import Application.HXournal.GUI.Menu import Application.HXournal.ModelAction.File -import Application.HXournal.ModelAction.Page import Application.HXournal.ModelAction.Window- import Graphics.UI.Gtk hiding (get,set)--import Control.Applicative import Control.Monad.Trans - import Data.IORef import Data.Maybe- import Control.Category import Data.Label import Prelude hiding ((.),id) +-- | startGUI :: Maybe FilePath -> IO () startGUI mfname = do
lib/Application/HXournal/GUI/Menu.hs view
@@ -10,6 +10,7 @@ -- Stability : experimental -- Portability : GHC --+----------------------------------------------------------------------------- module Application.HXournal.GUI.Menu where @@ -157,7 +158,8 @@ <menuitem action="PENFINEA" /> <menuitem action="PENMEDIUMA" /> <menuitem action="PENTHICKA" /> - <menuitem action="PENVERYTHICKA" /> + <menuitem action="PENVERYTHICKA" /> + <menuitem action="PENULTRATHICKA" /> </menu> <menuitem action="ERASROPTA" /> <menuitem action="HILTROPTA" /> @@ -292,7 +294,8 @@ , RadioActionEntry "PENFINEA" "Fine" (Just "mythin") Nothing Nothing 1 , RadioActionEntry "PENTHICKA" "Thick" (Just "mythick") Nothing Nothing 3 - , RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4 + , RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4 + , RadioActionEntry "PENULTRATHICKA" "Ultra Thick" Nothing Nothing Nothing 5 , RadioActionEntry "PENMEDIUMA" "Medium" (Just "mymedium") Nothing Nothing 2 ] @@ -455,7 +458,14 @@ -- AndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput) dcrdcorea <- actionNewAndRegister "DCRDCOREA" "Discard Core Events" (Just "Just a Stub") Nothing (justMenu MenuDiscardCoreEvents) ersrtipa <- actionNewAndRegister "ERSRTIPA" "Eraser Tip" (Just "Just a Stub") Nothing (justMenu MenuEraserTip)- pressrsensa <- actionNewAndRegister "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing (justMenu MenuPressureSensitivity)+ pressrsensa <- toggleActionNew "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing + pressrsensa `on` actionToggled $ do + bouncecallback tref sref (Menu MenuPressureSensitivity)+-- AndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput)++ + + pghilta <- actionNewAndRegister "PGHILTA" "Page Highlight" (Just "Just a Stub") Nothing (justMenu MenuPageHighlight) mltpgvwa <- actionNewAndRegister "MLTPGVWA" "Multiple Page View" (Just "Just a Stub") Nothing (justMenu MenuMultiplePageView) mltpga <- actionNewAndRegister "MLTPGA" "Multiple Pages" (Just "Just a Stub") Nothing (justMenu MenuMultiplePages)@@ -489,7 +499,7 @@ , shpreca, rulera, clra, penopta , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa+ , dcrdcorea, ersrtipa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa , abouta @@ -497,6 +507,8 @@ ] actionGroupAddAction agr uxinputa + actionGroupAddAction agr pressrsensa+ -- actionGroupAddRadioActions agr viewmods 0 (assignViewMode tref sref) actionGroupAddRadioActions agr viewmods 0 (const (return ())) @@ -515,7 +527,7 @@ , shpreca, rulera , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa+ , dcrdcorea, ersrtipa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa , abouta @@ -633,21 +645,25 @@ int2Point PenWork 2 = predefined_medium int2Point PenWork 3 = predefined_thick int2Point PenWork 4 = predefined_verythick+int2Point PenWork 5 = predefined_ultrathick int2Point HighlighterWork 0 = predefined_highlighter_veryfine int2Point HighlighterWork 1 = predefined_highlighter_fine int2Point HighlighterWork 2 = predefined_highlighter_medium int2Point HighlighterWork 3 = predefined_highlighter_thick int2Point HighlighterWork 4 = predefined_highlighter_verythick+int2Point HighlighterWork 5 = predefined_highlighter_ultrathick int2Point EraserWork 0 = predefined_eraser_veryfine int2Point EraserWork 1 = predefined_eraser_fine int2Point EraserWork 2 = predefined_eraser_medium int2Point EraserWork 3 = predefined_eraser_thick int2Point EraserWork 4 = predefined_eraser_verythick+int2Point EraserWork 5 = predefined_eraser_ultrathick int2Point TextWork 0 = predefined_veryfine int2Point TextWork 1 = predefined_fine int2Point TextWork 2 = predefined_medium int2Point TextWork 3 = predefined_thick int2Point TextWork 4 = predefined_verythick+int2Point TextWork 5 = predefined_ultrathick int2Point _ _ = error "No such point" int2Color :: Int -> PenColor
lib/Application/HXournal/ModelAction/Eraser.hs view
@@ -1,4 +1,3 @@- ----------------------------------------------------------------------------- -- | -- Module : Application.HXournal.ModelAction.Eraser @@ -9,10 +8,11 @@ -- Stability : experimental -- Portability : GHC --+-----------------------------------------------------------------------------+ module Application.HXournal.ModelAction.Eraser where import Control.Monad.State - import Data.Xournal.BBox import Graphics.Xournal.Render.Type import Graphics.Xournal.Render.HitTest
lib/Application/HXournal/ModelAction/File.hs view
@@ -15,28 +15,16 @@ module Application.HXournal.ModelAction.File where import Application.HXournal.Type.XournalState-import Application.HXournal.Type.Canvas-import Application.HXournal.ModelAction.Page-import Application.HXournal.Type.PageArrangement-import Application.HXournal.Util-import Data.Xournal.BBox-import qualified Text.Xournal.Parse as P-import qualified Data.IntMap as M+import qualified Text.Xournal.Parse.Enumerator as PE import Data.Maybe - import Control.Monad import Control.Category import Data.Label import Prelude hiding ((.),id)- import Data.Xournal.Simple-import Data.Xournal.Generic- import Graphics.Xournal.Render.BBoxMapPDF import Graphics.Xournal.Render.PDFBackground- import Graphics.UI.Gtk hiding (get,set)- import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C @@ -51,9 +39,14 @@ -> HXournalState -> IO HXournalState getFileContent (Just fname) xstate = do - xojcontent <- P.read_xournal fname - nxstate <- constructNewHXournalStateFromXournal xojcontent xstate - return $ set currFileName (Just fname) nxstate + -- xojcontent <- P.read_xournal fname + PE.parseXojFile fname >>= \x -> case x of + Left str -> do+ putStrLn $ "file reading error : " ++ str + return xstate + Right xojcontent -> do + nxstate <- constructNewHXournalStateFromXournal xojcontent xstate + return $ set currFileName (Just fname) nxstate getFileContent Nothing xstate = do newxoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF $ defaultXournal @@ -61,30 +54,30 @@ xstate' = set currFileName Nothing . set xournalstate newxojstate $ xstate + return xstate' + -- let dim = get g_dimension . maybeError "getFileContent" . M.lookup 0 . get g_pages -- $ newxoj -- let cvschange = setPage xstate' 0 -- modifyCurrCvsInfoM cvschange xstate'- return xstate' -- | constructNewHXournalStateFromXournal :: Xournal -> HXournalState -> IO HXournalState constructNewHXournalStateFromXournal xoj' xstate = do xoj <- mkTXournalBBoxMapPDFBufFromNoBuf <=< mkTXournalBBoxMapPDF $ xoj'- let dim = get g_dimension . maybeError "constructNewHxournalStateFromXournal" . M.lookup 0 - . get g_pages $ xoj- startingxojstate = ViewAppendState xoj- -- forSingle = set (pageDimension.pageArrangement.viewInfo) (PageDimension dim)- -- . set currentPageNum 0 - + let startingxojstate = ViewAppendState xoj return $ set xournalstate startingxojstate xstate--- cvschange = setPage xstate' 0 --- modifyCurrCvsInfoM cvschange xstate' - - -- rentCanvasInfo (selectBox forSingle (error "construct..."))- -- return $ setPage xstate' 0 xstate'++ -- dim = get g_dimension . maybeError "constructNewHxournalStateFromXournal" . M.lookup 0 + -- . get g_pages $ xoj+ -- forSingle = set (pageDimension.pageArrangement.viewInfo) (PageDimension dim)+ -- . set currentPageNum 0 + -- cvschange = setPage xstate' 0 + -- modifyCurrCvsInfoM cvschange xstate' + -- rentCanvasInfo (selectBox forSingle (error "construct..."))+ -- return $ setPage xstate' 0 xstate' -- |
lib/Application/HXournal/ModelAction/Page.hs view
@@ -23,7 +23,7 @@ import Control.Applicative import Control.Monad (liftM)-import Data.Xournal.BBox (moveBBoxToOrigin)+-- import Data.Xournal.BBox (moveBBoxToOrigin) import Data.Xournal.Simple (Dimension(..)) import Data.Xournal.Generic import Data.Xournal.Select@@ -131,8 +131,8 @@ let ulcoord = maybeError "updateCvsFromXoj" $ desktop2Page geometry (DeskCoord (xdesk,ydesk)) let cdim = canvasDim geometry - pg = getPageFromGXournalMap pagenum xoj - pdim = PageDimension $ get g_dimension pg+ -- pg = getPageFromGXournalMap pagenum xoj + -- pdim = PageDimension $ get g_dimension pg let arr = makeContinuousSingleArrangement zmode cdim xoj ulcoord ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr adjustmentSetUpper hadj w @@ -154,19 +154,10 @@ updatePage :: XournalState -> CanvasInfoBox -> IO CanvasInfoBox updatePage (ViewAppendState xojbbox) cinfobox = updateCvsInfoFrmXoj xojbbox cinfobox updatePage (SelectState txoj) cinfobox = selectBoxAction fsingle fcont cinfobox- where getselectedpage :: CanvasInfo a -> Either (Page EditMode) (Page SelectMode)- getselectedpage cinfo = - let pagenum = get currentPageNum cinfo - pgs = get g_selectAll txoj- pg = maybeError "??" (M.lookup pagenum pgs)- spg = case get g_selectSelected txoj of - Nothing -> Left pg - Just (spnum,tpg) -> if spnum == pagenum then Right tpg else Left pg- in spg- fsingle cinfo = do + where fsingle _cinfo = do let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj) updateCvsInfoFrmXoj xoj cinfobox- fcont cinfo = do + fcont _cinfo = do let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj) updateCvsInfoFrmXoj xoj cinfobox @@ -174,6 +165,17 @@ {- +-- getselectedpage :: CanvasInfo a -> Either (Page EditMode) (Page SelectMode)+ -- getselectedpage cinfo = + -- let pagenum = get currentPageNum cinfo + -- pgs = get g_selectAll txoj+ -- pg = maybeError "??" (M.lookup pagenum pgs)+ -- spg = case get g_selectSelected txoj of + -- Nothing -> Left pg + -- Just (spnum,tpg) -> if spnum == pagenum then Right tpg else Left pg+ -- in spg++ let pagenum = unboxGet currentPageNum cinfobox mspage = get g_selectSelected txoj @@ -229,7 +231,7 @@ let xoj = getXournal xstate geometry <- getCvsGeomFrmCvsInfo cinfo let cdim = canvasDim geometry - let pg = getPageFromGXournalMap (unPageNum pnum) xoj+ let -- pg = getPageFromGXournalMap (unPageNum pnum) xoj zmode = get (zoomMode.viewInfo) cinfo arr = makeContinuousSingleArrangement zmode cdim xoj (pnum,PageCoord (0,0)) return $ set currentPageNum (unPageNum pnum)@@ -252,7 +254,7 @@ 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 + -- pagekeylst = M.keys . get g_pages $ xoj (pagesbefore,pagesafter) = splitAt cpn pagelst npage = newSinglePageFromOld (head pagesafter) npagelst = pagesbefore ++ (npage : pagesafter)
lib/Application/HXournal/ModelAction/Pen.hs view
@@ -33,12 +33,13 @@ import Data.Xournal.Generic import Data.Xournal.BBox import Graphics.Xournal.Render.BBoxMapPDF-import Application.HXournal.View.Coordinate +-- | + addPDraw :: PenInfo -> TXournalBBoxMapPDFBuf -> PageNum - -> Seq (Double,Double) + -> Seq (Double,Double,Double) -> IO (TXournalBBoxMapPDFBuf,BBox) -- ^ new xournal and bbox in page coordinate addPDraw pinfo xoj (PageNum pgnum) pdraw = do @@ -46,16 +47,25 @@ pcolor = get (penColor.currentTool) pinfo pcolname = fromJust (M.lookup pcolor penColorNameMap) pwidth = get (penWidth.currentTool) pinfo+ pvwpen = get variableWidthPen pinfo (mcurrlayer,currpage) = getCurrentLayerOrSet (getPageFromGXournalMap pgnum xoj) currlayer = maybe (error "something wrong in addPDraw") id mcurrlayer - newstroke = Stroke { stroke_tool = case ptype of - PenWork -> "pen" - HighlighterWork -> "highlighter"- _ -> error "error in addPDraw"- , stroke_color = pcolname - , stroke_width = pwidth- , stroke_data = map (uncurry (:!:)) . toList $ pdraw- } + ptool = case ptype of + PenWork -> "pen" + HighlighterWork -> "highlighter"+ _ -> error "error in addPDraw"+ newstroke = + case pvwpen of + False -> Stroke { stroke_tool = ptool + , stroke_color = pcolname + , stroke_width = pwidth+ , stroke_data = map (\(x,y,_)->x:!:y) . toList $ pdraw+ } + True -> VWStroke { stroke_tool = ptool+ , stroke_color = pcolname + , stroke_vwdata = map (\(x,y,z)->(x,y,pwidth*z)) . toList $ pdraw+ }+ newstrokebbox = mkStrokeBBoxFromStroke newstroke bbox = strokebbox_bbox newstrokebbox newlayerbbox <- updateLayerBuf (Just bbox)
lib/Application/HXournal/ModelAction/Select.hs view
@@ -13,10 +13,9 @@ module Application.HXournal.ModelAction.Select where import Application.HXournal.Type.Enum-import Application.HXournal.Type.Canvas import Application.HXournal.Type.Alias+import Application.HXournal.Type.Predefined import Application.HXournal.Type.PageArrangement-import Application.HXournal.View.Draw import Application.HXournal.View.Coordinate import Application.HXournal.Util import Application.HXournal.ModelAction.Layer@@ -25,14 +24,14 @@ import Data.Monoid import Data.Xournal.Generic import Data.Xournal.BBox-import Data.Xournal.Simple (Dimension(..))+import Data.Xournal.Simple hiding (Page,Xournal) import Graphics.Xournal.Render.Type import Graphics.Xournal.Render.BBox import Graphics.Xournal.Render.BBoxMapPDF import Graphics.Xournal.Render.HitTest import Graphics.Xournal.Render.Simple import Graphics.Rendering.Cairo-import Graphics.Rendering.Cairo.Matrix (Matrix, invert, transformPoint )+import Graphics.Rendering.Cairo.Matrix ( invert, transformPoint ) import Graphics.UI.Gtk hiding (get,set) import Data.Time.Clock import Control.Monad@@ -81,13 +80,23 @@ -- | modify stroke using a function changeStrokeBy :: ((Double,Double)->(Double,Double)) -> StrokeBBox -> StrokeBBox-changeStrokeBy func (StrokeBBox t c w ds _bbox) = +changeStrokeBy func (StrokeBBox (Stroke t c w ds) _bbox) = let change ( x :!: y ) = let (nx,ny) = func (x,y) in nx :!: ny newds = map change ds - newbbox = mkbbox newds - in StrokeBBox t c w newds newbbox+ nstrk = Stroke t c w newds + newbbox = bboxFromStroke nstrk + in StrokeBBox nstrk newbbox+changeStrokeBy func (StrokeBBox (VWStroke t c ds) _bbox) = + let change (x,y,z) = let (nx,ny) = func (x,y) + in (nx,ny,z)+ newds = map change ds + nstrk = VWStroke t c newds + newbbox = bboxFromStroke nstrk + in StrokeBBox nstrk newbbox ++ getActiveLayer :: Page SelectMode -> Either [StrokeBBox] (TAlterHitted StrokeBBox) getActiveLayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . get g_layers @@ -240,11 +249,17 @@ changeStrokeColor :: PenColor -> StrokeBBox -> StrokeBBox changeStrokeColor pcolor str = let Just cname = Map.lookup pcolor penColorNameMap - in str { strokebbox_color = cname } + strsmpl = strokebbox_stroke str + in str { strokebbox_stroke = set s_color cname strsmpl } changeStrokeWidth :: Double -> StrokeBBox -> StrokeBBox-changeStrokeWidth pwidth str = str { strokebbox_width = pwidth } +changeStrokeWidth pwidth str = + let nstrsmpl = case strokebbox_stroke str of + Stroke t c _w d -> Stroke t c pwidth d+ VWStroke t c d -> Stroke t c pwidth (map (\(x,y,_z) -> (x:!:y)) d)+ in str { strokebbox_stroke = nstrsmpl } +-- str { strokebbox_width = pwidth } newtype CmpStrokeBBox = CmpStrokeBBox { unCmpStrokeBBox :: StrokeBBox } deriving Show@@ -329,7 +344,7 @@ hitLassoPoint lst = odd . mappingDegree lst hitLassoStroke :: Seq (Double,Double) -> StrokeBBox -> Bool -hitLassoStroke lst strk = all (\(x :!: y)-> hitLassoPoint lst (x,y)) $ strokebbox_data strk+hitLassoStroke lst = all (hitLassoPoint lst) . getXYtuples . strokebbox_stroke data TempSelectRender a = TempSelectRender { tempSurface :: Surface @@ -347,10 +362,10 @@ -- | mkStrokesNImage :: CanvasGeometry -> Page SelectMode -> IO StrokesNImage -mkStrokesNImage geometry tpage = do +mkStrokesNImage _geometry tpage = do let strs = getSelectedStrokes tpage drawselection = mapM_ (drawOneStroke.gToStroke) strs - Dim cw ch = get g_dimension tpage -- unCanvasDimension . canvasDim $ geometry + Dim cw ch = get g_dimension tpage mbbox = case getULBBoxFromSelected tpage of Middle bbox -> Just bbox _ -> Nothing @@ -407,9 +422,8 @@ fill renderfunc -dtime_bound :: NominalDiffTime -dtime_bound = realToFrac (picosecondsToDiffTime 100000000000)-+-- | + getNewCoordTime :: ((Double,Double),UTCTime) -> (Double,Double) -> IO (Bool,((Double,Double),UTCTime))
lib/Application/HXournal/ModelAction/Window.hs view
@@ -57,7 +57,7 @@ -- | only creating windows minimalCanvasInfo :: ViewMode a => HXournalState -> CanvasId -> IO (CanvasInfo a)-minimalCanvasInfo xstate cid = do +minimalCanvasInfo _xstate cid = do canvas <- drawingAreaNew scrwin <- scrolledWindowNew Nothing Nothing containerAdd scrwin canvas@@ -82,19 +82,20 @@ hadj = _horizAdjustment cinfo vadj = _vertAdjustment cinfo - sizereq <- canvas `on` sizeRequest $ return (Requisition 800 400) + _sizereq <- canvas `on` sizeRequest $ return (Requisition 800 400) - bpevent <- canvas `on` buttonPressEvent $ tryEvent $ do - p <- getPointer dev- liftIO (callback (PenDown cid p))- confevent <- canvas `on` configureEvent $ tryEvent $ do + _bpevent <- canvas `on` buttonPressEvent $ tryEvent $ do + (mbtn,p) <- getPointer dev+ let pbtn = maybe PenButton1 id mbtn+ liftIO (callback (PenDown cid pbtn p))+ _confevent <- canvas `on` configureEvent $ tryEvent $ do (w,h) <- eventSize liftIO $ callback (CanvasConfigure cid (fromIntegral w) (fromIntegral h))- brevent <- canvas `on` buttonReleaseEvent $ tryEvent $ do - p <- getPointer dev+ _brevent <- canvas `on` buttonReleaseEvent $ tryEvent $ do + (_,p) <- getPointer dev liftIO (callback (PenUp cid p))- exposeev <- canvas `on` exposeEvent $ tryEvent $ do + _exposeev <- canvas `on` exposeEvent $ tryEvent $ do liftIO $ callback (UpdateCanvas cid) {-@@ -125,11 +126,11 @@ v <- adjustmentGetValue vadj callback (VScrollBarMoved cid v) Just vscrbar <- scrolledWindowGetVScrollbar scrwin- bpevtvscrbar <- vscrbar `on` buttonPressEvent $ do + _bpevtvscrbar <- vscrbar `on` buttonPressEvent $ do v <- liftIO $ adjustmentGetValue vadj liftIO (callback (VScrollBarStart cid v)) return False- brevtvscrbar <- vscrbar `on` buttonReleaseEvent $ do + _brevtvscrbar <- vscrbar `on` buttonReleaseEvent $ do v <- liftIO $ adjustmentGetValue vadj liftIO (callback (VScrollBarEnd cid v)) return False@@ -197,7 +198,7 @@ -> IO (HXournalState,Widget,WindowConfig) constructFrame' template oxstate (Node cid) = do let ocmap = getCanvasInfoMap oxstate - (cinfobox,cmap,xstate) <- case M.lookup cid ocmap of + (cinfobox,_cmap,xstate) <- case M.lookup cid ocmap of Just cinfobox' -> return (cinfobox',ocmap,oxstate) Nothing -> do let cinfobox' = setCanvasId cid template @@ -212,7 +213,14 @@ constructFrame' template xstate (HSplit wconf1 wconf2) = do (xstate',win1,wconf1') <- constructFrame' template xstate wconf1 (xstate'',win2,wconf2') <- constructFrame' template xstate' wconf2 + let callback = get callBack xstate'' hpane' <- hPanedNew+ hpane' `on` buttonPressEvent $ do + liftIO (callback PaneMoveStart)+ return False + hpane' `on` buttonReleaseEvent $ do + liftIO (callback PaneMoveEnd)+ return False panedPack1 hpane' win1 True False panedPack2 hpane' win2 True False widgetShowAll hpane' @@ -220,7 +228,14 @@ constructFrame' template xstate (VSplit wconf1 wconf2) = do (xstate',win1,wconf1') <- constructFrame' template xstate wconf1 (xstate'',win2,wconf2') <- constructFrame' template xstate' wconf2 + let callback = get callBack xstate'' vpane' <- vPanedNew + vpane' `on` buttonPressEvent $ do + liftIO (callback PaneMoveStart)+ return False + vpane' `on` buttonReleaseEvent $ do + liftIO (callback PaneMoveEnd)+ return False panedPack1 vpane' win1 True False panedPack2 vpane' win2 True False widgetShowAll vpane'
lib/Application/HXournal/Type/Canvas.hs view
@@ -58,6 +58,7 @@ , currText , penType , penSet+, variableWidthPen -- * for box , getDrawAreaFromBox , unboxGet@@ -74,37 +75,39 @@ ) where import Application.HXournal.Type.Enum -import Application.HXournal.Type.Alias import Data.Sequence import qualified Data.IntMap as M import Control.Applicative ((<*>),(<$>)) import Control.Category import Data.Label import Prelude hiding ((.), id)- import Graphics.UI.Gtk hiding (get,set) import Data.Xournal.Simple (Dimension(..)) import Data.Xournal.BBox-import Data.Xournal.Generic import Data.Xournal.Predefined import Application.HXournal.Type.PageArrangement- import Control.Monad.Identity (Identity(..)) type CanvasId = Int +-- |+ data PenDraw = PenDraw { _points :: Seq (Double,Double) } deriving (Show) -emptyPenDraw :: PenDraw-emptyPenDraw = PenDraw empty-+-- | data ViewInfo a = (ViewMode a) => ViewInfo { _zoomMode :: ZoomMode , _pageArrangement :: PageArrangement a } +-- | ++emptyPenDraw :: PenDraw+emptyPenDraw = PenDraw empty++ -- | default view info with single page mode defaultViewInfoSinglePage :: ViewInfo SinglePage@@ -284,7 +287,9 @@ -- | data PenInfo = PenInfo { _penType :: PenType- , _penSet :: PenHighlighterEraserSet } + , _penSet :: PenHighlighterEraserSet + , _variableWidthPen :: Bool + } deriving (Show) -- | @@ -333,6 +338,7 @@ , _currHighlighter = defaultHighligherWCS , _currEraser = defaultEraserWCS , _currText = defaultTextWCS }+ , _variableWidthPen = False } $(mkLabels [''PenDraw, ''ViewInfo, ''PenInfo, ''PenHighlighterEraserSet, ''WidthColorStyle ])@@ -351,7 +357,7 @@ -> CanvasInfo SinglePage updateCanvasDimForSingle cdim@(CanvasDimension (Dim w' h')) cinfo = let zmode = get (zoomMode.viewInfo) cinfo- arr@(SingleArrangement _ pdim vbbox@(ViewPortBBox bbox)) + SingleArrangement _ pdim (ViewPortBBox bbox) = get (pageArrangement.viewInfo) cinfo (x,y) = bbox_upperleft bbox (sinvx,sinvy) = getRatioPageCanvas zmode pdim cdim @@ -367,7 +373,7 @@ -> CanvasInfo ContinuousSinglePage updateCanvasDimForContSingle pdim cdim@(CanvasDimension (Dim w' h')) cinfo = let zmode = get (zoomMode.viewInfo) cinfo- arr@(ContinuousSingleArrangement _ ddim func vbbox@(ViewPortBBox bbox)) + ContinuousSingleArrangement _ ddim func (ViewPortBBox bbox) = get (pageArrangement.viewInfo) cinfo (x,y) = bbox_upperleft bbox -- dim = get g_dimension . getPage $ cinfo
lib/Application/HXournal/Type/Event.hs view
@@ -16,10 +16,11 @@ import Application.HXournal.Device import Graphics.UI.Gtk + data MyEvent = Initialized | CanvasConfigure Int Double Double | UpdateCanvas Int- | PenDown Int PointerCoord+ | PenDown Int PenButton PointerCoord | PenMove Int PointerCoord | PenUp Int PointerCoord | PenColorChanged PenColor@@ -28,6 +29,8 @@ | VScrollBarMoved Int Double | VScrollBarStart Int Double | VScrollBarEnd Int Double+ | PaneMoveStart + | PaneMoveEnd | ToViewAppendMode | ToSelectMode | ToSinglePage
lib/Application/HXournal/Type/PageArrangement.hs view
@@ -125,7 +125,7 @@ makeContinuousSingleArrangement zmode cdim@(CanvasDimension (Dim cw ch)) xoj (pnum,PageCoord (xpos,ypos)) = let PageOrigin (_,y0) = maybeError "makeContSingleArr" $ pageArrFuncContSingle xoj pnum - dim@(Dim pw ph) = get g_dimension . head . gToList . get g_pages $ xoj+ dim = get g_dimension . head . gToList . get g_pages $ xoj (sinvx,sinvy) = getRatioPageCanvas zmode (PageDimension dim) cdim vport = ViewPortBBox (BBox (xpos,ypos+y0) (xpos+cw/sinvx,ypos+y0+ch/sinvy)) in ContinuousSingleArrangement cdim (deskDimContSingle xoj) (pageArrFuncContSingle xoj) vport @@ -133,7 +133,7 @@ -- | pageArrFuncContSingle :: Xournal EditMode -> PageNum -> Maybe PageOrigin -pageArrFuncContSingle xoj pnum@(PageNum n)+pageArrFuncContSingle xoj (PageNum n) | n < 0 = Nothing | n >= len = Nothing | otherwise = Just (PageOrigin (0,ys !! n))
lib/Application/HXournal/Type/Predefined.hs view
@@ -12,6 +12,16 @@ module Application.HXournal.Type.Predefined where +import Data.Time.Clock ++++dtime_bound :: NominalDiffTime +dtime_bound = realToFrac (picosecondsToDiffTime 100000000000)++predefinedWinReconfTimeBound :: NominalDiffTime+predefinedWinReconfTimeBound = realToFrac (picosecondsToDiffTime 50000000000)+ predefinedLassoColor :: (Double,Double,Double,Double) predefinedLassoColor = (1.0,116.0/255.0,0,0.8)
lib/Application/HXournal/Type/Window.hs view
@@ -14,7 +14,7 @@ import Application.HXournal.Type.Canvas -import Graphics.UI.Gtk hiding (get,set)+-- | data WindowConfig = Node CanvasId | HSplit WindowConfig WindowConfig
lib/Application/HXournal/Type/XournalState.hs view
@@ -16,6 +16,7 @@ ( XournalStateIO , XournalState(..) , HXournalState(..)+, IsOneTimeSelectMode(..) -- | labels , xournalstate , currFileName@@ -35,7 +36,9 @@ , isSaved , undoTable , isEventBlocked +, isOneTimeSelectMode , pageModeSignal+, lastTimeCanvasConfigure -- | others , emptyHXournalState , getXournal@@ -75,8 +78,8 @@ import Control.Monad.State hiding (get,modify) import Graphics.UI.Gtk hiding (Clipboard, get,set) import Data.Maybe+import Data.Time.Clock import Data.Label -import qualified Data.Label.Maybe as ML import Data.Xournal.Generic import qualified Data.IntMap as M @@ -88,6 +91,10 @@ data XournalState = ViewAppendState { unView :: TXournalBBoxMapPDFBuf } | SelectState { tempSelect :: TTempXournalSelectPDFBuf } +data IsOneTimeSelectMode = NoOneTimeSelectMode + | YesBeforeSelect + | YesAfterSelect+ deriving (Show,Eq,Ord) data HXournalState = HXournalState { _xournalstate :: XournalState@@ -108,7 +115,9 @@ , _isSaved :: Bool , _undoTable :: UndoTable XournalState , _isEventBlocked :: Bool+ , _isOneTimeSelectMode :: IsOneTimeSelectMode , _pageModeSignal :: Maybe (ConnectId RadioAction)+ , _lastTimeCanvasConfigure :: Maybe UTCTime -- , _networkClipboardInfo :: Maybe HXournalClipClientConfiguration } @@ -136,7 +145,9 @@ , _isSaved = False , _undoTable = emptyUndo 1 , _isEventBlocked = False + , _isOneTimeSelectMode = NoOneTimeSelectMode , _pageModeSignal = Nothing+ , _lastTimeCanvasConfigure = Nothing -- , _networkClipboardInfo = Nothing }
lib/Application/HXournal/View/Coordinate.hs view
@@ -31,9 +31,6 @@ import Application.HXournal.Type.PageArrangement import Application.HXournal.Type.Alias -import Debug.Trace-- -- | data structure for transformation among screen, canvas, desktop and page coordinates data CanvasGeometry = @@ -101,7 +98,7 @@ makeDesktop2Page :: (PageNum -> Maybe PageOrigin) -> DesktopCoordinate -> Maybe (PageNum, PageCoordinate) makeDesktop2Page pfunc (DeskCoord (x,y)) =- let (prev,next) = break (y<) . map (snd.unPageOrigin) . catMaybes+ let (prev,_next) = break (y<) . map (snd.unPageOrigin) . catMaybes . takeWhile isJust . map (pfunc.PageNum) $ [0..] in Just (PageNum (length prev-1),PageCoord (x,y- last prev)) @@ -159,12 +156,12 @@ -- | device2Desktop :: CanvasGeometry -> PointerCoord -> DesktopCoordinate -device2Desktop geometry (PointerCoord typ x y) = +device2Desktop geometry (PointerCoord typ x y _z) = case typ of Core -> core2Desktop geometry (x,y) Stylus -> wacom2Desktop geometry (x,y) Eraser -> wacom2Desktop geometry (x,y)-device2Desktop geometry NoPointerCoord = error "NoPointerCoordinate device2Desktop"+device2Desktop _geometry NoPointerCoord = error "NoPointerCoordinate device2Desktop" -- | @@ -177,7 +174,7 @@ pgcheck n pg = let Dim w h = get g_dimension pg DeskCoord ul = page2Desktop geometry (PageNum n,PageCoord (0,0)) DeskCoord lr = page2Desktop geometry (PageNum n,PageCoord (w,h))- nbbox = BBox ul lr + -- nbbox = BBox ul lr inbbox = Intersect (Middle (BBox ul lr)) result = ivbbox `mappend` inbbox in case result of @@ -189,29 +186,14 @@ -- | getCvsGeomFrmCvsInfo :: (ViewMode a) => - -- Page EditMode -> CanvasInfo a -> IO CanvasGeometry getCvsGeomFrmCvsInfo cinfo = do - let -- page = getPage cinfo- cpn = PageNum . get currentPageNum $ cinfo + let cpn = PageNum . get currentPageNum $ cinfo canvas = get drawArea cinfo arr = get (pageArrangement.viewInfo) cinfo - makeCanvasGeometry cpn arr canvas -- EditMode (cpn,page) arr canvas + makeCanvasGeometry cpn arr canvas ----- -- contained (ViewPortBBox bbox) (DeskCoord (x,y)) = hitTestBBoxPoint bbox (x,y) - {- contained vbbox ul || contained vbbox ur - || contained vbbox ll || contained vbbox lr -}- -- ur = page2Desktop geometry (PageNum n,PageCoord (w,0))- -- ll = page2Desktop geometry (PageNum n,PageCoord (0,h)) -{- trace (show n ++ ": " ++ show (intersectBBox bbox nbbox)- ++ "\nivbbox = " ++ show ivbbox - ++ "\ninbbox = " ++ show inbbox - ++ "\nresult = " ++ show result) $ -}
lib/Application/HXournal/View/Draw.hs view
@@ -16,10 +16,8 @@ import Graphics.UI.Gtk hiding (get) import Graphics.Rendering.Cairo--import Control.Applicative -import Control.Category (id,(.))-import Control.Monad (liftM,(<=<),when)+import Control.Category ((.))+import Control.Monad (when) import Data.Label import Prelude hiding ((.),id,mapM_,concatMap) import Data.Foldable@@ -28,6 +26,7 @@ import Data.Monoid import Data.Sequence import Data.Xournal.Simple (Dimension(..))+import Data.Xournal.Predefined import Data.Xournal.Generic import Data.Xournal.BBox import Graphics.Xournal.Render.Type@@ -37,19 +36,18 @@ import Graphics.Xournal.Render.Generic import Application.HXournal.Type.Canvas import Application.HXournal.Type.Alias -import Application.HXournal.Device import Application.HXournal.Util import Application.HXournal.Type.PageArrangement import Application.HXournal.Type.Predefined import Application.HXournal.Type.Enum import Application.HXournal.View.Coordinate-import Application.HXournal.ModelAction.Page ---- type DrawingFunction = forall a. (ViewMode a) => ViewInfo a -> Maybe BBox -> IO ()+-- | type family DrawingFunction v :: * -> * +-- |+ newtype SinglePageDraw a = SinglePageDraw { unSinglePageDraw :: Bool -> DrawingArea @@ -58,6 +56,7 @@ -> Maybe BBox -> IO () } +-- | newtype ContPageDraw a = ContPageDraw @@ -67,7 +66,12 @@ -> Xournal a -> IO () } +-- | + type instance DrawingFunction SinglePage = SinglePageDraw++-- | + type instance DrawingFunction ContinuousSinglePage = ContPageDraw -- | @@ -82,32 +86,25 @@ -- | getBBoxInPageCoord :: CanvasGeometry -> PageNum -> BBox -> BBox -getBBoxInPageCoord geometry pnum bbox@(BBox (x1,y1) (x2,y2)) = +getBBoxInPageCoord geometry pnum bbox = let DeskCoord (x0,y0) = page2Desktop geometry (pnum,PageCoord (0,0)) in moveBBoxByOffset (-x0,-y0) bbox -- | getViewableBBox :: CanvasGeometry - -- -> Maybe (PageNum, Maybe BBox) -- ^ in page coordinate -> Maybe BBox -- ^ in desktop coordinate -> IntersectBBox- -- Maybe BBox -- ^ in desktop coordinate-getViewableBBox geometry mbbox = -- (Just (pnum,mbbox)) = +getViewableBBox geometry mbbox = let ViewPortBBox vportbbox = getCanvasViewPort geometry in (fromMaybe mbbox :: IntersectBBox) `mappend` (Intersect (Middle vportbbox)) -{- getViewableBBox geometry Nothing = - let ViewPortBBox vportbbox = getCanvasViewPort geometry - in (Just vportbbox) -}-- -- | common routine for double buffering doubleBufferDraw :: DrawWindow -> CanvasGeometry -> Render () -> Render () -> IntersectBBox -> IO ()-doubleBufferDraw win geometry xform rndr (Intersect ibbox) = do +doubleBufferDraw win geometry _xform rndr (Intersect ibbox) = do let Dim cw ch = unCanvasDimension . canvasDim $ geometry mbbox' = case ibbox of Top -> Just (BBox (0,0) (cw,ch))@@ -141,31 +138,51 @@ translate x0 y0 scale sx sy +-- | + +data PressureMode = NoPressure | Pressure+ -- | -drawCurvebit :: DrawingArea - -> CanvasGeometry - -> Double - -> (Double,Double,Double,Double) - -> PageNum - -> (Double,Double) - -> (Double,Double) - -> IO () -drawCurvebit canvas geometry wdth (r,g,b,a) pnum (x0,y0) (x,y) = do +drawCurvebitGen :: PressureMode + -> DrawingArea + -> CanvasGeometry + -> Double + -> (Double,Double,Double,Double) + -> PageNum + -> ((Double,Double),Double) + -> ((Double,Double),Double) + -> IO () +drawCurvebitGen pmode canvas geometry wdth (r,g,b,a) pnum ((x0,y0),z0) ((x,y),z) = do win <- widgetGetDrawWindow canvas renderWithDrawable win $ do cairoXform4PageCoordinate geometry pnum setSourceRGBA r g b a- setLineWidth wdth- moveTo x0 y0- lineTo x y- stroke+ case pmode of + NoPressure -> do + setLineWidth wdth+ moveTo x0 y0+ lineTo x y+ stroke+ Pressure -> do + -- setLineWidth wdth+ let wx0 = 0.5*(fst predefinedPenShapeAspectXY)*wdth*z0+ wy0 = 0.5*(snd predefinedPenShapeAspectXY)*wdth*z0+ wx = 0.5*(fst predefinedPenShapeAspectXY)*wdth*z+ wy = 0.5*(snd predefinedPenShapeAspectXY)*wdth*z+ moveTo (x0-wx0) (y0-wy0)+ lineTo (x0+wx0) (y0+wy0)+ lineTo (x+wx) (y+wy)+ lineTo (x-wx) (y-wy)+ fill+ -- stroke + -- | drawFuncGen :: (GPageable em) => em -> ((PageNum,Page em) -> Maybe BBox -> Render ()) -> DrawingFunction SinglePage em-drawFuncGen typ render = SinglePageDraw func +drawFuncGen _typ render = SinglePageDraw func where func isCurrentCvs canvas (pnum,page) vinfo mbbox = do let arr = get pageArrangement vinfo geometry <- makeCanvasGeometry pnum arr canvas