{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- | -- Module : Application.HXournal.ModelAction.Page -- Copyright : (c) 2011, 2012 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim -- Stability : experimental -- Portability : GHC -- ----------------------------------------------------------------------------- module Application.HXournal.ModelAction.Page where import Application.HXournal.Type.XournalState import Application.HXournal.Type.Canvas import Application.HXournal.Type.PageArrangement import Application.HXournal.Type.Alias import Application.HXournal.View.Coordinate import Application.HXournal.Util import Control.Applicative import Control.Monad (liftM) import Data.Xournal.BBox (moveBBoxToOrigin) import Data.Xournal.Simple (Dimension(..)) import Data.Xournal.Generic import Data.Xournal.Select import Data.Traversable (mapM) import Graphics.Xournal.Render.BBoxMapPDF import Control.Category import Data.Label import Prelude hiding ((.),id,mapM) import qualified Data.IntMap as M import Graphics.UI.Gtk (adjustmentSetUpper,adjustmentGetValue) -- | getPageMap :: XournalState -> M.IntMap (Page EditMode) getPageMap = either (get g_pages) (get g_selectAll) . xojstateEither -- | setPageMap :: M.IntMap (Page EditMode) -> XournalState -> XournalState setPageMap nmap = either (ViewAppendState . set g_pages nmap) (SelectState . set g_selectSelected Nothing . set g_selectAll nmap ) . 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 in setPageMap (M.adjust (const page) cpn . getPageMap $ xojstate) xojstate -- | updatePageAll :: XournalState -> HXournalState -> IO HXournalState updatePageAll xojst xstate = do let cmap = get canvasInfoMap xstate cmap' <- mapM (updatePage xojst . adjustPage xojst) cmap let cid = get currentCanvasId xstate cinfobox = maybeError "updatePageAll" (M.lookup cid cmap') let newxstate = set currentCanvas (cid,cinfobox) . set canvasInfoMap cmap' . set xournalstate xojst $ xstate return newxstate adjustPage :: XournalState -> CanvasInfoBox -> CanvasInfoBox adjustPage xojstate = selectBox fsingle fsingle where fsingle :: CanvasInfo a -> CanvasInfo a fsingle cinfo = let cpn = get currentPageNum cinfo pagemap = getPageMap xojstate in adjustwork cpn pagemap where adjustwork cpn pagemap = if M.notMember cpn pagemap then let (minp,_) = M.findMin pagemap (maxp,_) = M.findMax pagemap in if cpn > maxp then set currentPageNum maxp cinfo else set currentPageNum minp cinfo else cinfo getPageFromGXournalMap :: Int -> GXournal M.IntMap a -> a getPageFromGXournalMap pagenum = maybeError ("getPageFromGXournalMap " ++ show pagenum) . M.lookup pagenum . get g_pages -- | updateCvsInfoFrmXoj :: Xournal EditMode -> CanvasInfoBox -> IO CanvasInfoBox 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 let cdim = canvasDim geometry pg = getPageFromGXournalMap pagenum xoj pdim@(PageDimension (Dim w h)) = PageDimension $ get g_dimension pg (hadj,vadj) = get adjustments cinfo (xpos,ypos) <- (,) <$> adjustmentGetValue hadj <*> adjustmentGetValue vadj let arr = makeSingleArrangement zmode pdim cdim (xpos,ypos) adjustmentSetUpper hadj w adjustmentSetUpper vadj h return . CanvasInfoBox . set currentPageNum pagenum . set (pageArrangement.viewInfo) arr . set currentPage (Left pg) $ 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 let ulcoord = maybeError "updateCvsFromXoj" $ desktop2Page geometry (DeskCoord (xdesk,ydesk)) let cdim = canvasDim geometry 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 adjustmentSetUpper vadj h return . CanvasInfoBox . set currentPageNum pagenum . set (pageArrangement.viewInfo) arr . set currentPage (Left pg) $ cinfo -- | {- updatePage :: XournalState -> CanvasInfoBox -> IO CanvasInfoBox updatePage = either updateCvsInfoFrmXoj . either id makexoj . xojstateEither where makexoj txoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj) -} 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 let xoj = GXournal (get g_selectTitle txoj) (get g_selectAll txoj) CanvasInfoBox cinfo' <- updateCvsInfoFrmXoj xoj cinfobox return . CanvasInfoBox . set currentPage (getselectedpage cinfo) $ cinfo' 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' {- let pagenum = unboxGet currentPageNum cinfobox mspage = get g_selectSelected txoj pageFromArg = case M.lookup pagenum (get g_selectAll txoj) of Nothing -> error "no such page in updatePage" Just p -> p (newpage,Dim w h) = case mspage of Nothing -> (Left pageFromArg, gdimension pageFromArg) Just (spagenum,page) -> if spagenum == pagenum then (Right page, gdimension page) else (Left pageFromArg, gdimension pageFromArg) in set currentPageNum pagenum . set (pageDimension.viewInfo) (w,h) . set currentPage newpage $ cinfo -} -- | setPage :: HXournalState -> PageNum -> CanvasId -> IO CanvasInfoBox setPage xstate pnum cid = do let cinfobox = getCanvasInfo cid xstate selectBoxAction (liftM CanvasInfoBox . setPageSingle xstate pnum) (liftM CanvasInfoBox . setPageCont xstate pnum) cinfobox -- | setPageSingle : in Single Page mode setPageSingle :: HXournalState -> PageNum -> CanvasInfo SinglePage -> IO (CanvasInfo SinglePage) setPageSingle xstate pnum cinfo = do let xoj = getXournal xstate geometry <- getCvsGeomFrmCvsInfo cinfo let cdim = canvasDim geometry let pg = getPageFromGXournalMap (unPageNum pnum) xoj pdim = PageDimension (get g_dimension pg) 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 -- | setPageCont : in ContinuousSingle Page mode setPageCont :: HXournalState -> PageNum -> CanvasInfo ContinuousSinglePage -> IO (CanvasInfo ContinuousSinglePage) setPageCont xstate pnum cinfo = do let xoj = getXournal xstate geometry <- getCvsGeomFrmCvsInfo cinfo let cdim = canvasDim geometry 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) . set (pageArrangement.viewInfo) arr . set currentPage (Left pg) $ cinfo -- | newSinglePageFromOld :: Page EditMode -> Page EditMode newSinglePageFromOld = set g_layers (NoSelect [GLayerBuf (LyBuf Nothing) []]) -- | newPageBeforeAction :: (ViewMode a) => Xournal EditMode -> (CanvasId, CanvasInfo a) -> IO (Xournal EditMode) newPageBeforeAction xoj (_cid,cinfo) = do let cpn = get currentPageNum cinfo let pagelst = M.elems . get g_pages $ xoj pagekeylst = M.keys . get g_pages $ xoj (pagesbefore,pagesafter) = splitAt cpn pagelst npage = newSinglePageFromOld (head pagesafter) npagelst = pagesbefore ++ (npage : pagesafter) nxoj = set g_pages (M.fromList . zip [0..] $ npagelst) xoj return nxoj