diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -22,3 +22,6 @@ 0.6.4: 6 Feb 2012 * lasso selection, continuous page view. + +0.6.5: 12 Feb 2012 + * pen button support, pen pressure support, using faster xoj parser diff --git a/hxournal.cabal b/hxournal.cabal --- a/hxournal.cabal +++ b/hxournal.cabal @@ -1,5 +1,5 @@ Name: hxournal -Version: 0.6.5 +Version: 0.6.5.0 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs Homepage: http://ianwookim.org/hxournal diff --git a/lib/Application/HXournal/Accessor.hs b/lib/Application/HXournal/Accessor.hs --- a/lib/Application/HXournal/Accessor.hs +++ b/lib/Application/HXournal/Accessor.hs @@ -16,22 +16,23 @@ import Application.HXournal.Type import Control.Applicative -import Control.Monad -import qualified Control.Monad.State as St +import Control.Monad hiding (mapM_) +import qualified Control.Monad.State as St hiding (mapM_) import Control.Monad.Trans import Control.Category import qualified Data.IntMap as M import Data.Label -import Prelude hiding ((.),id) import Graphics.UI.Gtk hiding (get,set) import qualified Graphics.UI.Gtk as Gtk (set) +import Data.Foldable +import Data.Monoid import Data.Xournal.BBox import Data.Xournal.Generic import Application.HXournal.ModelAction.Layer import Application.HXournal.Type.Alias import Application.HXournal.Type.PageArrangement import Application.HXournal.View.Coordinate - +import Prelude hiding ((.),id,mapM_) -- | get HXournalState @@ -140,7 +141,6 @@ liftIO $ maybe (return ()) signalBlock mconnid agr <- liftIO $ uiManagerGetActionGroups ui Just ra1 <- liftIO $ actionGroupGetAction (head agr) "ONEPAGEA" - -- let wra1 = castToRadioAction ra1 selectBoxAction (fsingle ra1) (fcont ra1) cinfobox liftIO $ maybe (return ()) signalUnblock mconnid return () @@ -148,8 +148,6 @@ let wra1 = castToRadioAction ra1 liftIO $ Gtk.set wra1 [radioActionCurrentValue := 1 ] fcont ra1 _cinfo = do - -- let wra1 = castToRadioAction ra1 - -- liftIO $ wra1 `on` radioActionChanged $ const (putStrLn "hellowworld2" >> return ()) liftIO $ Gtk.set (castToRadioAction ra1) [radioActionCurrentValue := 0 ] -- | @@ -232,7 +230,6 @@ let cinfobox = getCanvasInfo cid xstate cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox - -- xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo) @@ -240,32 +237,19 @@ -- | -getCanvasGeometry :: HXournalState -> IO CanvasGeometry -getCanvasGeometry xstate = do +getGeometry4CurrCvs :: HXournalState -> IO CanvasGeometry +getGeometry4CurrCvs xstate = do let cinfobox = get currentCanvasInfo xstate cpn = PageNum . unboxGet currentPageNum $ cinfobox canvas = unboxGet drawArea cinfobox - -- xojstate = get xournalstate xstate fsingle :: (ViewMode a) => CanvasInfo a -> IO CanvasGeometry fsingle = flip (makeCanvasGeometry cpn) canvas . get (pageArrangement.viewInfo) - boxAction fsingle cinfobox - -{- -getCanvasGeometry :: CanvasInfo SinglePage -> MainCoroutine CanvasPageGeometry -getCanvasGeometry cinfo = do - let canvas = get drawArea cinfo - page = getPage cinfo - (x0,y0) = bbox_upperleft . unViewPortBBox . get (viewPortBBox.pageArrangement.viewInfo) $ cinfo - liftIO (getCanvasPageGeometry canvas page (x0,y0)) --} - - - - - +-- | +bbox4AllStrokes :: (Foldable t, Functor t) => t StrokeBBox -> ULMaybe BBox +bbox4AllStrokes = unUnion . fold . fmap (Union . Middle . strokebbox_bbox) diff --git a/lib/Application/HXournal/Coroutine/Draw.hs b/lib/Application/HXournal/Coroutine/Draw.hs --- a/lib/Application/HXournal/Coroutine/Draw.hs +++ b/lib/Application/HXournal/Coroutine/Draw.hs @@ -131,11 +131,9 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - -- page <- getCurrentPageCvsId cid let canvas = get drawArea cvsInfo - -- vinfo = get viewInfo cvsInfo pnum = PageNum . get currentPageNum $ cvsInfo - geometry <- liftIO $ getCanvasGeometry xstate + geometry <- liftIO $ getCanvasGeometryCvsId cid xstate win <- liftIO $ widgetGetDrawWindow canvas let xformfunc = cairoXform4PageCoordinate geometry pnum liftIO $ renderWithDrawable win $ do @@ -154,10 +152,8 @@ xst <- getSt selectBoxAction (fsingle xst) (fsingle xst) . getCanvasInfo cid $ xst where fsingle xstate cvsInfo = do - -- page <- getCurrentPageCvsId cid let canvas = get drawArea cvsInfo - -- vinfo = get viewInfo cvsInfo - geometry <- liftIO $ getCanvasGeometry xstate + geometry <- liftIO $ getCanvasGeometryCvsId cid xstate win <- liftIO $ widgetGetDrawWindow canvas let xformfunc = cairoXform4PageCoordinate geometry pnum liftIO $ renderWithDrawable win $ do diff --git a/lib/Application/HXournal/Coroutine/Mode.hs b/lib/Application/HXournal/Coroutine/Mode.hs --- a/lib/Application/HXournal/Coroutine/Mode.hs +++ b/lib/Application/HXournal/Coroutine/Mode.hs @@ -82,8 +82,9 @@ noaction xstate = const (return xstate) whencont xstate cinfo = do - geometry <- liftIO $ getCanvasGeometry xstate - cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate + geometry <- liftIO $ getGeometry4CurrCvs xstate + cdim <- liftIO $ return . canvasDim $ geometry + -- =<< getCanvasGeometry xstate page <- getCurrentPageCurr let zmode = get (zoomMode.viewInfo) cinfo canvas = get drawArea cinfo @@ -109,8 +110,7 @@ return $ set currentCanvasInfo (CanvasInfoBox ncinfo) xstate whensing xstate cinfo = do - cdim <- liftIO $ return . canvasDim =<< getCanvasGeometry xstate - -- page <- getCurrentPageCurr + cdim <- liftIO $ return . canvasDim =<< getGeometry4CurrCvs xstate let zmode = get (zoomMode.viewInfo) cinfo canvas = get drawArea cinfo cpn = PageNum . get currentPageNum $ cinfo diff --git a/lib/Application/HXournal/Coroutine/Page.hs b/lib/Application/HXournal/Coroutine/Page.hs --- a/lib/Application/HXournal/Coroutine/Page.hs +++ b/lib/Application/HXournal/Coroutine/Page.hs @@ -46,7 +46,6 @@ npgnum = modifyfn (get currentPageNum cvsInfo) cid = get canvasId cvsInfo (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' @@ -58,7 +57,6 @@ npgnum = modifyfn (get currentPageNum cvsInfo) cid = get canvasId cvsInfo (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' @@ -102,21 +100,23 @@ page <- getCurrentPageCvsId cid let zmode = maybe (get (zoomMode.viewInfo) cinfo) id mzmode pdim = PageDimension $ get g_dimension page + xy = either (const (0,0)) (unPageCoord.snd) + (getCvsOriginInPage geometry) cdim = canvasDim geometry - narr = makeSingleArrangement zmode pdim cdim (0,0) + narr = makeSingleArrangement zmode pdim cdim xy 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)) + origcoord = either (const (cpn,PageCoord (0,0))) id + (getCvsOriginInPage geometry) + narr = makeContinuousSingleArrangement zmode cdim xoj origcoord ncinfobox = CanvasInfoBox . set (pageArrangement.viewInfo) narr . set (zoomMode.viewInfo) zmode $ cinfo @@ -130,40 +130,6 @@ -> MainCoroutine () canvasZoomUpdateCvsId = canvasZoomUpdateGenRenderCvsId invalidateAll -{- - cid mzmode = updateXState zoomUpdateAction - >> adjustScrollbarWithGeometryCvsId cid - >> invalidateAll - 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 --} - -- | canvasZoomUpdateBufAll :: MainCoroutine () @@ -182,12 +148,13 @@ -- | - + canvasZoomUpdate :: Maybe ZoomMode -> MainCoroutine () canvasZoomUpdate mzmode = do cid <- (liftM (getCurrentCanvasId) getSt) canvasZoomUpdateCvsId cid mzmode + -- | diff --git a/lib/Application/HXournal/Coroutine/Scroll.hs b/lib/Application/HXournal/Coroutine/Scroll.hs --- a/lib/Application/HXournal/Coroutine/Scroll.hs +++ b/lib/Application/HXournal/Coroutine/Scroll.hs @@ -36,8 +36,7 @@ adjustScrollbarWithGeometryCvsId cid = do xstate <- getSt let cinfobox = getCanvasInfo cid xstate - - geometry <- liftIO . getCanvasGeometry $ xstate + geometry <- liftIO (getCanvasGeometryCvsId cid xstate) let (hadj,vadj) = unboxGet adjustments cinfobox connidh = unboxGet horizAdjConnId cinfobox connidv = unboxGet vertAdjConnId cinfobox @@ -49,7 +48,7 @@ adjustScrollbarWithGeometryCurrent :: MainCoroutine () adjustScrollbarWithGeometryCurrent = do xstate <- getSt - geometry <- liftIO . getCanvasGeometry $ xstate + geometry <- liftIO . getGeometry4CurrCvs $ xstate let cinfobox = get currentCanvasInfo xstate let (hadj,vadj) = unboxGet adjustments cinfobox connidh = unboxGet horizAdjConnId cinfobox @@ -96,7 +95,7 @@ vscrollMove cid = do ev <- await xst <- getSt - geometry <- liftIO (getCanvasGeometry xst) + geometry <- liftIO (getCanvasGeometryCvsId cid xst) case ev of VScrollBarMoved _cid' v -> do updateXState $ return.modifyCurrentCanvasInfo diff --git a/lib/Application/HXournal/Coroutine/Select.hs b/lib/Application/HXournal/Coroutine/Select.hs --- a/lib/Application/HXournal/Coroutine/Select.hs +++ b/lib/Application/HXournal/Coroutine/Select.hs @@ -173,16 +173,15 @@ (ncoord,ntime) tempselection { tempSelectInfo = hittedstrs } upact xstate cinfo pcoord = do - let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord - (_,(x,y)) = runIdentity $ + let (_,(x,y)) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return (pcoord,prev)) return - let epage = getCurrentPageEitherFromXojState cinfo (get xournalstate xstate) + epage = getCurrentPageEitherFromXojState cinfo (get xournalstate xstate) cpn = get currentPageNum cinfo - let bbox = BBox orig (x,y) + bbox = BBox orig (x,y) hittestbbox = mkHitTestInsideBBox bbox strs selectstrs = fmapAL unNotHitted id hittestbbox - let SelectState txoj = get xournalstate xstate + SelectState txoj = get xournalstate xstate newpage = case epage of Left pagebbox -> makePageSelectMode pagebbox selectstrs Right tpage -> @@ -192,7 +191,7 @@ npage = tpage { glayers = ls { gselectedlayerbuf = newlayer } } in npage newtxoj = txoj { gselectSelected = Just (cpn,newpage) } - let ui = get gtkUIManager xstate + ui = get gtkUIManager xstate liftIO $ toggleCutCopyDelete ui (isAnyHitted selectstrs) putSt . set xournalstate (SelectState newtxoj) =<< (liftIO (updatePageAll (SelectState newtxoj) xstate)) @@ -386,8 +385,7 @@ 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 $ + let (_,(x,y)) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return (pcoord,prev)) return newbbox = getNewBBoxFromHandlePos handle origbbox (x,y) @@ -431,12 +429,16 @@ liftIO $ toggleCutCopyDelete ui False invalidateAll +-- | + cutSelection :: MainCoroutine () cutSelection = do liftIO $ putStrLn "cutSelection called" copySelection deleteSelection +-- | + copySelection :: MainCoroutine () copySelection = updateXState copySelectionAction >> invalidateAll where copySelectionAction xst = @@ -457,24 +459,28 @@ liftIO $ togglePaste ui True return xstate' +-- | + pasteToSelection :: MainCoroutine () pasteToSelection = modeChange ToSelectMode >> updateXState pasteAction >> invalidateAll where pasteAction xst = boxAction (fsimple xst) . get currentCanvasInfo $ xst fsimple xstate cinfo = do - let xojstate@(SelectState txoj) = get xournalstate xstate - clipstrs = getClipContents . get clipboard $ xstate - pagenum = get currentPageNum cinfo + geometry <- liftIO (getGeometry4CurrCvs xstate) + let pagenum = get currentPageNum cinfo + xojstate@(SelectState txoj) = get xournalstate xstate + clipstrs' = getClipContents . get clipboard $ xstate + nclipstrs = adjustStrokePosition4Paste geometry (PageNum pagenum) clipstrs' epage = getCurrentPageEitherFromXojState cinfo xojstate tpage = either gcast id epage layerselect = gselectedlayerbuf . glayers $ tpage ls = glayers tpage gbuf = get g_buffer layerselect newlayerselect = case getActiveLayer tpage of - Left strs -> (GLayerBuf gbuf . TEitherAlterHitted . Right) (strs :- Hitted clipstrs :- Empty) + Left strs -> (GLayerBuf gbuf . TEitherAlterHitted . Right) (strs :- Hitted nclipstrs :- Empty) Right alist -> (GLayerBuf gbuf . TEitherAlterHitted . Right) (concat (interleave id unHitted alist) - :- Hitted clipstrs + :- Hitted nclipstrs :- Empty ) tpage' = tpage { glayers = ls { gselectedlayerbuf = newlayerselect } } txoj' <- liftIO $ updateTempXournalSelectIO txoj tpage' pagenum @@ -508,6 +514,8 @@ . set xournalstate (SelectState newtxoj) $ xstate ) invalidateAll +-- | + selectPenWidthChanged :: Double -> MainCoroutine () selectPenWidthChanged pwidth = do liftIO $ putStrLn "selectPenWidthChanged called" @@ -590,8 +598,7 @@ (ncoord,ntime) nlasso tsel upact cinfo pcoord = do xstate <- getSt - let -- pagecoord = desktop2Page geometry . device2Desktop geometry $ pcoord - (_,(x,y)) = runIdentity $ + let (_,(x,y)) = runIdentity $ skipIfNotInSamePage pnum geometry pcoord (return (pcoord,prev)) return nlasso = lasso |> (x,y) diff --git a/lib/Application/HXournal/Coroutine/Window.hs b/lib/Application/HXournal/Coroutine/Window.hs --- a/lib/Application/HXournal/Coroutine/Window.hs +++ b/lib/Application/HXournal/Coroutine/Window.hs @@ -48,9 +48,7 @@ canvasConfigureGenUpdate updatefunc cid cdim = (updateXState $ selectBoxAction fsingle fcont . getCanvasInfo cid ) >> updatefunc - -- canvasZoomUpdateAll - where -- cdim = CanvasDimension (Dim w' h') - fsingle cinfo = do + where fsingle cinfo = do xstate <- getSt let cinfo' = updateCanvasDimForSingle cdim cinfo return $ setCanvasInfo (cid,CanvasInfoBox cinfo') xstate @@ -68,18 +66,10 @@ -> 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 +canvasConfigure' cid cdim = do xstate <- getSt ctime <- liftIO getCurrentTime maybe defaction (chkaction ctime) (get lastTimeCanvasConfigure xstate) @@ -171,8 +161,10 @@ ev <- await case ev of UpdateCanvas cid -> invalidateWithBuf cid >> paneMoveStart - PaneMoveEnd -> return () - CanvasConfigure cid w' h'-> + PaneMoveEnd -> do + -- canvasZoomUpdateAll + return () + CanvasConfigure cid w' h'-> do canvasConfigureGenUpdate canvasZoomUpdateBufAll cid (CanvasDimension (Dim w' h')) >> paneMoveStart _ -> paneMoveStart diff --git a/lib/Application/HXournal/ModelAction/Select.hs b/lib/Application/HXournal/ModelAction/Select.hs --- a/lib/Application/HXournal/ModelAction/Select.hs +++ b/lib/Application/HXournal/ModelAction/Select.hs @@ -12,6 +12,7 @@ module Application.HXournal.ModelAction.Select where +import Application.HXournal.Accessor (bbox4AllStrokes) import Application.HXournal.Type.Enum import Application.HXournal.Type.Alias import Application.HXournal.Type.Predefined @@ -209,8 +210,8 @@ let activelayer = unTEitherAlterHitted . get g_bstrokes . gselectedlayerbuf . glayers $ tpage in case activelayer of Left _ -> Bottom - Right alist -> - unUnion . mconcat . fmap (Union . Middle . strokebbox_bbox) . takeHittedStrokes $ alist + Right alist -> bbox4AllStrokes . takeHittedStrokes $ alist +-- unUnion . mconcat . fmap (Union . Middle . strokebbox_bbox) . takeHittedStrokes $ alist hitInHandle :: Page SelectMode -> (Double,Double) -> Bool hitInHandle tpage point = @@ -435,4 +436,17 @@ then ((x,y),ntime) else (prev,otime) return (willUpdate,(nprev,nntime)) + +-- | + +adjustStrokePosition4Paste :: CanvasGeometry -> PageNum -> [StrokeBBox] -> [StrokeBBox] +adjustStrokePosition4Paste geometry pgn strs = + case bboxStrs of + Middle (BBox (xs0,ys0) _) -> fmap (changeStrokeBy (offsetFunc (x0-xs0,y0-ys0))) strs + _ -> strs + where bboxStrs = bbox4AllStrokes strs + ViewPortBBox (BBox (xv0,yv0) _) = canvasViewPort geometry + (x0,y0) = maybe (0,0) + (\(pgn',norigin) -> if pgn == pgn' then unPageCoord norigin else (0,0)) + $ desktop2Page geometry (DeskCoord (xv0,yv0)) diff --git a/lib/Application/HXournal/Type/Canvas.hs b/lib/Application/HXournal/Type/Canvas.hs --- a/lib/Application/HXournal/Type/Canvas.hs +++ b/lib/Application/HXournal/Type/Canvas.hs @@ -345,13 +345,6 @@ -- | -{- -getPage :: (ViewMode a) => CanvasInfo a -> (Page EditMode) -getPage = either id (gcast :: Page SelectMode -> Page EditMode) . get currentPage --} - --- | - updateCanvasDimForSingle :: CanvasDimension -> CanvasInfo SinglePage -> CanvasInfo SinglePage @@ -376,7 +369,6 @@ ContinuousSingleArrangement _ ddim func (ViewPortBBox bbox) = get (pageArrangement.viewInfo) cinfo (x,y) = bbox_upperleft bbox - -- 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) diff --git a/lib/Application/HXournal/Type/Clipboard.hs b/lib/Application/HXournal/Type/Clipboard.hs --- a/lib/Application/HXournal/Type/Clipboard.hs +++ b/lib/Application/HXournal/Type/Clipboard.hs @@ -10,6 +10,7 @@ -- Stability : experimental -- Portability : GHC -- +----------------------------------------------------------------------------- module Application.HXournal.Type.Clipboard where diff --git a/lib/Application/HXournal/Type/PageArrangement.hs b/lib/Application/HXournal/Type/PageArrangement.hs --- a/lib/Application/HXournal/Type/PageArrangement.hs +++ b/lib/Application/HXournal/Type/PageArrangement.hs @@ -127,8 +127,13 @@ let PageOrigin (_,y0) = maybeError "makeContSingleArr" $ pageArrFuncContSingle xoj pnum 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 + (x1,y1) = (xpos,ypos+y0) + (x2,y2) = (xpos+cw/sinvx,ypos+y0+ch/sinvy) + ddim@(DesktopDimension (Dim w h)) = deskDimContSingle xoj + (x1',x2') = if x2 > w && w-(x2-x1) > 0 then (w-(x2-x1),w) else (x1,x2) + (y1',y2') = if y2 > h && h-(y2-y1) > 0 then (h-(y2-y1),h) else (y1,y2) + vport = ViewPortBBox (BBox (x1',y1') (x2',y2') ) + in ContinuousSingleArrangement cdim ddim (pageArrFuncContSingle xoj) vport -- | diff --git a/lib/Application/HXournal/View/Coordinate.hs b/lib/Application/HXournal/View/Coordinate.hs --- a/lib/Application/HXournal/View/Coordinate.hs +++ b/lib/Application/HXournal/View/Coordinate.hs @@ -37,7 +37,6 @@ CanvasGeometry { screenDim :: ScreenDimension , canvasDim :: CanvasDimension - -- , canvasOrigin :: CanvasOrigin , desktopDim :: DesktopDimension , canvasViewPort :: ViewPortBBox -- ^ in desktop coordinate , screen2Canvas :: ScreenCoordinate -> CanvasCoordinate @@ -50,13 +49,10 @@ -- | make a canvas geometry data structure from current status -makeCanvasGeometry :: -- (GPageable em) => - -- em - PageNum -- , Page em) -> PageDimension +makeCanvasGeometry :: PageNum -> PageArrangement vm -> DrawingArea -> IO CanvasGeometry --- makeCanvasGeometry typ (cpn,page) arr canvas = do makeCanvasGeometry cpn arr canvas = do win <- widgetGetDrawWindow canvas let cdim@(CanvasDimension (Dim w' h')) = get canvasDimension arr @@ -64,9 +60,8 @@ (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 - corig = CanvasOrigin (x0,y0) - let (deskdim, cvsvbbox, p2d, d2p) = + let corig = CanvasOrigin (x0,y0) + (deskdim, cvsvbbox, p2d, d2p) = case arr of SingleArrangement _ pdim vbbox -> ( DesktopDimension . unPageDimension $ pdim , vbbox @@ -82,10 +77,6 @@ deskdim cvsvbbox s2c c2s c2d d2c d2p p2d - - - - -- | makePage2Desktop :: (PageNum -> Maybe PageOrigin) @@ -174,7 +165,6 @@ 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 inbbox = Intersect (Middle (BBox ul lr)) result = ivbbox `mappend` inbbox in case result of @@ -193,7 +183,16 @@ arr = get (pageArrangement.viewInfo) cinfo makeCanvasGeometry cpn arr canvas - - +-- | Get Canvas Origin in Page Coordinate : Right is successful case, +-- Left is unsuccessful case, then return in DesktopCoordinate + +getCvsOriginInPage :: CanvasGeometry + -> Either DesktopCoordinate (PageNum, PageCoordinate) +getCvsOriginInPage geometry = + let ViewPortBBox (BBox (x0,y0) (_,_)) = canvasViewPort geometry + in case desktop2Page geometry (DeskCoord (x0,y0)) of + Nothing -> Left (DeskCoord (x0,y0)) + Just (pgn,pxy) -> Right (pgn,pxy) +