hxournal 0.6.4.2 → 0.6.4.3
raw patch · 18 files changed
+422/−243 lines, 18 files
Files
- hxournal.cabal +1/−1
- lib/Application/HXournal/Accessor.hs +54/−18
- lib/Application/HXournal/Coroutine/Commit.hs +6/−6
- lib/Application/HXournal/Coroutine/Draw.hs +6/−5
- lib/Application/HXournal/Coroutine/Eraser.hs +2/−1
- lib/Application/HXournal/Coroutine/Layer.hs +5/−7
- lib/Application/HXournal/Coroutine/Mode.hs +4/−6
- lib/Application/HXournal/Coroutine/Page.hs +2/−35
- lib/Application/HXournal/Coroutine/Pen.hs +3/−8
- lib/Application/HXournal/Coroutine/Select.hs +119/−69
- lib/Application/HXournal/Coroutine/Window.hs +4/−1
- lib/Application/HXournal/ModelAction/Page.hs +19/−30
- lib/Application/HXournal/ModelAction/Select.hs +54/−9
- lib/Application/HXournal/ModelAction/Window.hs +2/−2
- lib/Application/HXournal/Type/Canvas.hs +110/−12
- lib/Application/HXournal/Type/XournalState.hs +15/−16
- lib/Application/HXournal/View/Coordinate.hs +11/−8
- lib/Application/HXournal/View/Draw.hs +5/−9
hxournal.cabal view
@@ -1,5 +1,5 @@ Name: hxournal-Version: 0.6.4.2+Version: 0.6.4.3 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal
lib/Application/HXournal/Accessor.hs view
@@ -36,6 +36,7 @@ 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 @@ -57,29 +58,65 @@ -- | -getPenType :: Iteratee MyEvent XournalStateIO PenType+getPenType :: MainCoroutine PenType -- Iteratee MyEvent XournalStateIO PenType getPenType = get (penType.penInfo) <$> lift (St.get) -- | +getCurrentPageCurr :: MainCoroutine (Page EditMode) +getCurrentPageCurr = do + xstate <- getSt + let xojstate = get xournalstate xstate+ cinfobox = get currentCanvasInfo xstate + case cinfobox of + CanvasInfoBox cinfo -> return (getCurrentPageFromXojState cinfo xojstate)++-- | ++getCurrentPageCvsId :: CanvasId -> MainCoroutine (Page EditMode) +getCurrentPageCvsId cid = do + xstate <- getSt + let xojstate = get xournalstate xstate+ cinfobox = getCanvasInfo cid xstate + case cinfobox of + CanvasInfoBox cinfo -> return (getCurrentPageFromXojState cinfo xojstate)++++-- | + +getCurrentPageEitherFromXojState :: (ViewMode a) => + CanvasInfo a -> XournalState + -> Either (Page EditMode) (Page SelectMode)+getCurrentPageEitherFromXojState cinfo xojstate = + let cpn = get currentPageNum cinfo + page = getCurrentPageFromXojState cinfo xojstate+ in case xojstate of + ViewAppendState xoj -> Left page+ SelectState txoj -> + case get g_selectSelected txoj of + Nothing -> Left page+ Just (n,tpage) -> if cpn == n + then Right tpage+ else Left page+ +++-- | + getAllStrokeBBoxInCurrentPage :: MainCoroutine [StrokeBBox] getAllStrokeBBoxInCurrentPage = do - xstate <- getSt - case get currentCanvasInfo xstate of- CanvasInfoBox currCvsInfo -> - let pagebbox = getPage currCvsInfo- in return [s| l <- gToList (get g_layers pagebbox), s <- get g_bstrokes l ]+ page <- getCurrentPageCurr+ return [s| l <- gToList (get g_layers page), s <- get g_bstrokes l ] +-- | getAllStrokeBBoxInCurrentLayer :: MainCoroutine [StrokeBBox] getAllStrokeBBoxInCurrentLayer = do - xstate <- getSt - case get currentCanvasInfo xstate of - CanvasInfoBox currCvsInfo -> do - let pagebbox = getPage currCvsInfo- (mcurrlayer, _currpage) = getCurrentLayerOrSet pagebbox- currlayer = maybe (error "getAllStrokeBBoxInCurrentLayer") id mcurrlayer- return (get g_bstrokes currlayer)+ page <- getCurrentPageCurr+ let (mcurrlayer, _currpage) = getCurrentLayerOrSet page+ currlayer = maybe (error "getAllStrokeBBoxInCurrentLayer") id mcurrlayer+ return (get g_bstrokes currlayer) otherCanvas :: HXournalState -> [Int] otherCanvas = M.keys . getCanvasInfoMap @@ -190,21 +227,21 @@ -- | -+{- unboxGetPage :: CanvasInfoBox -> (Page EditMode) unboxGetPage = either id (gcast :: Page SelectMode -> Page EditMode) . unboxGet currentPage+-} -- | getCanvasGeometryCvsId :: CanvasId -> HXournalState -> IO CanvasGeometry getCanvasGeometryCvsId cid xstate = do let cinfobox = getCanvasInfo cid xstate- page = unboxGetPage cinfobox cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry - fsingle = flip (makeCanvasGeometry EditMode (cpn,page)) canvas + fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo) boxAction fsingle cinfobox @@ -213,12 +250,11 @@ getCanvasGeometry :: HXournalState -> IO CanvasGeometry getCanvasGeometry xstate = do let cinfobox = get currentCanvasInfo xstate- page = unboxGetPage cinfobox cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry - fsingle = flip (makeCanvasGeometry EditMode (cpn,page)) canvas + fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo) boxAction fsingle cinfobox
lib/Application/HXournal/Coroutine/Commit.hs view
@@ -16,16 +16,14 @@ import Application.HXournal.Type.Coroutine import Application.HXournal.Type.Event import Application.HXournal.Type.Undo - import Application.HXournal.Coroutine.Draw import Application.HXournal.ModelAction.File import Application.HXournal.ModelAction.Page- import Data.Label import Control.Monad.Trans import Application.HXournal.Accessor -+-- | save state and add the current status in undo history commit :: HXournalState -> MainCoroutine () commit xstate = do @@ -39,9 +37,10 @@ $ xstate putSt xstate' +-- | + undo :: MainCoroutine () undo = do - liftIO $ putStrLn "undo is called" xstate <- getSt let utable = get undoTable xstate case getPrevUndo utable of @@ -53,10 +52,10 @@ =<< (liftIO (updatePageAll xojstate xstate)) invalidateAll +-- | redo :: MainCoroutine () redo = do - liftIO $ putStrLn "redo is called" xstate <- getSt let utable = get undoTable xstate case getNextUndo utable of @@ -68,9 +67,10 @@ =<< (liftIO (updatePageAll xojstate xstate)) invalidateAll +-- | + clearUndoHistory :: MainCoroutine () clearUndoHistory = do - liftIO $ putStrLn "clearUndoHistory is called" xstate <- getSt putSt . set undoTable (emptyUndo 1) $ xstate
lib/Application/HXournal/Coroutine/Draw.hs view
@@ -58,7 +58,8 @@ fsingle xstate cvsInfo = do let cpn = PageNum . get currentPageNum $ cvsInfo isCurrentCvs = cid == getCurrentCanvasId xstate- case get currentPage cvsInfo of + epage = getCurrentPageEitherFromXojState cvsInfo (get xournalstate xstate)+ case epage of Left page -> do liftIO (unSinglePageDraw drawf isCurrentCvs <$> get drawArea <*> pure (cpn,page) @@ -133,8 +134,8 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - let page = either id gcast $ get currentPage cvsInfo - canvas = get drawArea cvsInfo+ page <- getCurrentPageCvsId cid + let canvas = get drawArea cvsInfo vinfo = get viewInfo cvsInfo pnum = PageNum . get currentPageNum $ cvsInfo geometry <- liftIO $ getCanvasGeometry xstate@@ -156,8 +157,8 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - let page = either id gcast $ get currentPage cvsInfo - canvas = get drawArea cvsInfo+ page <- getCurrentPageCvsId cid + let canvas = get drawArea cvsInfo vinfo = get viewInfo cvsInfo geometry <- liftIO $ getCanvasGeometry xstate win <- liftIO $ widgetGetDrawWindow canvas
lib/Application/HXournal/Coroutine/Eraser.hs view
@@ -76,9 +76,10 @@ St.runState (hitTestStrokes line hittestbbox) False if hitState then do + page <- getCurrentPageCvsId cid let currxoj = unView . get xournalstate $ xstate pgnum = get currentPageNum cvsInfo- (mcurrlayer, currpage) = getCurrentLayerOrSet . getPage $ cvsInfo+ (mcurrlayer, currpage) = getCurrentLayerOrSet page currlayer = maybe (error "eraserProcess") id mcurrlayer let (newstrokes,maybebbox1) = St.runState (eraseHitted hitteststroke) Nothing maybebbox = fmap (flip inflate 2.0) maybebbox1
lib/Application/HXournal/Coroutine/Layer.hs view
@@ -33,11 +33,7 @@ import Control.Category import Data.Label import Prelude hiding ((.),id)--- import Data.IORef- import qualified Data.Sequence as Seq import Graphics.UI.Gtk hiding (get,set) @@ -48,7 +44,8 @@ selectBoxAction (fsingle xst) (fsingle xst) . get currentCanvasInfo $ xst where fsingle xstate cvsInfo = do- let epage = get currentPage cvsInfo+ let xojstate = get xournalstate xstate+ let epage = getCurrentPageEitherFromXojState cvsInfo xojstate cpn = get currentPageNum cvsInfo xojstate = get xournalstate xstate newxojstate <- either (action xojstate cpn) (action xojstate cpn . gcast) epage @@ -125,10 +122,11 @@ startGotoLayerAt :: MainCoroutine () startGotoLayerAt = selectBoxAction fsingle fsingle . get currentCanvasInfo =<< getSt- {- (error "startGotoLayerAt") -} where fsingle cvsInfo = do - let epage = get currentPage cvsInfo+ xstate <- getSt + let xojstate = get xournalstate xstate+ let epage = getCurrentPageEitherFromXojState cvsInfo xojstate page = either id gcast epage (_,currpage) = getCurrentLayerOrSet page Select (O (Just lyrzipper)) = get g_layers currpage
lib/Application/HXournal/Coroutine/Mode.hs view
@@ -25,7 +25,6 @@ import Application.HXournal.ModelAction.Page import Application.HXournal.Coroutine.Scroll import Application.HXournal.Coroutine.Draw---import Data.Foldable import Data.Traversable import Control.Applicative import Control.Monad.Trans@@ -77,10 +76,11 @@ whencont xstate cinfo = do geometry <- liftIO $ getCanvasGeometry xstate cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate + page <- getCurrentPageCurr let zmode = get (zoomMode.viewInfo) cinfo canvas = get drawArea cinfo cpn = PageNum . get currentPageNum $ cinfo - page = getPage cinfo+ pdim = PageDimension (get g_dimension page ) ViewPortBBox bbox = get (viewPortBBox.pageArrangement.viewInfo) cinfo (x0,y0) = bbox_upperleft bbox @@ -92,7 +92,6 @@ (get scrolledWindow cinfo) nvinfo (unPageNum cpn)- (Left page) (get horizAdjustment cinfo) (get vertAdjustment cinfo) (get horizAdjConnId cinfo)@@ -103,17 +102,17 @@ whensing xstate cinfo = do cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate + page <- getCurrentPageCurr let zmode = get (zoomMode.viewInfo) cinfo canvas = get drawArea cinfo cpn = PageNum . get currentPageNum $ cinfo - page = getPage cinfo (hadj,vadj) = get adjustments cinfo (xpos,ypos) <- liftIO $ (,) <$> adjustmentGetValue hadj <*> adjustmentGetValue vadj let arr = makeContinuousSingleArrangement zmode cdim (getXournal xstate) (cpn, PageCoord (xpos,ypos)) ContinuousSingleArrangement _ (DesktopDimension (Dim w h)) _ _ = arr - geometry <- liftIO $ makeCanvasGeometry EditMode (cpn,page) arr canvas+ geometry <- liftIO $ makeCanvasGeometry cpn arr canvas let DeskCoord (nxpos,nypos) = page2Desktop geometry (cpn,PageCoord (xpos,ypos)) let vinfo = get viewInfo cinfo nvinfo = ViewInfo (get zoomMode vinfo) arr @@ -122,7 +121,6 @@ (get scrolledWindow cinfo) nvinfo (get currentPageNum cinfo)- (get currentPage cinfo) hadj vadj (get horizAdjConnId cinfo)
lib/Application/HXournal/Coroutine/Page.hs view
@@ -102,8 +102,8 @@ fsingle xstate cinfo = do geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo + page <- getCurrentPageCvsId cid let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode - page = getPage cinfo pdim = PageDimension $ get g_dimension page cdim = canvasDim geometry narr = makeSingleArrangement zmode pdim cdim (0,0)@@ -114,9 +114,9 @@ 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 - page = getPage cinfo pdim = PageDimension $ get g_dimension page cdim = canvasDim geometry xoj = getXournal xstate @@ -141,39 +141,6 @@ cid <- (liftM (getCurrentCanvasId) getSt) canvasZoomUpdateCvsId cid mzmode -{- - updateXState zoomUpdateAction - >> adjustScrollbarWithGeometryCurrent- >> invalidateAll- where zoomUpdateAction xst = - selectBoxAction (fsingle xst) (fcont xst) . get currentCanvasInfo $ xst - - fsingle xstate cinfo = do - geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo - let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode - page = getPage cinfo - 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 . modifyCurrentCanvasInfo (const ncinfobox) $ xstate- - fcont xstate cinfo = do - geometry <- liftIO $ getCvsGeomFrmCvsInfo cinfo - let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode - cpn = PageNum $ get currentPageNum cinfo - page = getPage 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 . modifyCurrentCanvasInfo (const ncinfobox) $ xstate--} -- |
lib/Application/HXournal/Coroutine/Pen.hs view
@@ -57,11 +57,7 @@ return cinfo' where switchact xst = do let xoj = getXournal xst- let page = maybeError "no such page in penPageSwitch" - $ IM.lookup (unPageNum pgn) (get g_pages xoj)- ncinfo = set currentPageNum (unPageNum pgn)- . set currentPage (Left page) - $ cinfo+ ncinfo = set currentPageNum (unPageNum pgn) cinfo mfunc = const (return . CanvasInfoBox $ ncinfo) return . (,ncinfo) =<< modifyCurrCvsInfoM mfunc xst @@ -81,11 +77,10 @@ boxAction f . getCanvasInfo cid $ nxstate where f :: forall b. (ViewMode b) => CanvasInfo b -> MainCoroutine () f cvsInfo = do - let page = getPage cvsInfo- cpn = PageNum . get currentPageNum $ cvsInfo+ let cpn = PageNum . get currentPageNum $ cvsInfo arr = get (pageArrangement.viewInfo) cvsInfo canvas = get drawArea cvsInfo- geometry <- liftIO $ makeCanvasGeometry EditMode (cpn,page) arr canvas+ geometry <- liftIO $ makeCanvasGeometry cpn arr canvas let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord maybeFlip pagecoord (return ()) $ \(pgn,PageCoord (x,y)) -> do
lib/Application/HXournal/Coroutine/Select.hs view
@@ -46,6 +46,7 @@ import Data.Xournal.Generic import Data.Xournal.BBox import Graphics.Rendering.Cairo+import qualified Graphics.Rendering.Cairo.Matrix as Mat import Data.Monoid import qualified Data.IntMap as M import Data.Sequence (Seq,(|>))@@ -94,19 +95,22 @@ action (Right tpage) | hitInHandle tpage (x,y) = case getULBBoxFromSelected tpage of Middle bbox -> - maybe (return ()) (\handle -> do { tsel <- createTempSelectRender pnum geometry (gcast tpage :: Page EditMode) (getSelectedStrokes tpage); resizeSelect handle cid pnum geometry cidmove cidup bbox ((x,y),ctime) tsel ; surfaceFinish (tempSurface tsel) }) (checkIfHandleGrasped bbox (x,y))+ maybe (return ()) + (\handle -> startResizeSelect + handle cid pnum geometry cidmove cidup + bbox ((x,y),ctime) tpage)+ (checkIfHandleGrasped bbox (x,y)) _ -> return () action (Right tpage) | hitInSelection tpage (x,y) = do- tsel <- createTempSelectRender pnum geometry- (gcast tpage :: Page EditMode) (getSelectedStrokes tpage)- moveSelect cid pnum geometry cidmove cidup - (x,y) ((x,y),ctime) tsel - surfaceFinish (tempSurface tsel) - + startMoveSelect cid pnum geometry cidmove cidup ((x,y),ctime) tpage action (Right tpage) | otherwise = newSelectAction (gcast tpage :: Page EditMode ) action (Left page) = newSelectAction page- action (get currentPage cinfo) + xstate <- getSt + let xojstate = get xournalstate xstate + let epage = getCurrentPageEitherFromXojState cinfo xojstate + action epage +-- | newSelectRectangle :: CanvasId -> PageNum @@ -131,8 +135,8 @@ let bbox = BBox orig (x,y) hittestbbox = mkHitTestInsideBBox bbox strs hittedstrs = concat . map unHitted . getB $ hittestbbox- let page = either id gcast $ get currentPage cinfo - (fstrs,sstrs) = separateFS $ getDiffStrokeBBox (tempSelected tempselection) hittedstrs + page <- getCurrentPageCvsId cid+ let (fstrs,sstrs) = separateFS $ getDiffStrokeBBox (tempSelected tempselection) hittedstrs (willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y) when ((not.null) fstrs || (not.null) sstrs ) $ do let xformfunc = cairoXform4PageCoordinate geometry pnum @@ -160,7 +164,7 @@ upact xstate cinfo pcoord = do let pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord (x,y) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return- let epage = get currentPage cinfo + let epage = getCurrentPageEitherFromXojState cinfo (get xournalstate xstate) cpn = get currentPageNum cinfo let bbox = BBox orig (x,y) hittestbbox = mkHitTestInsideBBox bbox strs@@ -184,19 +188,25 @@ disconnect connidup invalidateAll -{- let (mcurrlayer,npagebbox) = getCurrentLayerOrSet pagebbox- currlayer = maybe (error "newSelectRectangle") id mcurrlayer - newlayer = GLayerBuf (get g_buffer currlayer) (TEitherAlterHitted (Right selectstrs))- tpg = gcast npagebbox - ls = get g_layers tpg - npg = tpg { glayers = ls { gselectedlayerbuf = newlayer} }- in npg -} -----+-- | prepare for moving selection + +startMoveSelect :: CanvasId + -> PageNum + -> CanvasGeometry + -> ConnectId DrawingArea+ -> ConnectId DrawingArea+ -> ((Double,Double),UTCTime) + -> Page SelectMode+ -> MainCoroutine () +startMoveSelect cid pnum geometry cidmove cidup ((x,y),ctime) tpage = do + strimage <- liftIO $ mkStrokesNImage geometry tpage+ tsel <- createTempSelectRender pnum geometry+ (gcast tpage :: Page EditMode) + strimage + moveSelect cid pnum geometry cidmove cidup (x,y) ((x,y),ctime) tsel + surfaceFinish (tempSurface tsel) + surfaceFinish (imageSurface strimage) -- | @@ -207,7 +217,7 @@ -> ConnectId DrawingArea -> (Double,Double) -> ((Double,Double),UTCTime)- -> TempSelection+ -> TempSelectRender StrokesNImage -> MainCoroutine () moveSelect cid pnum geometry connidmove connidup orig@(x0,y0) (prev,otime) tempselection = do@@ -229,11 +239,22 @@ (willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y) when willUpdate $ do - let strs = tempSelectInfo tempselection- newstrs = map (changeStrokeBy (offsetFunc (x-x0,y-y0))) strs- drawselection = do - mapM_ (drawOneStroke . gToStroke) newstrs - invalidateTempBasePage cid (tempSurface tempselection) pnum drawselection+ let sfunc = offsetFunc (x-x0,y-y0)+ xform = unCvsCoord . desktop2Canvas geometry+ . page2Desktop geometry . (,) pnum . PageCoord+ (c1,c2) = xform (sfunc (0,0))+ (a1',a2') = xform (sfunc (1,0))+ (a1,a2) = (a1'-c1,a2'-c2)+ (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 () @@ -243,8 +264,8 @@ (ordaction xst cinfo) chgaction :: (ViewMode a) => HXournalState -> CanvasInfo a -> PageNum -> (PageNum,PageCoordinate) -> MainCoroutine () chgaction xstate cinfo oldpgn (newpgn,PageCoord (x,y)) = do - let SelectState txoj = get xournalstate xstate- epage = get currentPage cinfo + let xojstate@(SelectState txoj) = get xournalstate xstate+ epage = getCurrentPageEitherFromXojState cinfo xojstate (xstate1,ntxoj1,selectedstrs) <- case epage of Right oldtpage -> do @@ -265,8 +286,7 @@ ntpage = makePageSelectMode npage alist coroutineaction = do ntxoj2 <- liftIO $ updateTempXournalSelectIO ntxoj1 ntpage (unPageNum newpgn) - let ncinfo = set currentPage (Right ntpage)- . set currentPageNum (unPageNum newpgn) $ cinfo + let ncinfo = set currentPageNum (unPageNum newpgn) $ cinfo cmap = getCanvasInfoMap xstate1 cmap' = M.adjust (const (CanvasInfoBox ncinfo)) cid cmap xst = maybe xstate1 id $ setCanvasInfoMap cmap' xstate1@@ -279,12 +299,10 @@ disconnect connidup invalidateAll - - ordaction xstate cinfo _pgn (_cpn,PageCoord (x,y)) = do let offset = (x-x0,y-y0)- SelectState txoj = get xournalstate xstate- epage = get currentPage cinfo + xojstate@(SelectState txoj) = get xournalstate xstate+ epage = getCurrentPageEitherFromXojState cinfo xojstate pagenum = get currentPageNum cinfo case epage of Right tpage -> do @@ -297,12 +315,31 @@ disconnect connidup invalidateAll ++-- | prepare for resizing selection - -- return () - -- runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return prev) return- -- penMoveAndUpOnly r pnum geometry defact (moveact xstate cinfo) (upact xstate cinfo) +startResizeSelect :: Handle + -> CanvasId + -> PageNum + -> CanvasGeometry + -> ConnectId DrawingArea+ -> ConnectId DrawingArea+ -> BBox+ -> ((Double,Double),UTCTime) + -> Page SelectMode+ -> MainCoroutine () +startResizeSelect handle cid pnum geometry cidmove cidup bbox + ((x,y),ctime) tpage = do + strimage <- liftIO $ mkStrokesNImage geometry tpage + tsel <- createTempSelectRender pnum geometry + (gcast tpage :: Page EditMode) + strimage + resizeSelect handle cid pnum geometry cidmove cidup bbox ((x,y),ctime) tsel + surfaceFinish (tempSurface tsel) + surfaceFinish (imageSurface strimage)+ --- |+-- | resizeSelect :: Handle -> CanvasId@@ -312,7 +349,7 @@ -> ConnectId DrawingArea -> BBox -> ((Double,Double),UTCTime)- -> TempSelection+ -> TempSelectRender StrokesNImage -> MainCoroutine () resizeSelect handle cid pnum geometry connidmove connidup origbbox (prev,otime) tempselection = do@@ -326,21 +363,27 @@ moveact xstate cinfo (x,y) = do (willUpdate,(ncoord,ntime)) <- liftIO $ getNewCoordTime (prev,otime) (x,y) when willUpdate $ do - let strs = tempSelectInfo tempselection+ let newbbox = getNewBBoxFromHandlePos handle origbbox (x,y) sfunc = scaleFromToBBox origbbox newbbox- newbbox = getNewBBoxFromHandlePos handle origbbox (x,y) - newstrs = map (changeStrokeBy sfunc) strs- drawselection = do - mapM_ (drawOneStroke . gToStroke) newstrs - invalidateTemp cid (tempSurface tempselection) drawselection+ xform = unCvsCoord . desktop2Canvas geometry+ . page2Desktop geometry . (,) pnum . PageCoord+ (c1,c2) = xform (sfunc (0,0))+ (a1',a2') = xform (sfunc (1,0))+ (a1,a2) = (a1'-c1,a2'-c2)+ (b1',b2') = xform (sfunc (0,1))+ (b1,b2) = (b1'-c1,b2'-c2)+ xformmat = Mat.Matrix a1 a2 b1 b2 c1 c2 + invalidateTemp cid (tempSurface tempselection) + (drawTempSelectImage geometry tempselection + xformmat) 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 newbbox = getNewBBoxFromHandlePos handle origbbox (x,y)- SelectState txoj = get xournalstate xstate- epage = get currentPage cinfo + xojstate@(SelectState txoj) = get xournalstate xstate+ epage = getCurrentPageEitherFromXojState cinfo xojstate pagenum = get currentPageNum cinfo case epage of Right tpage -> do @@ -389,9 +432,11 @@ copySelection = updateXState copySelectionAction >> invalidateAll where copySelectionAction xst = selectBoxAction (fsingle xst) (fsingle xst) . get currentCanvasInfo $ xst- fsingle xstate cinfo = maybe (return xstate) id $ - eitherMaybe (get currentPage cinfo) `pipe` getActiveLayer - `pipe` (Right . xstateadj . takeHittedStrokes)+ fsingle xstate cinfo = maybe (return xstate) id $ do + let xojstate = get xournalstate xstate+ let epage = getCurrentPageEitherFromXojState cinfo xojstate+ eitherMaybe epage `pipe` getActiveLayer + `pipe` (Right . xstateadj . takeHittedStrokes) where eitherMaybe (Left _) = Nothing eitherMaybe (Right a) = Just a x `pipe` a = x >>= eitherMaybe . a @@ -408,10 +453,11 @@ where pasteAction xst = boxAction (fsimple xst) . get currentCanvasInfo $ xst fsimple xstate cinfo = do - let SelectState txoj = get xournalstate xstate+ let xojstate@(SelectState txoj) = get xournalstate xstate clipstrs = getClipContents . get clipboard $ xstate pagenum = get currentPageNum cinfo - tpage = either gcast id (get currentPage cinfo)+ epage = getCurrentPageEitherFromXojState cinfo xojstate + tpage = either gcast id epage layerselect = gselectedlayerbuf . glayers $ tpage ls = glayers tpage gbuf = get g_buffer layerselect@@ -487,22 +533,28 @@ 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) = do- tsel <- createTempSelectRender - pnum geometry (gcast tpage :: Page EditMode)- (getSelectedStrokes tpage)- moveSelect (get canvasId cinfo) pnum geometry cidmove cidup - (x,y) ((x,y),ctime) 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) = case getULBBoxFromSelected tpage of Middle bbox -> - maybe (return ()) (\handle -> do { tsel <- createTempSelectRender pnum geometry (gcast tpage :: Page EditMode) (getSelectedStrokes tpage); resizeSelect handle cid pnum geometry cidmove cidup bbox ((x,y),ctime) tsel ; surfaceFinish (tempSurface tsel) }) (checkIfHandleGrasped bbox (x,y))+ maybe (return ()) + (\handle -> startResizeSelect + handle cid pnum geometry cidmove cidup + bbox ((x,y),ctime) tpage)+ (checkIfHandleGrasped bbox (x,y)) _ -> return () action (Right tpage) | otherwise = newSelectAction (gcast tpage :: Page EditMode ) action (Left page) = newSelectAction page- action (get currentPage cinfo) + xstate <- getSt + let xojstate = get xournalstate xstate + let epage = getCurrentPageEitherFromXojState cinfo xojstate + action epage + ++-- | + newSelectLasso :: (ViewMode a) => CanvasInfo a -> PageNum -> CanvasGeometry@@ -529,10 +581,12 @@ newSelectLasso cinfo pnum geometry cidmove cidup strs orig (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 nlasso = lasso |> (x,y)- let epage = get currentPage cinfo + xojstate = get xournalstate xstate + let epage = getCurrentPageEitherFromXojState cinfo xojstate cpn = get currentPageNum cinfo let hittestlasso = mkHitTestAL (hitLassoStroke (nlasso |> orig)) strs selectstrs = fmapAL unNotHitted id hittestlasso@@ -561,9 +615,5 @@ disconnect cidmove disconnect cidup invalidateAll ----
lib/Application/HXournal/Coroutine/Window.hs view
@@ -33,6 +33,7 @@ import qualified Data.IntMap as M import Data.Maybe import Data.Xournal.Simple (Dimension(..))+import Data.Xournal.Generic import Prelude hiding ((.),id) -- | @@ -50,7 +51,9 @@ let cinfo' = updateCanvasDimForSingle cdim cinfo return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate fcont xstate cinfo = do - let cinfo' = updateCanvasDimForContSingle cdim cinfo + page <- getCurrentPageCvsId cid+ let pdim = PageDimension (get g_dimension page)+ let cinfo' = updateCanvasDimForContSingle pdim cdim cinfo return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate
lib/Application/HXournal/ModelAction/Page.hs view
@@ -53,13 +53,17 @@ . xojstateEither +{- updatePageFromCanvasToXournal :: (ViewMode a) => CanvasInfo a -> XournalState -> XournalState updatePageFromCanvasToXournal cinfo xojstate = - let cpn = get currentPageNum cinfo - epg = get currentPage cinfo- page = either id gcast epg+ let cpn = get curentPageNum + page = getCurrentPageFromXojState cinfo xojstate + -- either id gcast epg in setPageMap (M.adjust (const page) cpn . getPageMap $ xojstate) xojstate + -- epg = get currentPage cinfo+-}+ -- | updatePageAll :: XournalState -> HXournalState -> IO HXournalState@@ -69,13 +73,9 @@ return $ maybe xstate id . setCanvasInfoMap cmap' . set xournalstate xojst $ xstate- --- return newxstate--- let cid = getCurrentCanvasId xstate --- cinfobox = maybeError "updatePageAll" (M.lookup cid cmap')- -- set currentCanvasInfo cinfobox- -- set currentCanvas (cid,cinfobox) +-- | + adjustPage :: XournalState -> CanvasInfoBox -> CanvasInfoBox adjustPage xojstate = selectBox fsingle fsingle where fsingle :: CanvasInfo a -> CanvasInfo a @@ -104,12 +104,10 @@ updateCvsInfoFrmXoj xoj cinfobox = selectBoxAction fsingle fcont cinfobox where fsingle cinfo = do let pagenum = get currentPageNum cinfo - page = getPage cinfo let oarr = get (pageArrangement.viewInfo) cinfo canvas = get drawArea cinfo zmode = get (zoomMode.viewInfo) cinfo- geometry <- makeCanvasGeometry EditMode (PageNum pagenum,page) - oarr canvas+ geometry <- makeCanvasGeometry (PageNum pagenum) oarr canvas let cdim = canvasDim geometry pg = getPageFromGXournalMap pagenum xoj pdim@(PageDimension (Dim w h)) = PageDimension $ get g_dimension pg@@ -120,19 +118,16 @@ adjustmentSetUpper vadj h return . CanvasInfoBox . set currentPageNum pagenum - . set (pageArrangement.viewInfo) arr- . set currentPage (Left pg) $ cinfo+ . set (pageArrangement.viewInfo) arr $ cinfo fcont cinfo = do let pagenum = get currentPageNum cinfo - page = getPage cinfo let oarr = get (pageArrangement.viewInfo) cinfo canvas = get drawArea cinfo zmode = get (zoomMode.viewInfo) cinfo (hadj,vadj) = get adjustments cinfo (xdesk,ydesk) <- (,) <$> adjustmentGetValue hadj <*> adjustmentGetValue vadj - geometry <- makeCanvasGeometry EditMode (PageNum pagenum,page)- oarr canvas + geometry <- makeCanvasGeometry (PageNum pagenum) oarr canvas let ulcoord = maybeError "updateCvsFromXoj" $ desktop2Page geometry (DeskCoord (xdesk,ydesk)) let cdim = canvasDim geometry @@ -144,8 +139,7 @@ adjustmentSetUpper vadj h return . CanvasInfoBox . set currentPageNum pagenum - . set (pageArrangement.viewInfo) arr- . set currentPage (Left pg) $ cinfo + . set (pageArrangement.viewInfo) arr $ cinfo @@ -171,13 +165,11 @@ in spg fsingle cinfo = do let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj)- CanvasInfoBox cinfo' <- updateCvsInfoFrmXoj xoj cinfobox- return . CanvasInfoBox . set currentPage (getselectedpage cinfo) $ cinfo' - + updateCvsInfoFrmXoj xoj cinfobox fcont cinfo = do let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj)- CanvasInfoBox cinfo' <- updateCvsInfoFrmXoj xoj cinfobox- return . CanvasInfoBox . set currentPage (getselectedpage cinfo) $ cinfo' + updateCvsInfoFrmXoj xoj cinfobox+ {- @@ -225,9 +217,7 @@ zmode = get (zoomMode.viewInfo) cinfo arr = makeSingleArrangement zmode pdim cdim (0,0) return $ set currentPageNum (unPageNum pnum)- . set (pageArrangement.viewInfo) arr- . set currentPage (Left pg)- $ cinfo + . set (pageArrangement.viewInfo) arr $ cinfo -- | setPageCont : in ContinuousSingle Page mode @@ -243,9 +233,8 @@ zmode = get (zoomMode.viewInfo) cinfo arr = makeContinuousSingleArrangement zmode cdim xoj (pnum,PageCoord (0,0)) return $ set currentPageNum (unPageNum pnum)- . set (pageArrangement.viewInfo) arr- . set currentPage (Left pg)- $ cinfo + . set (pageArrangement.viewInfo) arr $ cinfo + -- |
lib/Application/HXournal/ModelAction/Select.hs view
@@ -25,11 +25,14 @@ import Data.Monoid import Data.Xournal.Generic import Data.Xournal.BBox+import Data.Xournal.Simple (Dimension(..)) 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.UI.Gtk hiding (get,set) import Data.Time.Clock import Control.Monad@@ -88,18 +91,11 @@ getActiveLayer :: Page SelectMode -> Either [StrokeBBox] (TAlterHitted StrokeBBox) getActiveLayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . get g_layers -{- let ls = glayers tpage- slayer = gselectedlayerbuf ls- in et $ slayer -} getSelectedStrokes :: Page SelectMode -> [StrokeBBox] getSelectedStrokes = either (const []) (concatMap unHitted . getB) . getActiveLayer - {- let activelayer = getActiveLayer tpage - in case activelayer of - Left _ -> [] - Right alist -> concatMap unHitted . getB $ alist -} -- | start a select mode with alter list selection @@ -198,7 +194,6 @@ Middle bbox -> hitTestBBoxPoint bbox point _ -> False - -- any (flip hitTestBBoxPoint point) bboxes getULBBoxFromSelected :: Page SelectMode -> ULMaybe BBox getULBBoxFromSelected tpage = @@ -343,6 +338,56 @@ } type TempSelection = TempSelectRender [StrokeBBox]++data StrokesNImage = StrokesNImage { strokes :: [StrokeBBox]+ , strbbox :: Maybe BBox + , imageSurface :: Surface } +++-- | ++mkStrokesNImage :: CanvasGeometry -> Page SelectMode -> IO StrokesNImage +mkStrokesNImage geometry tpage = do + let strs = getSelectedStrokes tpage+ drawselection = mapM_ (drawOneStroke.gToStroke) strs + Dim cw ch = get g_dimension tpage -- unCanvasDimension . canvasDim $ geometry + mbbox = case getULBBoxFromSelected tpage of + Middle bbox -> Just bbox + _ -> Nothing + sfc <- createImageSurface FormatARGB32 (floor cw) (floor ch) + renderWith sfc $ do + setSourceRGBA 1 1 1 0 + rectangle 0 0 cw ch + fill + setSourceRGBA 0 0 0 1+ drawselection+ return $ StrokesNImage strs mbbox sfc++-- | + +drawTempSelectImage :: CanvasGeometry + -> TempSelectRender StrokesNImage + -> Matrix -- ^ transformation matrix+ -> Render ()+drawTempSelectImage geometry tempselection xformmat = do + let sfc = imageSurface (tempSelectInfo tempselection)+ CanvasDimension (Dim cw ch) = canvasDim geometry + invxformmat = invert xformmat + newvbbox = BBox (transformPoint invxformmat (0,0)) + (transformPoint invxformmat (cw,ch))+ mbbox = strbbox (tempSelectInfo tempselection)+ newmbbox = case unIntersect (Intersect (Middle newvbbox) `mappend` fromMaybe mbbox) of + Middle bbox -> Just bbox + _ -> Just newvbbox+ setMatrix xformmat+ clipBBox newmbbox+ setSourceSurface sfc 0 0 + setOperator OperatorOver+ paint ++++-- | tempSelected :: TempSelection -> [StrokeBBox] tempSelected = tempSelectInfo
lib/Application/HXournal/ModelAction/Window.hs view
@@ -66,7 +66,7 @@ scrolledWindowSetHAdjustment scrwin hadj scrolledWindowSetVAdjustment scrwin vadj -- scrolledWindowSetPolicy scrwin PolicyAutomatic PolicyAutomatic - return $ CanvasInfo cid canvas scrwin (error "no viewInfo" :: ViewInfo a) 0 (error "No page") hadj vadj Nothing Nothing+ return $ CanvasInfo cid canvas scrwin (error "no viewInfo" :: ViewInfo a) 0 hadj vadj Nothing Nothing -- | only connect events @@ -150,7 +150,7 @@ newcinfo <- minimalCanvasInfo xstate cid return $ newcinfo { _viewInfo = _viewInfo oldcinfo , _currentPageNum = _currentPageNum oldcinfo - , _currentPage = _currentPage oldcinfo } + } -- | event connect
lib/Application/HXournal/Type/Canvas.hs view
@@ -13,7 +13,65 @@ -- ----------------------------------------------------------------------------- -module Application.HXournal.Type.Canvas where+module Application.HXournal.Type.Canvas +( +-- * data types + CanvasId+, PenDraw (..)+, emptyPenDraw+, ViewInfo (..)+, CanvasInfo (..) +, CanvasInfoBox (..)+, CanvasInfoMap+, PenType (..) +, WidthColorStyle+, PenHighlighterEraserSet+, PenInfo+-- * default constructor +, defaultViewInfoSinglePage +, defaultCvsInfoSinglePage+, defaultPenWCS+, defaultEraserWCS+, defaultTextWCS+, defaultHighligherWCS+, defaultPenInfo+-- * lenses+, zoomMode +, pageArrangement +, canvasId+, drawArea +, scrolledWindow+, viewInfo+, currentPageNum +-- , currentPage+, horizAdjustment+, vertAdjustment+, horizAdjConnId +, vertAdjConnId+, adjustments +, currentTool +, penWidth+, penColor+, currPen+, currHighlighter+, currEraser+, currText+, penType+, penSet+-- * for box+, getDrawAreaFromBox+, unboxGet+, fmapBox +, boxAction+, selectBoxAction+, selectBox+, pageArrEitherFromCanvasInfoBox+, viewModeBranch+-- * others+-- , getPage+, updateCanvasDimForSingle+, updateCanvasDimForContSingle+) where import Application.HXournal.Type.Enum import Application.HXournal.Type.Alias @@ -47,6 +105,8 @@ , _pageArrangement :: PageArrangement a } +-- | default view info with single page mode+ defaultViewInfoSinglePage :: ViewInfo SinglePage defaultViewInfoSinglePage = ViewInfo { _zoomMode = Original @@ -55,6 +115,7 @@ (PageDimension (Dim 100 100)) (ViewPortBBox (BBox (0,0) (100,100))) } +-- | lens for zoomMode zoomMode :: ViewInfo a :-> ZoomMode zoomMode = lens _zoomMode (\a f -> f { _zoomMode = a } )@@ -69,7 +130,7 @@ , _scrolledWindow :: ScrolledWindow , _viewInfo :: ViewInfo a , _currentPageNum :: Int- , _currentPage :: Either (Page EditMode) (Page SelectMode)+ -- , _currentPage :: Either (Page EditMode) (Page SelectMode) , _horizAdjustment :: Adjustment , _vertAdjustment :: Adjustment , _horizAdjConnId :: Maybe (ConnectId Adjustment)@@ -83,7 +144,7 @@ , _scrolledWindow = error "ScrolledWindow" , _viewInfo = defaultViewInfoSinglePage , _currentPageNum = 0 - , _currentPage = error "currentPage" + -- , _currentPage = error "currentPage" , _horizAdjustment = error "adjustment" , _vertAdjustment = error "vadjust" , _horizAdjConnId = Nothing@@ -105,24 +166,31 @@ currentPageNum :: CanvasInfo a :-> Int currentPageNum = lens _currentPageNum (\a f -> f { _currentPageNum = a }) +{- currentPage :: CanvasInfo a :-> Either (Page EditMode) (Page SelectMode) currentPage = lens _currentPage (\a f -> f { _currentPage = a })+-} +-- | + horizAdjustment :: CanvasInfo a :-> Adjustment horizAdjustment = lens _horizAdjustment (\a f -> f { _horizAdjustment = a }) +-- | + vertAdjustment :: CanvasInfo a :-> Adjustment vertAdjustment = lens _vertAdjustment (\a f -> f { _vertAdjustment = a }) +-- | ConnectId for horizontal scrollbar value change event + horizAdjConnId :: CanvasInfo a :-> Maybe (ConnectId Adjustment ) horizAdjConnId = lens _horizAdjConnId (\a f -> f { _horizAdjConnId = a }) +-- | ConnectId for vertical scrollbar value change event + vertAdjConnId :: CanvasInfo a :-> Maybe (ConnectId Adjustment) vertAdjConnId = lens _vertAdjConnId (\a f -> f { _vertAdjConnId = a }) --- -- | adjustments :: CanvasInfo a :-> (Adjustment,Adjustment) @@ -133,20 +201,26 @@ data CanvasInfoBox = forall a. (ViewMode a) => CanvasInfoBox (CanvasInfo a) getDrawAreaFromBox :: CanvasInfoBox -> DrawingArea -getDrawAreaFromBox = unboxGet drawArea -- (CanvasInfoBox x) = get drawArea x +getDrawAreaFromBox = unboxGet drawArea +-- | + unboxGet :: (forall a. (ViewMode a) => CanvasInfo a :-> b) -> CanvasInfoBox -> b unboxGet f (CanvasInfoBox x) = get f x +-- | fmap-like operation for box+ fmapBox :: (forall a. (ViewMode a) => CanvasInfo a -> CanvasInfo a) -> CanvasInfoBox -> CanvasInfoBox fmapBox f (CanvasInfoBox cinfo) = CanvasInfoBox (f cinfo) +-- | boxAction :: Monad m => (forall a. ViewMode a => CanvasInfo a -> m b) -> CanvasInfoBox -> m b boxAction f (CanvasInfoBox cinfo) = f cinfo +-- | either-like operation selectBoxAction :: (Monad m) => (CanvasInfo SinglePage -> m a) @@ -156,6 +230,8 @@ SingleArrangement _ _ _ -> fsingle cinfo ContinuousSingleArrangement _ _ _ _ -> fcont cinfo +-- | + selectBox :: (CanvasInfo SinglePage -> CanvasInfo SinglePage) -> (CanvasInfo ContinuousSinglePage -> CanvasInfo ContinuousSinglePage) -> CanvasInfoBox -> CanvasInfoBox @@ -164,11 +240,14 @@ idaction = selectBoxAction (return . CanvasInfoBox . fsingle) (return . CanvasInfoBox . fcont) in runIdentity . idaction +-- | + pageArrEitherFromCanvasInfoBox :: CanvasInfoBox -> Either (PageArrangement SinglePage) (PageArrangement ContinuousSinglePage) pageArrEitherFromCanvasInfoBox (CanvasInfoBox cinfo) = pageArrEither . get (pageArrangement.viewInfo) $ cinfo +-- | viewModeBranch :: (CanvasInfo SinglePage -> CanvasInfo SinglePage) -> (CanvasInfo ContinuousSinglePage -> CanvasInfo ContinuousSinglePage) @@ -186,10 +265,15 @@ | TextWork deriving (Show,Eq) ++-- | + data WidthColorStyle = WidthColorStyle { _penWidth :: Double , _penColor :: PenColor } deriving (Show) +-- | + data PenHighlighterEraserSet = PenHighlighterEraserSet { _currPen :: WidthColorStyle , _currHighlighter :: WidthColorStyle @@ -197,10 +281,13 @@ , _currText :: WidthColorStyle} deriving (Show) +-- | + data PenInfo = PenInfo { _penType :: PenType , _penSet :: PenHighlighterEraserSet } deriving (Show) +-- | currentTool :: PenInfo :-> WidthColorStyle currentTool = lens chooser setter where chooser pinfo = case _penType pinfo of@@ -217,18 +304,27 @@ TextWork -> pset { _currText = wcs } in pinfo { _penSet = psetnew } +-- | + defaultPenWCS :: WidthColorStyle defaultPenWCS = WidthColorStyle predefined_medium ColorBlack +-- | + defaultEraserWCS :: WidthColorStyle defaultEraserWCS = WidthColorStyle predefined_eraser_medium ColorWhite +-- | + defaultTextWCS :: WidthColorStyle defaultTextWCS = defaultPenWCS +-- | + defaultHighligherWCS :: WidthColorStyle defaultHighligherWCS = WidthColorStyle predefined_highlighter_medium ColorYellow +-- | defaultPenInfo :: PenInfo defaultPenInfo = @@ -243,9 +339,10 @@ -- | +{- getPage :: (ViewMode a) => CanvasInfo a -> (Page EditMode) getPage = either id (gcast :: Page SelectMode -> Page EditMode) . get currentPage-+-} -- | @@ -264,16 +361,17 @@ -- | -updateCanvasDimForContSingle :: CanvasDimension +updateCanvasDimForContSingle :: PageDimension + -> CanvasDimension -> CanvasInfo ContinuousSinglePage -> CanvasInfo ContinuousSinglePage -updateCanvasDimForContSingle cdim@(CanvasDimension (Dim w' h')) cinfo = +updateCanvasDimForContSingle pdim cdim@(CanvasDimension (Dim w' h')) cinfo = let zmode = get (zoomMode.viewInfo) cinfo arr@(ContinuousSingleArrangement _ ddim func vbbox@(ViewPortBBox bbox)) = get (pageArrangement.viewInfo) cinfo (x,y) = bbox_upperleft bbox - dim = get g_dimension . getPage $ cinfo - (sinvx,sinvy) = getRatioPageCanvas zmode (PageDimension dim) cdim + -- dim = get g_dimension . getPage $ cinfo + (sinvx,sinvy) = getRatioPageCanvas zmode pdim cdim nbbox = BBox (x,y) (x+w'/sinvx,y+h'/sinvy) arr' = ContinuousSingleArrangement cdim ddim func (ViewPortBBox nbbox) in set (pageArrangement.viewInfo) arr' cinfo
lib/Application/HXournal/Type/XournalState.hs view
@@ -54,6 +54,7 @@ , modifyCurrentCanvasInfo , modifyCurrCvsInfoM , xojstateEither+, getCurrentPageFromXojState -- | for debug , showCanvasInfoMapViewPortBBox ) where@@ -157,7 +158,6 @@ setCurrentCanvasId a f = do cinfobox <- M.lookup a (_cvsInfoMap f) return (f { _currentCanvas = (a,cinfobox) })- -- modify currentCanvas (\(_,x)->(a,x)) -- | @@ -187,8 +187,6 @@ cmap' = M.adjust (const a) cid (_cvsInfoMap f) in f { _currentCanvas = (cid,a), _cvsInfoMap = cmap' } --- modify currentCanvas (\(x,_)->(x,a)) - resetXournalStateBuffers :: XournalState -> IO XournalState resetXournalStateBuffers xojstate1 = case xojstate1 of @@ -240,11 +238,7 @@ . M.adjust f cid . getCanvasInfoMap $ xstate --- modify currentCanvasInfo f --- . modify canvasInfoMap (M.adjust f cid) - - -- | should be deprecated modifyCurrentCanvasInfo :: (CanvasInfoBox -> CanvasInfoBox) @@ -252,8 +246,6 @@ -> HXournalState modifyCurrentCanvasInfo f = modify currentCanvasInfo f - -- modify currentCanvasInfo f . modify canvasInfoMap (M.adjust f cid) $ st - -- where cid = getCurrentCanvasId st -- | should be deprecated @@ -268,8 +260,6 @@ ncinfomap = M.adjust (const ncinfobox) cid cinfomap maybe (return st) return (setCanvasInfoMap ncinfomap st) --- return nst--- set currentCanvasInfo ncinfobox -- | @@ -279,16 +269,25 @@ SelectState txoj -> Right txoj -- | + +getCurrentPageFromXojState :: (ViewMode a) => CanvasInfo a -> XournalState -> Page EditMode +getCurrentPageFromXojState cinfo xojstate = + let cpn = get currentPageNum cinfo + pagemap = getPageMapFromXojState xojstate + in maybeError "updatePageFromCanvasToXournal" $ M.lookup cpn pagemap +-- | ++getPageMapFromXojState :: XournalState -> M.IntMap (Page EditMode)+getPageMapFromXojState = either (get g_pages) (get g_selectAll) . xojstateEither + + +-- | + showCanvasInfoMapViewPortBBox :: HXournalState -> IO () showCanvasInfoMapViewPortBBox xstate = do let cmap = getCanvasInfoMap xstate putStrLn . show . map (unboxGet (viewPortBBox.pageArrangement.viewInfo)) . M.elems $ cmap -----
lib/Application/HXournal/View/Coordinate.hs view
@@ -53,20 +53,21 @@ -- | make a canvas geometry data structure from current status -makeCanvasGeometry :: (GPageable em) => - em - -> (PageNum, Page em)+makeCanvasGeometry :: -- (GPageable em) => + -- em + PageNum -- , Page em) -> PageDimension -> PageArrangement vm -> DrawingArea -> IO CanvasGeometry -makeCanvasGeometry typ (cpn,page) arr canvas = do +-- makeCanvasGeometry typ (cpn,page) arr canvas = do +makeCanvasGeometry cpn arr canvas = do win <- widgetGetDrawWindow canvas let cdim@(CanvasDimension (Dim w' h')) = get canvasDimension arr screen <- widgetGetScreen canvas (ws,hs) <- (,) <$> (fromIntegral <$> screenGetWidth screen) <*> (fromIntegral <$> screenGetHeight screen) (x0,y0) <- return . ((,) <$> fromIntegral.fst <*> fromIntegral.snd ) =<< drawWindowGetOrigin win- let (Dim w h) = get g_dimension page+ let -- (Dim w h) = get g_dimension page corig = CanvasOrigin (x0,y0) let (deskdim, cvsvbbox, p2d, d2p) = case arr of @@ -187,13 +188,15 @@ -- | -getCvsGeomFrmCvsInfo :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry +getCvsGeomFrmCvsInfo :: (ViewMode a) => + -- Page EditMode -> + CanvasInfo a -> IO CanvasGeometry getCvsGeomFrmCvsInfo cinfo = do - let page = getPage cinfo+ let -- page = getPage cinfo cpn = PageNum . get currentPageNum $ cinfo canvas = get drawArea cinfo arr = get (pageArrangement.viewInfo) cinfo - makeCanvasGeometry EditMode (cpn,page) arr canvas + makeCanvasGeometry cpn arr canvas -- EditMode (cpn,page) arr canvas
lib/Application/HXournal/View/Draw.hs view
@@ -168,7 +168,7 @@ drawFuncGen typ render = SinglePageDraw func where func isCurrentCvs canvas (pnum,page) vinfo mbbox = do let arr = get pageArrangement vinfo- geometry <- makeCanvasGeometry typ (pnum,page) arr canvas+ geometry <- makeCanvasGeometry pnum arr canvas win <- widgetGetDrawWindow canvas let ibboxnew = getViewableBBox geometry mbbox let mbboxnew = toMaybe ibboxnew @@ -207,9 +207,8 @@ where func isCurrentCvs cinfo mbbox xoj = do let arr = get (pageArrangement.viewInfo) cinfo pnum = PageNum . get currentPageNum $ cinfo - page = getPage cinfo canvas = get drawArea cinfo - geometry <- makeCanvasGeometry EditMode (pnum,page) arr canvas+ geometry <- makeCanvasGeometry pnum arr canvas let pgs = get g_pages xoj let drawpgs = catMaybes . map f $ (getPagesInViewPortRange geometry xoj) @@ -256,10 +255,9 @@ where func isCurrentCvs cinfo mbbox txoj = do let arr = get (pageArrangement.viewInfo) cinfo pnum = PageNum . get currentPageNum $ cinfo - page = getPage cinfo - tpage = get currentPage cinfo + mtpage = get g_selectSelected txoj canvas = get drawArea cinfo - geometry <- makeCanvasGeometry EditMode (pnum,page) arr canvas+ geometry <- makeCanvasGeometry pnum arr canvas let pgs = get g_selectAll txoj xoj = GXournal (get g_selectTitle txoj) pgs let drawpgs = catMaybes . map f @@ -290,9 +288,7 @@ -- clipBBox mbboxnew mapM_ onepagerender drawpgs -- emphasispagerender (pnum,page)- case tpage of - Left page' -> return () - Right tpage' -> selpagerender (pnum,tpage')+ maybe (return ()) (\(n,tpage)-> selpagerender (PageNum n,tpage)) mtpage when isCurrentCvs (emphasisCanvasRender ColorGreen geometry) resetClip