diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -4,3 +4,5 @@ * Rename modules and make compatible with new xournal-types package 0.4: 25 Dec 2011 * Double buffer support +0.5: 15 Jan 2012 + * ZipperSelect support diff --git a/src/Graphics/Xournal/Render/BBox.hs b/src/Graphics/Xournal/Render/BBox.hs --- a/src/Graphics/Xournal/Render/BBox.hs +++ b/src/Graphics/Xournal/Render/BBox.hs @@ -71,13 +71,14 @@ cairoDrawLayerBBox :: Maybe BBox -> TLayerBBox -> Render () cairoDrawLayerBBox mbbox layer = do + clipBBox mbbox let hittestbbox = case mbbox of Nothing -> NotHitted [] :- Hitted (gstrokes layer) :- Empty Just bbox -> mkHitTestBBoxBBox bbox (gstrokes layer) mapM_ drawOneStroke . map gToStroke . concatMap unHitted . getB $ hittestbbox - + resetClip cairoDrawBackgroundBBox :: Maybe BBox -> Dimension -> Background -> Render () cairoDrawBackgroundBBox mbbox dim@(Dim w h) (Background typ col sty) = do diff --git a/src/Graphics/Xournal/Render/BBoxMapPDF.hs b/src/Graphics/Xournal/Render/BBoxMapPDF.hs --- a/src/Graphics/Xournal/Render/BBoxMapPDF.hs +++ b/src/Graphics/Xournal/Render/BBoxMapPDF.hs @@ -13,6 +13,7 @@ import Data.Xournal.Map import Data.Xournal.BBox import Data.Xournal.Buffer +import Data.Xournal.Select import Data.Foldable import Data.IntMap import Data.Traversable @@ -21,13 +22,7 @@ import Control.Monad.State hiding (get, mapM_, mapM,sequence) import qualified Control.Monad.State as St (get) import Data.Label - --- import Data.ByteString hiding (putStrLn, empty) --- import qualified Data.ByteString.Char8 as C hiding (empty) - --- #ifdef POPPLER --- import qualified Graphics.UI.Gtk.Poppler.Document as Poppler --- #endif +import Control.Compose import Graphics.Xournal.Render.BBox import Graphics.Rendering.Cairo @@ -39,11 +34,38 @@ type TXournalBBoxMapPDF = TXournalBBoxMapBkg BackgroundPDFDrawable +-- type TTempPageSelectPDF = GPage BackgroundPDFDrawable (TLayerSelectInPage []) TLayerBBox + type TTempPageSelectPDF = GPage BackgroundPDFDrawable (TLayerSelectInPage []) TLayerBBox type TTempXournalSelectPDF = GSelect (IntMap TPageBBoxMapPDF) (Maybe (Int, TTempPageSelectPDF)) +newtype LyBuf = LyBuf { mbuffer :: Maybe Surface } +type instance StrokeTypeFromLayer (TLayerBBoxBuf b) = StrokeBBox + +type TPageBBoxMapPDFBuf = + TPageBBoxMapBkgBuf BackgroundPDFDrawable LyBuf + +type TXournalBBoxMapPDFBuf = + TXournalBBoxMapBkgBuf BackgroundPDFDrawable LyBuf + +type TTempPageSelectPDFBuf = + GPage BackgroundPDFDrawable (TLayerSelectInPageBuf ZipperSelect) (TLayerBBoxBuf LyBuf) + +type TTempXournalSelectPDFBuf = + GSelect (IntMap TPageBBoxMapPDFBuf) (Maybe (Int, TTempPageSelectPDFBuf)) + + +instance GCast (TLayerBBox) (TLayerBBoxBuf LyBuf) where + gcast lyr = GLayerBuf (LyBuf Nothing) (get g_strokes lyr) + +instance GCast Layer (TLayerBBoxBuf LyBuf) where + gcast lyr = gcast (fromLayer lyr :: TLayerBBox) + +emptyTLayerBBoxBufLyBuf :: IO (TLayerBBoxBuf LyBuf) +emptyTLayerBBoxBufLyBuf = updateLayerBuf Nothing $ gcast emptyLayer + instance GBackgroundable BackgroundPDFDrawable where gFromBackground = bkgPDFFromBkg gToBackground = bkgFromBkgPDF @@ -68,12 +90,16 @@ gcast = tpageBBoxMapPDFFromTTempPageSelectPDF +-- | deprecated + tpageBBoxMapPDFFromTTempPageSelectPDF :: TTempPageSelectPDF -> TPageBBoxMapPDF tpageBBoxMapPDFFromTTempPageSelectPDF p = - let TLayerSelectInPage s others = glayers p + let TLayerSelectInPage s others = get g_layers p s' = tlayerBBoxFromTLayerSelect s - in GPage (gdimension p) (gbackground p) (gFromList (s':others)) + in GPage (get g_dimension p) (get g_background p) (gFromList (s':others)) + + instance GCast TTempPageSelectPDFBuf TPageBBoxMapPDFBuf where gcast = tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf @@ -82,18 +108,36 @@ tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf p = let TLayerSelectInPageBuf s others = get g_layers p s' = tlayerbufFromTLayerSelectBuf s - in GPage (gdimension p) (gbackground p) (gFromList (s':others)) + normalizedothers = case others of + NoSelect [] -> error "something wrong in tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf" + NoSelect (x:xs) -> Select (gFromList (x:xs)) + Select (O (Nothing)) -> error "something wrong in tpageBBoxMapPDFBufFromTTempPageSelectPDFBuf" + Select (O (Just _)) -> others + Select (O (Just sz)) = normalizedothers + in GPage (get g_dimension p) (get g_background p) (Select . O . Just $ replace s' sz) + + -- GPage (gdimension p) (gbackground p) (gFromList (replace s' others)) + -- (s':others)) +{- instance GCast TPageBBoxMapPDF TTempPageSelectPDF where gcast = ttempPageSelectPDFFromTPageBBoxMapPDF ttempPageSelectPDFFromTPageBBoxMapPDF :: TPageBBoxMapPDF -> TTempPageSelectPDF ttempPageSelectPDFFromTPageBBoxMapPDF p = - let (x:xs) = gToList (glayers p) - l = GLayer . TEitherAlterHitted . Left . gToList . gstrokes $ x - in GPage (gdimension p) (gbackground p) (TLayerSelectInPage l xs) - + let -- (x:xs) = gToList (glayers p) + normalizedothers = case get g_layers p of + NoSelect [] -> error "something wrong in ttemppageBBoxMapPDFBufFromTPageSelectPDFBuf" + NoSelect (x:xs) -> Select (gFromList (x:xs)) + Select (O (Nothing)) -> error "something wrong in ttemppageBBoxMapPDFBufFromTPageSelectPDFBuf" + others@(Select (O (Just _))) -> others + Select (O (Just sz)) = normalizedothers + curr = current sz + currtemp = GLayer . TEitherAlterHitted . Left . gToList . gstrokes $ curr + in GPage (get g_dimension p) (get g_background p) + (TLayerSelectInPage currtemp normalizedothers) +-} instance GCast TPageBBoxMapPDFBuf TTempPageSelectPDFBuf where gcast = ttempPageSelectPDFBufFromTPageBBoxMapPDFBuf @@ -101,12 +145,24 @@ ttempPageSelectPDFBufFromTPageBBoxMapPDFBuf :: TPageBBoxMapPDFBuf -> TTempPageSelectPDFBuf ttempPageSelectPDFBufFromTPageBBoxMapPDFBuf p = - let (x:xs) = gToList (get g_layers p) + let normalizedothers = case (get g_layers p) of + NoSelect [] -> error "something wrong in ttemppageBBoxMapPDFBufFromTPageSelectPDFBuf" + NoSelect (x:xs) -> Select (gFromList (x:xs)) + Select (O (Nothing)) -> error "something wrong in ttemppageBBoxMapPDFBufFromTPageSelectPDFBuf" + others@(Select (O (Just _))) -> others + Select (O (Just sz)) = normalizedothers + curr = current sz + currtemp = GLayerBuf (get g_buffer curr) (TEitherAlterHitted . Left . gToList . get g_bstrokes $ curr) + in GPage (get g_dimension p) (get g_background p) + (TLayerSelectInPageBuf currtemp normalizedothers) + + +{- let (x:xs) = gToList (get g_layers p) l = GLayerBuf { gbuffer = gbuffer x , gbstrokes = TEitherAlterHitted . Left . gToList . gbstrokes $ x } - in GPage (gdimension p) (gbackground p) (TLayerSelectInPageBuf l xs) + in GPage (gdimension p) (gbackground p) (TLayerSelectInPageBuf l xs) -} ---------------------- @@ -171,22 +227,7 @@ -newtype LyBuf = LyBuf { mbuffer :: Maybe Surface } -type instance StrokeTypeFromLayer (TLayerBBoxBuf b) = StrokeBBox - -type TPageBBoxMapPDFBuf = - TPageBBoxMapBkgBuf BackgroundPDFDrawable LyBuf - -type TXournalBBoxMapPDFBuf = - TXournalBBoxMapBkgBuf BackgroundPDFDrawable LyBuf - -type TTempPageSelectPDFBuf = - GPage BackgroundPDFDrawable (TLayerSelectInPageBuf []) (TLayerBBoxBuf LyBuf) - -type TTempXournalSelectPDFBuf = - GSelect (IntMap TPageBBoxMapPDFBuf) (Maybe (Int, TTempPageSelectPDFBuf)) - mkTLayerBBoxBufFromNoBuf :: Dimension -> TLayerBBox -> IO (TLayerBBoxBuf LyBuf) mkTLayerBBoxBufFromNoBuf (Dim w h) lyr = do let strs = get g_strokes lyr @@ -212,7 +253,7 @@ bkg = get g_background page ls = get g_layers page ls' <- mapM (mkTLayerBBoxBufFromNoBuf dim) ls - return $ GPage dim bkg ls' + return . GPage dim bkg . gFromList . gToList $ ls' mkTXournalBBoxMapPDFBufFromNoBuf :: TXournalBBoxMapPDF @@ -228,7 +269,7 @@ resetPageBuffers page = do let dim = get g_dimension page mbbox = Just . dimToBBox $ dim - newlayers <- sequence . fmap (updateLayerBuf mbbox) . get g_layers $ page + newlayers <- mapM (updateLayerBuf mbbox) . get g_layers $ page return (set g_layers newlayers page) resetXournalBuffers :: TXournalBBoxMapPDFBuf -> IO TXournalBBoxMapPDFBuf @@ -250,7 +291,7 @@ tpageBBoxMapPDFFromTPageBBoxMapPDFBuf :: TPageBBoxMapPDFBuf -> TPageBBoxMapPDF tpageBBoxMapPDFFromTPageBBoxMapPDFBuf (GPage dim bkg ls) = - GPage dim bkg (fmap tlayerBBoxFromTLayerBBoxBuf ls) + GPage dim bkg . gFromList . gToList . fmap tlayerBBoxFromTLayerBBoxBuf $ ls ----- Rendering diff --git a/src/Graphics/Xournal/Render/Type.hs b/src/Graphics/Xournal/Render/Type.hs --- a/src/Graphics/Xournal/Render/Type.hs +++ b/src/Graphics/Xournal/Render/Type.hs @@ -1,142 +1,14 @@ {-# LANGUAGE TypeFamilies #-} -module Graphics.Xournal.Render.Type where - -import Prelude hiding (fst,snd) - -import Data.Xournal.Simple -import Data.Xournal.Generic -import Data.Xournal.BBox -import Data.Xournal.Map - -import Data.IntMap hiding (map) - -data AlterList a b = Empty | a :- AlterList b a - deriving (Show) - -infixr 6 :- - -newtype NotHitted a = NotHitted { unNotHitted :: [a] } - deriving (Show) - -newtype Hitted a = Hitted { unHitted :: [a] } - deriving (Show) - -type StrokeHitted = AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox) - - -fmapAL :: (a -> c) -> (b -> d) -> AlterList a b -> AlterList c d -fmapAL _ _ Empty = Empty -fmapAL f g (x :- ys) = f x :- fmapAL g f ys - - -getA :: AlterList a b -> [a] -getA Empty = [] -getA (x :- xs) = x : getB xs - -getB :: AlterList a b -> [b] -getB Empty = [] -getB (_x :- xs) = getA xs - -interleave :: (a->c) -> (b->c) -> AlterList a b -> [c] -interleave _fa _fb Empty = [] -interleave fa fb (x :- xs) = fa x : (interleave fb fa xs) - ----- - - -type TAlterHitted a = AlterList [a] (Hitted a) - -newtype TEitherAlterHitted a = - TEitherAlterHitted { - unTEitherAlterHitted :: Either [a] (TAlterHitted a) - } - -type TLayerSelect a = GLayer TEitherAlterHitted (StrokeTypeFromLayer a) - -type TLayerSelectBuf a = GLayerBuf (BufTypeFromLayer a) TEitherAlterHitted (StrokeTypeFromLayer a) - -type family StrokeTypeFromLayer a :: * - -type family BufTypeFromLayer a :: * - -type instance BufTypeFromLayer (GLayerBuf b s a) = b - -type instance StrokeTypeFromLayer TLayerBBox = StrokeBBox - -data TLayerSelectInPage s a = TLayerSelectInPage - { gselectedlayer :: TLayerSelect a - , gotherlayers :: s a - } - -data TLayerSelectInPageBuf s a = TLayerSelectInPageBuf - { gselectedlayerbuf :: TLayerSelectBuf a - , gotherlayersbuf :: s a - } - - -type TTempPageSelect = GPage Background (TLayerSelectInPage []) TLayerBBox - -type TTempXournalSelect = GSelect (IntMap TPageBBoxMap) (Maybe (Int, TTempPageSelect)) - - -{- - -instance IStroke StrokeBBox where - strokeTool = strokebbox_tool - strokeColor = strokebbox_color - strokeWidth = strokebbox_width - strokeData = strokebbox_data - -instance ILayer LayerBBox where - type TStroke LayerBBox = StrokeBBox - layerStrokes = layerbbox_strokes - -instance IPage PageBBox where - type TLayer PageBBox = LayerBBox - pageDim = pagebbox_dim - pageBkg = pagebbox_bkg - pageLayers = pagebbox_layers - -instance IXournal XournalBBox where - type TPage XournalBBox = PageBBox - xournalPages = xojbbox_pages +module Graphics.Xournal.Render.Type ( + module Graphics.Xournal.Render.Type.Hitted, + module Graphics.Xournal.Render.Type.Select + ) where +import Graphics.Xournal.Render.Type.Hitted +import Graphics.Xournal.Render.Type.Select - -mkXournalBBoxFromXournal :: Xournal -> XournalBBox -mkXournalBBoxFromXournal xoj = - XournalBBox { xojbbox_pages = map mkPageBBoxFromPage (xoj_pages xoj) } - -mkPageBBoxFromPage :: Page -> PageBBox -mkPageBBoxFromPage pg = - PageBBox { pagebbox_dim = page_dim pg - , pagebbox_bkg = page_bkg pg - , pagebbox_layers = map mkLayerBBoxFromLayer (page_layers pg) } - -mkLayerBBoxFromLayer :: Layer -> LayerBBox -mkLayerBBoxFromLayer ly = - LayerBBox { layerbbox_strokes = map mkStrokeBBoxFromStroke (layer_strokes ly) } - --} -{- -xournalFromXournalBBox :: XournalBBox -> Xournal -xournalFromXournalBBox xojbbox = - emptyXournal { xoj_pages = map pageFromPageBBox (xojbbox_pages xojbbox) } - -pageFromPageBBox :: PageBBox -> Page -pageFromPageBBox pgbbox = - Page { page_dim = pagebbox_dim pgbbox - , page_bkg = pagebbox_bkg pgbbox - , page_layers = map layerFromLayerBBox (pagebbox_layers pgbbox) } - -layerFromLayerBBox :: LayerBBox -> Layer -layerFromLayerBBox lybbox = - Layer { layer_strokes = map strokeFromStrokeBBox (layerbbox_strokes lybbox) } - --} ----- diff --git a/src/Graphics/Xournal/Render/Type/Hitted.hs b/src/Graphics/Xournal/Render/Type/Hitted.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Xournal/Render/Type/Hitted.hs @@ -0,0 +1,48 @@ +module Graphics.Xournal.Render.Type.Hitted where + +import Data.Xournal.BBox +import Prelude hiding (fst,snd) + + +data AlterList a b = Empty | a :- AlterList b a + deriving (Show) + +infixr 6 :- + +newtype NotHitted a = NotHitted { unNotHitted :: [a] } + deriving (Show) + +newtype Hitted a = Hitted { unHitted :: [a] } + deriving (Show) + +type StrokeHitted = AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox) + + +fmapAL :: (a -> c) -> (b -> d) -> AlterList a b -> AlterList c d +fmapAL _ _ Empty = Empty +fmapAL f g (x :- ys) = f x :- fmapAL g f ys + + +getA :: AlterList a b -> [a] +getA Empty = [] +getA (x :- xs) = x : getB xs + +getB :: AlterList a b -> [b] +getB Empty = [] +getB (_x :- xs) = getA xs + +interleave :: (a->c) -> (b->c) -> AlterList a b -> [c] +interleave _fa _fb Empty = [] +interleave fa fb (x :- xs) = fa x : (interleave fb fa xs) + +---- + + +type TAlterHitted a = AlterList [a] (Hitted a) + +newtype TEitherAlterHitted a = + TEitherAlterHitted { + unTEitherAlterHitted :: Either [a] (TAlterHitted a) + } + + diff --git a/src/Graphics/Xournal/Render/Type/Select.hs b/src/Graphics/Xournal/Render/Type/Select.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Xournal/Render/Type/Select.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TypeFamilies #-} + +module Graphics.Xournal.Render.Type.Select where + +import Data.Xournal.Simple +import Data.Xournal.Generic +import Data.Xournal.BBox +import Data.Xournal.Map +import Data.IntMap hiding (map) + +import Graphics.Xournal.Render.Type.Hitted + +type TLayerSelect a = GLayer TEitherAlterHitted (StrokeTypeFromLayer a) + +type TLayerSelectBuf a = GLayerBuf (BufTypeFromLayer a) TEitherAlterHitted (StrokeTypeFromLayer a) + +type family StrokeTypeFromLayer a :: * + +type family BufTypeFromLayer a :: * + +type instance BufTypeFromLayer (GLayerBuf b s a) = b + +type instance StrokeTypeFromLayer TLayerBBox = StrokeBBox + +data TLayerSelectInPage s a = TLayerSelectInPage + { gselectedlayer :: TLayerSelect a + , gotherlayers :: s a + } + +data TLayerSelectInPageBuf s a = TLayerSelectInPageBuf + { gselectedlayerbuf :: TLayerSelectBuf a + , gotherlayersbuf :: s a + } + + +-- | deprecated + +type TTempPageSelect = GPage Background (TLayerSelectInPage []) TLayerBBox + + +-- | deprecated + +type TTempXournalSelect = GSelect (IntMap TPageBBoxMap) (Maybe (Int, TTempPageSelect)) diff --git a/xournal-render.cabal b/xournal-render.cabal --- a/xournal-render.cabal +++ b/xournal-render.cabal @@ -1,5 +1,5 @@ Name: xournal-render -Version: 0.4.0.0 +Version: 0.5 Synopsis: Xournal file renderer Description: Rendering library using cairo for xournal file format License: BSD3 @@ -20,7 +20,7 @@ Library hs-source-dirs: src - ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind + ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind ghc-prof-options: -caf-all -auto-all if flag(poppler) @@ -32,7 +32,8 @@ bytestring == 0.9.*, poppler == 0.12.*, fclabels == 1.0.*, - xournal-types == 0.2.* + xournal-types == 0.3.*, + TypeCompose == 0.9.* else Build-Depends: base == 4.*, mtl == 2.*, @@ -41,7 +42,8 @@ strict == 0.3.*, bytestring == 0.9.*, fclabels == 1.0.*, - xournal-types == 0.2.* + xournal-types == 0.3.*, + TypeCompose == 0.9.* Exposed-Modules: @@ -52,6 +54,8 @@ Graphics.Xournal.Render.BBoxMapPDF Graphics.Xournal.Render.HitTest Graphics.Xournal.Render.Type + Graphics.Xournal.Render.Type.Hitted + Graphics.Xournal.Render.Type.Select if flag(poppler) cpp-options: -DPOPPLER