packages feed

xournal-render 0.2.0.0 → 0.3

raw patch · 14 files changed

+764/−575 lines, 14 filesdep +fclabelsdep +popplerdep +xournal-typesdep −xournal-parser

Dependencies added: fclabels, poppler, xournal-types

Dependencies removed: xournal-parser

Files

+ CHANGES view
@@ -0,0 +1,4 @@+0.2: 12 Dec 2011+   * First public release+0.3: 18 Dec 2011 +   * Rename modules and make compatible with new xournal-types package
− src/Graphics/Xournal/HitTest.hs 
@@ -1,126 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Graphics.Xournal.HitTest where--import Data.Strict.Tuple-import Text.Xournal.Type --import Graphics.Xournal.Type--import Control.Applicative-import Control.Monad.State---hitTestBBoxPoint :: BBox -> (Double,Double) -> Bool  -hitTestBBoxPoint (BBox (ulx,uly) (lrx,lry)) (x,y) -  = ulx <= x && x <= lrx && uly <= y && y <= lry --hitTestLineLine :: ((Double,Double),(Double,Double)) -> ((Double,Double),(Double,Double)) -> Bool -hitTestLineLine ((x1,y1),(x2,y2)) ((x3,y3),(x4,y4)) = -    (x2-xc)*(xc-x1)>=0 && (x3-xc)*(xc-x4) >=0 -  where x21 = x2-x1 -        x43 = x4-x3 -        y21 = y2-y1 -        y43 = y4-y3-        -- denom = y21*x43-y43*x21 -        xc = (x21*x43*(y3-y1)+y21*x43*x1-y43*x21*x3)/(y21*x43-y43*x21)-        -hitTestLineStroke :: (IStroke a) => -                     ((Double,Double),(Double,Double)) -                     -> a-                     -> Bool-hitTestLineStroke line1 str = test (strokeData str) -  where test [] = False-        test ((_:!:_):[]) = False-        test ((x0:!:y0):(x:!:y):rest) -          = hitTestLineLine line1 ((x0,y0),(x,y))-            || test ((x:!:y) : rest)-            -mkHitTestAL :: (StrokeBBox -> Bool) -            -> [StrokeBBox]-            -> AlterList NotHitted Hitted -mkHitTestAL test strs = evalState (mkHitTestALState test strs) False--mkHitTestALState :: (StrokeBBox -> Bool) -                 -> [StrokeBBox]-                 -> State Bool (AlterList NotHitted Hitted)-mkHitTestALState test strs = do -  let (nhit,rest) = break test  strs-      (hit,rest') = break (not.test) rest -  st <- get-  put (st || (not.null) hit) -  if null rest' -    then return (NotHitted nhit :- Hitted hit :- NotHitted [] :- Empty)-    else return (NotHitted nhit :- Hitted hit :- mkHitTestAL test rest')---mkHitTestBBox :: ((Double,Double),(Double,Double))-                 -> [StrokeBBox]-                 -> AlterList NotHitted Hitted -mkHitTestBBox (p1,p2) = mkHitTestAL boxhittest -  where boxhittest s = hitTestBBoxPoint (strokebbox_bbox s) p1-                       || hitTestBBoxPoint (strokebbox_bbox s) p2--mkHitTestBBoxBBox :: BBox -> [StrokeBBox] -> AlterList NotHitted Hitted -mkHitTestBBoxBBox b = mkHitTestAL (hitTestBBoxBBox b . strokebbox_bbox) --mkHitTestInsideBBox :: BBox -> [StrokeBBox] -> AlterList NotHitted Hitted  -mkHitTestInsideBBox b = mkHitTestAL (hitTestInsideBBox b . strokebbox_bbox)--hitTestInsideBBox :: BBox -> BBox -> Bool -hitTestInsideBBox b1 b2@(BBox (ulx2,uly2) (lrx2,lry2)) -  = hitTestBBoxPoint b1 (ulx2,uly2)-    && hitTestBBoxPoint b1 (lrx2,lry2)---hitTestBBoxBBox :: BBox -> BBox -> Bool  -hitTestBBoxBBox b1@(BBox (ulx1,uly1) (lrx1,lry1)) b2@(BBox (ulx2,uly2) (lrx2,lry2))-  = hitTestBBoxPoint b2 (ulx1,uly1)-    || hitTestBBoxPoint b2 (lrx1,lry1)-    || hitTestBBoxPoint b2 (lrx1,uly1)-    || hitTestBBoxPoint b2 (ulx1,lry1)-    || hitTestBBoxPoint b1 (lrx2,lry2)-    || hitTestBBoxPoint b1 (ulx2,uly2)- ---mkHitTestStroke :: ((Double,Double),(Double,Double))-                -> [StrokeBBox]-                -> State Bool (AlterList NotHitted Hitted)-mkHitTestStroke line = mkHitTestALState (hitTestLineStroke line)-  -hitTestStrokes :: ((Double,Double),(Double,Double))-               -> AlterList NotHitted Hitted -               -> State Bool (AlterList NotHitted StrokeHitted)-hitTestStrokes _ Empty = error "something is wrong, invariant broken"-hitTestStrokes _ (n:-Empty) = return (n:-Empty)-hitTestStrokes line (n:-h:-rest) = do -  h' <- mkHitTestStroke line (unHitted h)-  (n:-) . (h':-) <$> hitTestStrokes line rest-  -elimHitted :: AlterList NotHitted Hitted -> State (Maybe BBox) [StrokeBBox]-elimHitted Empty = error "something wrong in elimHitted"-elimHitted (n:-Empty) = return (unNotHitted n)-elimHitted (n:-h:-rest) = do  -  bbox <- get-  let bbox2 = getTotalBBox (unHitted h) -  put (merge bbox bbox2) -  return . (unNotHitted n ++) =<< elimHitted rest--                 -merge :: Maybe BBox -> Maybe BBox -> Maybe BBox    -merge Nothing Nothing = Nothing-merge Nothing (Just b) = Just b-merge (Just b) Nothing = Just b -merge (Just (BBox (x1,y1) (x2,y2))) (Just (BBox (x3,y3) (x4,y4))) -  = Just (BBox (min x1 x3, min y1 y3) (max x2 x4,max y2 y4))  -    -getTotalBBox :: [StrokeBBox] -> Maybe BBox -getTotalBBox = foldl f Nothing -  where f acc = merge acc . Just . strokebbox_bbox------
− src/Graphics/Xournal/Render.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Graphics.Xournal.Render where --import Graphics.Rendering.Cairo--import Data.Strict.Tuple--import Text.Xournal.Type -import Text.Xournal.Predefined --import qualified Data.Map as M-import qualified Data.ByteString.Char8 as S--drawOneStroke :: IStroke a => a -> Render ()-drawOneStroke s = do -  case M.lookup (strokeColor s) predefined_pencolor of-    Just (r,g,b,a) -> setSourceRGBA r g b a -    Nothing -> setSourceRGBA 0 0 0 1-  setLineWidth (strokeWidth s) -  drawOneStrokeCurve (strokeData s)-  stroke--drawOneStrokeCurve :: [Pair Double Double] -> Render ()-drawOneStrokeCurve ((x0 :!: y0) : xs) = do -  x0 `seq` y0 `seq` moveTo x0 y0-  mapM_ f xs -    where f (x :!: y) = x `seq` y `seq` lineTo x y --cairoDrawBackground :: IPage a => a -> Render () -cairoDrawBackground page = do -  let Background typ col sty = pageBkg page-      Dim w h = pageDim page  -  cairoDrawBkg (Dim w h) (Background typ col sty)-{-  let c = M.lookup col predefined_bkgcolor  -  case c of -    Just (r,g,b,a) -> setSourceRGB r g b -    Nothing        -> setSourceRGB 1 1 1 -  rectangle 0 0 w h -  fill-  cairoDrawRuling w h sty -}--cairoDrawBkg :: Dimension -> Background -> Render () -cairoDrawBkg (Dim w h) (Background typ col sty) = do -  let c = M.lookup col predefined_bkgcolor  -  case c of -    Just (r,g,b,a) -> setSourceRGB r g b -    Nothing        -> setSourceRGB 1 1 1 -  rectangle 0 0 w h -  fill-  cairoDrawRuling w h sty---cairoDrawRuling :: Double -> Double -> S.ByteString -> Render () -cairoDrawRuling w h style = do-  let drawHorizRules = do -      let (r,g,b,a) = predefined_RULING_COLOR         -      setSourceRGBA r g b a -      setLineWidth predefined_RULING_THICKNESS-      let drawonerule y = do -            moveTo 0 y -            lineTo w y-            stroke  -      mapM_ drawonerule [ predefined_RULING_TOPMARGIN -                        , predefined_RULING_TOPMARGIN+predefined_RULING_SPACING-                        .. -                        h-1 ]-  case style of -    "plain" -> return () -    "lined" -> do -      drawHorizRules-      let (r2,g2,b2,a2) = predefined_RULING_MARGIN_COLOR-      setSourceRGBA r2 g2 b2 a2 -      setLineWidth predefined_RULING_THICKNESS-      moveTo predefined_RULING_LEFTMARGIN 0 -      lineTo predefined_RULING_LEFTMARGIN h-      stroke-    "ruled" -> drawHorizRules -    "graph" -> do -      let (r3,g3,b3,a3) = predefined_RULING_COLOR -      setSourceRGBA r3 g3 b3 a3 -      setLineWidth predefined_RULING_THICKNESS-      let drawonegraphvert x = do -            moveTo x 0 -            lineTo x h-            stroke  -      let drawonegraphhoriz y = do -            moveTo 0 y-            lineTo w y-            stroke-      mapM_ drawonegraphvert  [0,predefined_RULING_GRAPHSPACING..w-1] -      mapM_ drawonegraphhoriz [0,predefined_RULING_GRAPHSPACING..h-1]-    _ -> return ()     --cairoDrawPage :: IPage a => a -> Render ()-cairoDrawPage page = do -  let strokes = (layerStrokes . (!!0) . pageLayers) page -      (Dim w h) = pageDim page-  cairoDrawBackground page-  -- setSourceRGB 0 0 0-  -- setLineWidth 1-  setLineCap LineCapRound-  setLineJoin LineJoinRound--  mapM_ drawOneStroke strokes-  stroke--
src/Graphics/Xournal/Render/BBox.hs view
@@ -3,41 +3,45 @@ module Graphics.Xournal.Render.BBox where  import Graphics.Rendering.Cairo-import Graphics.Xournal.Render-import Graphics.Xournal.HitTest-import Graphics.Xournal.Type +import Graphics.Xournal.Render.Simple+import Graphics.Xournal.Render.HitTest+import Graphics.Xournal.Render.Type  -import Graphics.Xournal.Type.Map+import Data.Xournal.Generic+import Data.Xournal.Map+import Data.Xournal.Simple+import Data.Xournal.BBox+import Data.Xournal.Predefined  -import Text.Xournal.Type -import Text.Xournal.Predefined +import Data.Foldable  import qualified Data.Map as M  import Data.ByteString hiding (map, minimum, maximum, concat, concatMap, filter ) --import Prelude hiding (fst,snd,curry,uncurry)+import Debug.Trace+import Prelude hiding (fst,snd,curry,uncurry,mapM_,concatMap)   cairoOneStrokeBBoxOnly :: StrokeBBox -> Render () -cairoOneStrokeBBoxOnly s = do  -  case M.lookup (strokeColor s) predefined_pencolor of +cairoOneStrokeBBoxOnly sbbox = do  +  let s = gToStroke sbbox+  case M.lookup (stroke_color s) predefined_pencolor of      Just (r,g,b,a) -> setSourceRGBA r g b a     Nothing -> setSourceRGBA 0 0 0 1 -  setLineWidth (strokeWidth s) -  let BBox (x1,y1) (x2,y2) = strokebbox_bbox s+  setLineWidth (stroke_width s) +  let BBox (x1,y1) (x2,y2) = strokebbox_bbox sbbox   rectangle x1 y1 (x2-x1) (y2-y1)   stroke   -cairoDrawPageBBoxOnly :: PageBBoxMap -> Render ()  +cairoDrawPageBBoxOnly :: TPageBBoxMap -> Render ()   cairoDrawPageBBoxOnly page = do-    let layers =  pageLayers page-    cairoDrawBackground page +    let layers =  glayers page+    cairoDrawBackground (toPage id page)     mapM_ cairoDrawLayerBBoxOnly layers -cairoDrawLayerBBoxOnly :: LayerBBox -> Render () -cairoDrawLayerBBoxOnly  = mapM_ cairoOneStrokeBBoxOnly . layerStrokes +cairoDrawLayerBBoxOnly :: TLayerBBox -> Render () +cairoDrawLayerBBoxOnly  = mapM_ cairoOneStrokeBBoxOnly . gstrokes   ---- @@ -46,20 +50,20 @@  ---- -cairoDrawPageBBox :: Maybe BBox -> PageBBoxMap -> Render ()+cairoDrawPageBBox :: Maybe BBox -> TPageBBoxMap -> Render () cairoDrawPageBBox mbbox page = do -  cairoDrawBackgroundBBox mbbox (pageDim page) (pageBkg page) -  mapM_ (cairoDrawLayerBBox mbbox) (pageLayers page)+    cairoDrawBackgroundBBox mbbox (gdimension page) (gbackground page) +    mapM_ (cairoDrawLayerBBox mbbox) (glayers page)  -cairoDrawLayerBBox :: Maybe BBox -> LayerBBox -> Render () +cairoDrawLayerBBox :: Maybe BBox -> TLayerBBox -> Render ()  cairoDrawLayerBBox mbbox layer = do     let hittestbbox = case mbbox of                         Nothing -> NotHitted [] -                                  :- Hitted (layerbbox_strokes layer) +                                  :- Hitted (gstrokes layer)                                    :- Empty -                       Just bbox -> mkHitTestBBoxBBox bbox (layerbbox_strokes layer)-  mapM_ drawOneStroke . concatMap unHitted  . getB $ hittestbbox+                       Just bbox -> mkHitTestBBoxBBox bbox (gstrokes layer)+  mapM_ drawOneStroke . map gToStroke . concatMap unHitted  . getB $ hittestbbox   cairoDrawBackgroundBBox :: Maybe BBox -> Dimension -> Background -> Render ()
+ src/Graphics/Xournal/Render/BBoxMapPDF.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Graphics.Xournal.Render.BBoxMapPDF where++import Graphics.Xournal.Render.Type +import Data.Xournal.Simple+import Data.Xournal.Generic+import Data.Xournal.Map+import Data.Xournal.BBox+import Data.IntMap++import Data.ByteString hiding (putStrLn, empty)+import qualified Data.ByteString.Char8 as C hiding (empty)+import qualified Graphics.UI.Gtk.Poppler.Document as Poppler++import Graphics.Rendering.Cairo++data BackgroundPDFDrawable = +  BkgPDFSolid { bkgpdf_color :: ByteString+              , bkgpdf_style :: ByteString+              }+  | BkgPDFPDF { bkgpdf_domain :: Maybe ByteString+              , bkgpdf_filename :: Maybe ByteString+              , bkgpdf_pageno :: Int +              , bkgpdf_popplerpage :: Maybe Poppler.Page +              , bkgpdf_cairosurface :: Maybe Surface+              } ++data BkgPDFOption = DrawBkgPDF | DrawWhite | DrawBuffer++type TPageBBoxMapPDF = TPageBBoxMapBkg BackgroundPDFDrawable ++type TXournalBBoxMapPDF = TXournalBBoxMapBkg BackgroundPDFDrawable++type TTempPageSelectPDF = GPage BackgroundPDFDrawable (TLayerSelectInPage []) TLayerBBox++type TTempXournalSelectPDF = GSelect (IntMap TPageBBoxMapPDF) (Maybe (Int, TTempPageSelectPDF))+++instance GBackgroundable BackgroundPDFDrawable where +  gFromBackground = bkgPDFFromBkg +  gToBackground = bkgFromBkgPDF++bkgFromBkgPDF :: BackgroundPDFDrawable -> Background +bkgFromBkgPDF (BkgPDFSolid c s) = Background "solid" c s +bkgFromBkgPDF (BkgPDFPDF d f n _ _ ) = BackgroundPdf "pdf" d f n ++bkgPDFFromBkg :: Background -> BackgroundPDFDrawable+bkgPDFFromBkg (Background _t c s) = BkgPDFSolid c s+bkgPDFFromBkg (BackgroundPdf _t md mf pn) = BkgPDFPDF md mf pn Nothing Nothing+++  +emptyTXournalBBoxMapPDF :: TXournalBBoxMapPDF+emptyTXournalBBoxMapPDF = GXournal "" empty+++tlayerBBoxFromTLayerSelect :: TLayerSelect TLayerBBox -> TLayerBBox +tlayerBBoxFromTLayerSelect l = +  case unTEitherAlterHitted (gstrokes l) of+    Left strs -> GLayer strs +    Right alist -> GLayer . Prelude.concat $ interleave id unHitted alist++tpageBBoxMapPDFFromTTempPageSelectPDF :: TTempPageSelectPDF -> TPageBBoxMapPDF+tpageBBoxMapPDFFromTTempPageSelectPDF p = +  let TLayerSelectInPage s others = glayers p +      s' = tlayerBBoxFromTLayerSelect s+  in  GPage (gdimension p) (gbackground p) (gFromList (s':others))+      +      +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)+      +
+ src/Graphics/Xournal/Render/Generic.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies #-}++module Graphics.Xournal.Render.Generic where++import Data.Foldable+import Prelude hiding (mapM_)++-- import Text.Xournal.Type+import Graphics.Xournal.Render.Type +import Data.Xournal.Generic+import Data.Xournal.Simple+import Data.Xournal.BBox+import Graphics.Rendering.Cairo+import Graphics.Xournal.Render.Simple+import Graphics.Xournal.Render.BBox++class Renderable a where +  cairoRender :: a -> Render ()+                 +instance Renderable (Background,Dimension) where+  cairoRender (b,dim) = cairoDrawBkg dim b ++instance Renderable Stroke where +  cairoRender = drawOneStroke ++instance Renderable StrokeBBox where+  cairoRender = drawOneStroke . gToStroke +  +cairoLayer :: (Renderable a, Foldable s) => GLayer s a -> Render ()+cairoLayer = mapM_ cairoRender . gstrokes ++instance (Renderable a, Foldable s) => Renderable (GLayer s a) where+  cairoRender = cairoLayer ++cairoPage :: (Renderable (b,Dimension), Renderable a, Foldable s) =>  +             GPage b s a -> Render ()+cairoPage p = do +  cairoRender (gbackground p,gdimension p)+  mapM_ cairoRender (glayers p)++instance (Renderable (b,Dimension), Renderable a, Foldable s) +         => Renderable (GPage b s a) where+  cairoRender = cairoPage +++class RenderOptionable a where   +  type RenderOption a :: *+  cairoRenderOption :: RenderOption a -> a -> Render ()++instance RenderOptionable (Background,Dimension) where+  type RenderOption (Background,Dimension) = ()+  cairoRenderOption () = cairoRender ++instance RenderOptionable Stroke where+  type RenderOption Stroke = () +  cairoRenderOption () = cairoRender+  +data StrokeBBoxOption = DrawFull | DrawBoxOnly+++instance RenderOptionable StrokeBBox where+  type RenderOption StrokeBBox = StrokeBBoxOption+  cairoRenderOption DrawFull = cairoRender +  cairoRenderOption DrawBoxOnly = cairoOneStrokeBBoxOnly++cairoOptionLayer :: (RenderOptionable a, Foldable s) => +                    RenderOption a -> GLayer s a -> Render () +cairoOptionLayer opt = mapM_ (cairoRenderOption opt) . gstrokes ++instance (RenderOptionable a, Foldable s) => +         RenderOptionable (GLayer s a) where+  type RenderOption (GLayer s a) = RenderOption a+  cairoRenderOption = cairoOptionLayer ++cairoOptionPage :: ( RenderOptionable (b,Dimension)+                   , RenderOptionable a+                   , Foldable s) => +                   (RenderOption (b,Dimension), RenderOption a) +                   -> GPage b s a +                   -> Render ()+cairoOptionPage (optb,opta) p = do +    cairoRenderOption optb (gbackground p, gdimension p)+    mapM_ (cairoRenderOption opta) (glayers p)+  +instance ( RenderOptionable (b,Dimension)+         , RenderOptionable a+         , Foldable s) =>+         RenderOptionable (GPage b s a) where+  type RenderOption (GPage b s a) = (RenderOption (b,Dimension), RenderOption a)+  cairoRenderOption = cairoOptionPage+            +{-+instance (Renderable (b,Dimension)) => +         Renderable (GBackground b,Dimension) where+  cairoRender (GBackground b,dim) = cairoRender (b,dim)++instance (RenderOptionable (b,Dimension)) => +         RenderOptionable (GBackground b,Dimension) where+  type RenderOption (GBackground b,Dimension) = RenderOption (b,Dimension)+  cairoRenderOption opt (GBackground b,dim)= cairoRenderOption opt (b,dim)+-}+
+ src/Graphics/Xournal/Render/HitTest.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Graphics.Xournal.Render.HitTest where++import Data.Strict.Tuple+import Data.Xournal.Simple +import Data.Xournal.BBox +import Data.Xournal.Generic++import Graphics.Xournal.Render.Type++import Control.Applicative+import Control.Monad.State+++hitTestBBoxPoint :: BBox -> (Double,Double) -> Bool  +hitTestBBoxPoint (BBox (ulx,uly) (lrx,lry)) (x,y) +  = ulx <= x && x <= lrx && uly <= y && y <= lry ++hitTestLineLine :: ((Double,Double),(Double,Double)) -> ((Double,Double),(Double,Double)) -> Bool +hitTestLineLine ((x1,y1),(x2,y2)) ((x3,y3),(x4,y4)) = +    (x2-xc)*(xc-x1)>=0 && (x3-xc)*(xc-x4) >=0 +  where x21 = x2-x1 +        x43 = x4-x3 +        y21 = y2-y1 +        y43 = y4-y3+        -- denom = y21*x43-y43*x21 +        xc = (x21*x43*(y3-y1)+y21*x43*x1-y43*x21*x3)/(y21*x43-y43*x21)+        +hitTestLineStroke :: ((Double,Double),(Double,Double)) +                     -> Stroke+                     -> Bool+hitTestLineStroke line1 str = test (stroke_data str) +  where test [] = False+        test ((_:!:_):[]) = False+        test ((x0:!:y0):(x:!:y):rest) +          = hitTestLineLine line1 ((x0,y0),(x,y))+            || test ((x:!:y) : rest)+            +mkHitTestAL :: (StrokeBBox -> Bool) +            -> [StrokeBBox]+            -> AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox)+mkHitTestAL test strs = evalState (mkHitTestALState test strs) False++mkHitTestALState :: (StrokeBBox -> Bool) +                 -> [StrokeBBox]+                 -> State Bool (AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox))+mkHitTestALState test strs = do +  let (nhit,rest) = break test  strs+      (hit,rest') = break (not.test) rest +  st <- get+  put (st || (not.null) hit) +  if null rest' +    then return (NotHitted nhit :- Hitted hit :- NotHitted [] :- Empty)+    else return (NotHitted nhit :- Hitted hit :- mkHitTestAL test rest')+++mkHitTestBBox :: ((Double,Double),(Double,Double))+                 -> [StrokeBBox]+                 -> AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox)+mkHitTestBBox (p1,p2) = mkHitTestAL boxhittest +  where boxhittest s = hitTestBBoxPoint (strokebbox_bbox s) p1+                       || hitTestBBoxPoint (strokebbox_bbox s) p2++mkHitTestBBoxBBox :: BBox -> [StrokeBBox] -> AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox)+mkHitTestBBoxBBox b = mkHitTestAL (hitTestBBoxBBox b . strokebbox_bbox) ++mkHitTestInsideBBox :: BBox -> [StrokeBBox] -> AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox)+mkHitTestInsideBBox b = mkHitTestAL (hitTestInsideBBox b . strokebbox_bbox)++hitTestInsideBBox :: BBox -> BBox -> Bool +hitTestInsideBBox b1 b2@(BBox (ulx2,uly2) (lrx2,lry2)) +  = hitTestBBoxPoint b1 (ulx2,uly2)+    && hitTestBBoxPoint b1 (lrx2,lry2)+++hitTestBBoxBBox :: BBox -> BBox -> Bool  +hitTestBBoxBBox b1@(BBox (ulx1,uly1) (lrx1,lry1)) b2@(BBox (ulx2,uly2) (lrx2,lry2))+  = hitTestBBoxPoint b2 (ulx1,uly1)+    || hitTestBBoxPoint b2 (lrx1,lry1)+    || hitTestBBoxPoint b2 (lrx1,uly1)+    || hitTestBBoxPoint b2 (ulx1,lry1)+    || hitTestBBoxPoint b1 (lrx2,lry2)+    || hitTestBBoxPoint b1 (ulx2,uly2)+ +++mkHitTestStroke :: ((Double,Double),(Double,Double))+                -> [StrokeBBox]+                -> State Bool (AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox))+mkHitTestStroke line = mkHitTestALState (hitTestLineStroke line . gToStroke)+  +hitTestStrokes :: ((Double,Double),(Double,Double))+               -> AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox)+               -> State Bool (AlterList (NotHitted StrokeBBox) StrokeHitted)+hitTestStrokes _ Empty = error "something is wrong, invariant broken"+hitTestStrokes _ (n:-Empty) = return (n:-Empty)+hitTestStrokes line (n:-h:-rest) = do +  h' <- mkHitTestStroke line (unHitted h)+  (n:-) . (h':-) <$> hitTestStrokes line rest+  +elimHitted :: AlterList (NotHitted StrokeBBox) (Hitted StrokeBBox) -> State (Maybe BBox) [StrokeBBox]+elimHitted Empty = error "something wrong in elimHitted"+elimHitted (n:-Empty) = return (unNotHitted n)+elimHitted (n:-h:-rest) = do  +  bbox <- get+  let bbox2 = getTotalBBox (unHitted h) +  put (merge bbox bbox2) +  return . (unNotHitted n ++) =<< elimHitted rest++                 +merge :: Maybe BBox -> Maybe BBox -> Maybe BBox    +merge Nothing Nothing = Nothing+merge Nothing (Just b) = Just b+merge (Just b) Nothing = Just b +merge (Just (BBox (x1,y1) (x2,y2))) (Just (BBox (x3,y3) (x4,y4))) +  = Just (BBox (min x1 x3, min y1 y3) (max x2 x4,max y2 y4))  +    +getTotalBBox :: [StrokeBBox] -> Maybe BBox +getTotalBBox = foldl f Nothing +  where f acc = merge acc . Just . strokebbox_bbox++++++
+ src/Graphics/Xournal/Render/PDFBackground.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE ExistentialQuantification, OverloadedStrings, +             FlexibleInstances, FlexibleContexts,  +             TypeFamilies #-}++module Graphics.Xournal.Render.PDFBackground where++import Control.Monad.State++import Data.Monoid +import Data.ByteString hiding (putStrLn)+import qualified Data.ByteString.Char8 as C+import Data.Xournal.Generic+import Data.Xournal.Simple+import Data.Xournal.BBox+import Graphics.Xournal.Render.BBoxMapPDF+import Graphics.Xournal.Render.Generic+import Graphics.Xournal.Render.Type+++import qualified Graphics.UI.Gtk.Poppler.Document as Poppler+import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage++import Graphics.Rendering.Cairo++  +data Context = Context { ctxt_domain :: ByteString+                       , ctxt_filename :: ByteString +                       , ctxt_doc :: Maybe Poppler.Document+                       }+++mkTXournalBBoxMapPDF :: Xournal -> IO TXournalBBoxMapPDF+mkTXournalBBoxMapPDF xoj = do +  let pgs = xoj_pages xoj +  npgs <- mkAllTPageBBoxMapPDF pgs +  return $ GXournal (xoj_title xoj) (gFromList npgs)+  +mkAllTPageBBoxMapPDF :: [Page] -> IO [TPageBBoxMapPDF]+mkAllTPageBBoxMapPDF pgs = evalStateT (mapM mkPagePDF pgs) Nothing +++mkPagePDF :: Page -> StateT (Maybe Context) IO TPageBBoxMapPDF+mkPagePDF pg = do  +  let bkg = page_bkg pg+      dim = page_dim pg +      ls = page_layers pg+  newbkg <- mkBkgPDF bkg+  return $ GPage dim newbkg (gFromList . Prelude.map fromLayer $ ls)+  +mkBkgPDF :: Background +            -> StateT (Maybe Context) IO BackgroundPDFDrawable+mkBkgPDF bkg = do  +  let bkgpdf = bkgPDFFromBkg bkg+  case bkgpdf of +    BkgPDFSolid _ _ -> return bkgpdf +    BkgPDFPDF md mf pn _ _ -> do +      mctxt <- get +      case mctxt of+        Nothing -> do +          case (md,mf) of +            (Just d, Just f) -> do +              liftIO $ putStrLn "hey"+              mdoc <- popplerGetDocFromFile f+              put $ Just (Context d f mdoc)+              case mdoc of +                Just doc -> do  +                  (mpg,msfc) <- popplerGetPageFromDoc doc pn +                  return (bkgpdf {bkgpdf_popplerpage = mpg, bkgpdf_cairosurface = msfc}) +            _ -> return bkgpdf +        Just (Context oldd oldf olddoc) -> do +          (mpage,msfc) <- case olddoc of +            Just doc -> do +              popplerGetPageFromDoc doc pn+            Nothing -> return (Nothing,Nothing) +          return $ BkgPDFPDF md mf pn mpage msfc+            +popplerGetDocFromFile :: (MonadIO m) => +                         ByteString -> m (Maybe Poppler.Document)+popplerGetDocFromFile fp = +  liftIO $ Poppler.documentNewFromFile +             (C.unpack ("file://localhost" `mappend` fp)) Nothing +             +             +popplerGetPageFromDoc :: (MonadIO m) => +                         Poppler.Document -> Int -> m (Maybe Poppler.Page, Maybe Surface)+popplerGetPageFromDoc doc pn = do   +  n <- liftIO $ Poppler.documentGetNPages doc  +  liftIO $ putStrLn $ "pages : " ++ (show n)+  liftIO $ putStrLn $ "current page = " ++ show pn+  pg <- liftIO $ Poppler.documentGetPage doc (pn-1) +  (w,h) <- liftIO $ PopplerPage.pageGetSize pg+  sfc <- liftIO $ createImageSurface FormatARGB32 (floor w) (floor h)+  renderWith sfc $ do   +    setSourceRGBA 1 1 1 1+    rectangle 0 0 w h +    fill+    PopplerPage.pageRender pg+  return (Just pg, Just sfc)+++cairoRenderBackgroundPDFDrawable :: (BackgroundPDFDrawable,Dimension) +                                    -> Render ()+cairoRenderBackgroundPDFDrawable (BkgPDFSolid c s,dim) = +  cairoRender (Background "solid" c s,dim)+cairoRenderBackgroundPDFDrawable (BkgPDFPDF _ _ _ p _,dim) = do+  case p of +    Nothing -> return () +    Just pg -> do +      let Dim w h = dim +      setSourceRGBA 1 1 1 1+      rectangle 0 0 w h +      fill+      PopplerPage.pageRender pg+    +  +++instance Renderable (BackgroundPDFDrawable,Dimension) where+  cairoRender = cairoRenderBackgroundPDFDrawable+++instance RenderOptionable (BackgroundPDFDrawable,Dimension) where+  type RenderOption (BackgroundPDFDrawable,Dimension) = BkgPDFOption +  cairoRenderOption DrawBkgPDF (b,dim) = cairoRenderBackgroundPDFDrawable (b,dim)+  cairoRenderOption DrawWhite (_,Dim w h) = do +    setSourceRGBA 1 1 1 1+    rectangle 0 0 w h +    fill +  cairoRenderOption DrawBuffer (b,dim) = do +    case b of +      BkgPDFSolid _ _ -> cairoRenderOption DrawBkgPDF (b,dim)+      BkgPDFPDF _ _ _ _ msfc -> do +        case bkgpdf_cairosurface b of +          Nothing -> cairoRenderOption DrawBkgPDF (b,dim)+          Just sfc -> do +            setSourceSurface sfc 0 0 +            paint +      ++cairoDrawPageBBoxPDF :: Maybe BBox -> TPageBBoxMapPDF -> Render ()+cairoDrawPageBBoxPDF mbbox page = do +  cairoRender page +{-  case gbackground page of +    BkgPDFSolid c s -> do +      let bkg = Background "solid" c s +          bkg +      +      page+-}    +    +  ++++++++
+ src/Graphics/Xournal/Render/Simple.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}++module Graphics.Xournal.Render.Simple where ++import Graphics.Rendering.Cairo++import Data.Strict.Tuple++import Data.Xournal.Simple+import Data.Xournal.Predefined ++import qualified Data.Map as M+import qualified Data.ByteString.Char8 as S++drawOneStroke :: Stroke -> Render ()+drawOneStroke s = do +  case M.lookup (stroke_color s) predefined_pencolor of+    Just (r,g,b,a) -> setSourceRGBA r g b a +    Nothing -> setSourceRGBA 0 0 0 1+  setLineWidth . stroke_width $ s +  drawOneStrokeCurve . stroke_data $ s+  stroke++drawOneStrokeCurve :: [Pair Double Double] -> Render ()+drawOneStrokeCurve ((x0 :!: y0) : xs) = do +  x0 `seq` y0 `seq` moveTo x0 y0+  mapM_ f xs +    where f (x :!: y) = x `seq` y `seq` lineTo x y ++-- | general background drawing (including pdf file)++cairoDrawBackground :: Page -> Render () +cairoDrawBackground page = do +  let Dim w h = page_dim page +  case page_bkg page of +    Background typ col sty -> cairoDrawBkg (Dim w h) (Background typ col sty)+    bpdf@(BackgroundPdf _ mdomain mfilename pagenum) -> +      cairoDrawPdfBkg (Dim w h) mdomain mfilename pagenum   +++cairoDrawPdfBkg :: Dimension -> Maybe S.ByteString +                   -> Maybe S.ByteString -> Int +                   -> Render () +cairoDrawPdfBkg = do +  error "pdf bkg is not implemented"++cairoDrawBkg :: Dimension -> Background -> Render () +cairoDrawBkg (Dim w h) (Background typ col sty) = do +  let c = M.lookup col predefined_bkgcolor  +  case c of +    Just (r,g,b,a) -> setSourceRGB r g b +    Nothing        -> setSourceRGB 1 1 1 +  rectangle 0 0 w h +  fill+  cairoDrawRuling w h sty+cairoDrawBkg (Dim w h) (BackgroundPdf typ mdomain mfilename pagenum) = do +  setSourceRGBA 1 1 1 1+  rectangle 0 0 w h +  fill++cairoDrawRuling :: Double -> Double -> S.ByteString -> Render () +cairoDrawRuling w h style = do+  let drawHorizRules = do +      let (r,g,b,a) = predefined_RULING_COLOR         +      setSourceRGBA r g b a +      setLineWidth predefined_RULING_THICKNESS+      let drawonerule y = do +            moveTo 0 y +            lineTo w y+            stroke  +      mapM_ drawonerule [ predefined_RULING_TOPMARGIN +                        , predefined_RULING_TOPMARGIN+predefined_RULING_SPACING+                        .. +                        h-1 ]+  case style of +    "plain" -> return () +    "lined" -> do +      drawHorizRules+      let (r2,g2,b2,a2) = predefined_RULING_MARGIN_COLOR+      setSourceRGBA r2 g2 b2 a2 +      setLineWidth predefined_RULING_THICKNESS+      moveTo predefined_RULING_LEFTMARGIN 0 +      lineTo predefined_RULING_LEFTMARGIN h+      stroke+    "ruled" -> drawHorizRules +    "graph" -> do +      let (r3,g3,b3,a3) = predefined_RULING_COLOR +      setSourceRGBA r3 g3 b3 a3 +      setLineWidth predefined_RULING_THICKNESS+      let drawonegraphvert x = do +            moveTo x 0 +            lineTo x h+            stroke  +      let drawonegraphhoriz y = do +            moveTo 0 y+            lineTo w y+            stroke+      mapM_ drawonegraphvert  [0,predefined_RULING_GRAPHSPACING..w-1] +      mapM_ drawonegraphhoriz [0,predefined_RULING_GRAPHSPACING..h-1]+    _ -> return ()     ++cairoDrawPage :: Page -> Render ()+cairoDrawPage page = do +  let strokes = (layer_strokes . (!!0) . page_layers) page +      (Dim w h) = page_dim page+  cairoDrawBackground page+  setLineCap LineCapRound+  setLineJoin LineJoinRound++  mapM_ drawOneStroke strokes+  stroke++
+ src/Graphics/Xournal/Render/Type.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE TypeFamilies #-}++module Graphics.Xournal.Render.Type where++import Prelude hiding (fst,snd)+import Data.Strict.Tuple +import Data.ByteString hiding (map, minimum, maximum)++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 family StrokeTypeFromLayer a  :: * +     +type instance StrokeTypeFromLayer TLayerBBox = StrokeBBox+ ++data TLayerSelectInPage s a = TLayerSelectInPage +                              { gselectedlayer :: TLayerSelect a +                              , gotherlayers :: 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 +++  +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/Type.hs 
@@ -1,148 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--module Graphics.Xournal.Type where--import Prelude hiding (fst,snd)-import Data.Strict.Tuple -import Data.ByteString hiding (map, minimum, maximum)--import Text.Xournal.Type --data AlterList a b = Empty | a :- AlterList b a-                   deriving (Show)--infixr 6 :---newtype NotHitted = NotHitted { unNotHitted :: [StrokeBBox] } -                  deriving (Show)--newtype Hitted = Hitted { unHitted :: [StrokeBBox] } -                 deriving (Show)--type StrokeHitted = AlterList NotHitted Hitted ---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) --------data BBox = BBox { bbox_upperleft :: (Double,Double) -                 , bbox_lowerright :: (Double,Double) } -          deriving (Show)--data XournalBBox = XournalBBox { xojbbox_pages :: [PageBBox] }--data PageBBox = PageBBox { pagebbox_dim :: Dimension-                         , pagebbox_bkg :: Background-                         , pagebbox_layers :: [LayerBBox] } --data LayerBBox = LayerBBox { layerbbox_strokes :: [StrokeBBox] } --data StrokeBBox = StrokeBBox { strokebbox_tool :: ByteString-                             , strokebbox_color :: ByteString -                             , strokebbox_width :: Double-                             , strokebbox_data :: [Pair Double Double] -                             , strokebbox_bbox :: BBox }-                deriving (Show)-                         ---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 ---  -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) } -  -mkStrokeBBoxFromStroke :: Stroke -> StrokeBBox-mkStrokeBBoxFromStroke str = -  StrokeBBox { strokebbox_tool = stroke_tool str -             , strokebbox_color = stroke_color str -             , strokebbox_width = stroke_width str -             , strokebbox_data = stroke_data str -             , strokebbox_bbox = mkbbox (stroke_data str) } -  -mkbbox :: [Pair Double Double] -> BBox -mkbbox lst = let xs = map fst lst -                 ys = map snd lst-             in  BBox { bbox_upperleft = (minimum xs, minimum ys)-                      , bbox_lowerright = (maximum xs, maximum ys) } - -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) }-  -strokeFromStrokeBBox :: StrokeBBox -> Stroke -strokeFromStrokeBBox strbbox = -  Stroke { stroke_tool = strokebbox_tool strbbox-         , stroke_color = strokebbox_color strbbox-         , stroke_width= strokebbox_width strbbox-         , stroke_data = strokebbox_data strbbox } -  -------emptyLayer :: Layer -emptyLayer = Layer { layer_strokes = [] }--newPageFromOld :: Page -> Page-newPageFromOld page = -  Page { page_dim = page_dim page -       , page_bkg = page_bkg page -       , page_layers = [emptyLayer] } -                   --
− src/Graphics/Xournal/Type/Map.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--module Graphics.Xournal.Type.Map where--import qualified Data.IntMap as M-import Text.Xournal.Type-import Graphics.Xournal.Type --data XournalBBoxMap = XournalBBoxMap { xbm_pages :: M.IntMap PageBBoxMap } --data PageBBoxMap = PageBBoxMap { pbm_dim :: Dimension-                               , pbm_bkg :: Background-                               , pbm_layers :: M.IntMap LayerBBox }---instance IPage PageBBoxMap where-  type TLayer PageBBoxMap = LayerBBox-  pageDim = pbm_dim -  pageBkg = pbm_bkg-  pageLayers = M.elems . pbm_layers-  -instance IXournal XournalBBoxMap where-  type TPage XournalBBoxMap = PageBBoxMap -  xournalPages = M.elems . xbm_pages -  --mkXournalBBoxMapFromXournalBBox :: XournalBBox -> XournalBBoxMap -mkXournalBBoxMapFromXournalBBox xoj = -  XournalBBoxMap { xbm_pages = M.map mkPageBBoxMapFromPageBBox -                             . M.fromList -                             $ zip [0..] (xojbbox_pages xoj) }  --mkPageBBoxMapFromPageBBox :: PageBBox -> PageBBoxMap-mkPageBBoxMapFromPageBBox page = -  PageBBoxMap { pbm_dim = pagebbox_dim page-              , pbm_bkg = pagebbox_bkg page-              , pbm_layers = M.fromList $ zip [0..] (pagebbox_layers page) }--mkXournalBBoxMapFromXournal :: Xournal -> XournalBBoxMap -mkXournalBBoxMapFromXournal = mkXournalBBoxMapFromXournalBBox . mkXournalBBoxFromXournal --xournalFromXournalBBoxMap :: XournalBBoxMap -> Xournal -xournalFromXournalBBoxMap xoj = -  emptyXournal { xoj_pages = map pageFromPageBBoxMap (xournalPages xoj) } -  -pageFromPageBBoxMap :: PageBBoxMap -> Page -pageFromPageBBoxMap page = -  let pbox  = PageBBox { pagebbox_dim = pbm_dim page-                       , pagebbox_bkg = pbm_bkg page-                       , pagebbox_layers = pageLayers page }-  in pageFromPageBBox pbox - -  -  -
− src/Graphics/Xournal/Type/Select.hs 
@@ -1,100 +0,0 @@-module Graphics.Xournal.Type.Select where--import Text.Xournal.Type-import Graphics.Xournal.Type-import Graphics.Xournal.Type.Map--import qualified Data.IntMap as M---- type WholeOrPart a b = Either a (AlterList a b)--data XournalSelect = -  XournalSelect -  { pages :: Either (M.IntMap PageBBoxMap) (AlterList [PageBBox] [PageSelect])-  }--data PageSelect = -  PageSelect -  { dimension :: Dimension-  , background :: Background-  , layers :: Either (M.IntMap LayerBBox) (AlterList [LayerBBox] [LayerSelect]) -  } --data TempXournalSelect = -  TempXournalSelect -  { tx_pages :: M.IntMap PageBBoxMap -  , tx_selectpage :: Maybe (Int, TempPageSelect)-  }--data TempPageSelect = -  TempPageSelect -  { tp_dim :: Dimension -  , tp_bkg :: Background-  , tp_firstlayer :: LayerSelect-  , tp_otherlayer :: [LayerBBox] -  }--data LayerSelect = -  LayerSelect { strokes :: Either [StrokeBBox] (AlterList [StrokeBBox] Hitted)-              } --xournalSelectFromXournalBBoxMap :: XournalBBoxMap -> XournalSelect -xournalSelectFromXournalBBoxMap xoj = -  XournalSelect { pages = Left (xbm_pages xoj) } -  -tempXournalSelectFromXournalBBoxMap :: XournalBBoxMap -> TempXournalSelect -tempXournalSelectFromXournalBBoxMap xoj = -  TempXournalSelect { tx_pages = xbm_pages xoj -                    , tx_selectpage = Nothing } --tempPageSelectFromPageBBoxMap :: PageBBoxMap -> TempPageSelect -tempPageSelectFromPageBBoxMap pbox = -   TempPageSelect { tp_dim = pageDim pbox-                  , tp_bkg = pageBkg pbox-                  , tp_firstlayer = LayerSelect . Left . layerStrokes -                                    . head . pageLayers $ pbox-                  , tp_otherlayer = tail (pageLayers pbox)-                  }---pageBBoxMapFromTempPageSelect :: TempPageSelect -> PageBBoxMap-pageBBoxMapFromTempPageSelect (TempPageSelect dim bkg flayer olayers)-  = PageBBoxMap dim bkg lmap -  where l = layerBBoxFromLayerSelect flayer -        lmap = M.fromList $ zip [0..] (l:olayers)---layerBBoxFromLayerSelect :: LayerSelect -> LayerBBox -layerBBoxFromLayerSelect layer = -  let newstrs = case strokes layer of-                  Left strs -> strs                -                  Right alstrs -> concat $ interleave id unHitted $ alstrs-  in  LayerBBox newstrs -      -pageBBoxMapFromPageSelect :: PageSelect -> PageBBoxMap-pageBBoxMapFromPageSelect page = -  let newlyrs = case layers page of  -                  Left ls -> ls   -                  Right allyrs -> -                    let layerlst = concat -                                   . interleave id -                                                (map layerBBoxFromLayerSelect) -                                   $ allyrs -                    in  M.fromList $ zip [0..] layerlst -  in  PageBBoxMap { pbm_dim = dimension page  -                  , pbm_bkg = background page-                  , pbm_layers = newlyrs }-      -xournalBBoxMapFromXournalSelect :: XournalSelect -> XournalBBoxMap-xournalBBoxMapFromXournalSelect xoj = -  let newpgs = case pages xoj of -                 Left ps -> ps -                 Right alpgs -> -                   let pglst = concat -                               . interleave (map mkPageBBoxMapFromPageBBox) -                                            (map pageBBoxMapFromPageSelect) -                               $ alpgs-                   in  M.fromList $ zip [0..] pglst -  in  XournalBBoxMap newpgs--------------------
xournal-render.cabal view
@@ -1,13 +1,18 @@ Name:		xournal-render-Version:	0.2.0.0+Version:	0.3 Synopsis:       Xournal file renderer-Description: 	Xournal file renderer+Description: 	Rendering library using cairo for xournal file format License: 	BSD3 License-file:	LICENSE Author:		Ian-Woo Kim Maintainer: 	Ian-Woo Kim <ianwookim@gmail.com>+Category:       Graphics Build-Type: 	Simple Cabal-Version:  >= 1.8+data-files:     CHANGES+Source-repository head+  type: git+  location: http://www.github.com/wavewave/xournal-render   @@ -19,20 +24,23 @@                  base == 4.*,                   mtl == 2.*,                   containers == 0.4.*, -                 xournal-parser == 0.2.*,                   cairo == 0.12.*,                   strict == 0.3.*, -                 bytestring == 0.9.*+                 bytestring == 0.9.*,+                 poppler == 0.12.*, +                 fclabels == 1.0.*, +                 xournal-types == 0.1.* +                 -- xournal-parser >= 0.2.0.999 && < 0.3,    Exposed-Modules: -                   Graphics.Xournal.Render+                   Graphics.Xournal.Render.Simple                    Graphics.Xournal.Render.BBox-                   Graphics.Xournal.HitTest-                   Graphics.Xournal.Type-                   Graphics.Xournal.Type.Map-                   Graphics.Xournal.Type.Select---+                   Graphics.Xournal.Render.Generic+                   Graphics.Xournal.Render.PDFBackground+                   Graphics.Xournal.Render.BBoxMapPDF+                   Graphics.Xournal.Render.HitTest+                   Graphics.Xournal.Render.Type+---                   Graphics.Xournal.Type.Map+--                  Graphics.Xournal.Type.Select+--                   Graphics.Xournal.Type.Generic+                   - -