xournal-render 0.4.0.0 → 0.5
raw patch · 7 files changed
+184/−173 lines, 7 filesdep +TypeComposedep ~xournal-types
Dependencies added: TypeCompose
Dependency ranges changed: xournal-types
Files
- CHANGES +2/−0
- src/Graphics/Xournal/Render/BBox.hs +2/−1
- src/Graphics/Xournal/Render/BBoxMapPDF.hs +75/−34
- src/Graphics/Xournal/Render/Type.hs +6/−134
- src/Graphics/Xournal/Render/Type/Hitted.hs +48/−0
- src/Graphics/Xournal/Render/Type/Select.hs +43/−0
- xournal-render.cabal +8/−4
CHANGES view
@@ -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
src/Graphics/Xournal/Render/BBox.hs view
@@ -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
src/Graphics/Xournal/Render/BBoxMapPDF.hs view
@@ -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
src/Graphics/Xournal/Render/Type.hs view
@@ -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) }- --} -----
+ src/Graphics/Xournal/Render/Type/Hitted.hs view
@@ -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)+ }++
+ src/Graphics/Xournal/Render/Type/Select.hs view
@@ -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))
xournal-render.cabal view
@@ -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