hxournal-0.6.4: lib/Application/HXournal/ModelAction/Page.hs
{-# LANGUAGE GADTs #-}
-----------------------------------------------------------------------------
-- |
-- Module : Application.HXournal.ModelAction.Page
-- Copyright : (c) 2011, 2012 Ian-Woo Kim
--
-- License : BSD3
-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>
-- 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