xournal-render (empty) → 0.2.0.0
raw patch · 9 files changed
+736/−0 lines, 9 filesdep +basedep +bytestringdep +cairosetup-changed
Dependencies added: base, bytestring, cairo, containers, mtl, strict, xournal-parser
Files
- LICENSE +25/−0
- Setup.lhs +10/−0
- src/Graphics/Xournal/HitTest.hs +126/−0
- src/Graphics/Xournal/Render.hs +108/−0
- src/Graphics/Xournal/Render/BBox.hs +126/−0
- src/Graphics/Xournal/Type.hs +148/−0
- src/Graphics/Xournal/Type/Map.hs +55/−0
- src/Graphics/Xournal/Type/Select.hs +100/−0
- xournal-render.cabal +38/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010-2011, Ian-Woo Kim. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,10 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> import Distribution.PackageDescription+> --import System.Process+> main = defaultMain+> --main = defaultMainWithHooks testUserHooks+> --testUserHooks = simpleUserHooks { +> -- preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo+> -- }
+ src/Graphics/Xournal/HitTest.hs view
@@ -0,0 +1,126 @@+{-# 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 view
@@ -0,0 +1,108 @@+{-# 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
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}++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.Type.Map++import Text.Xournal.Type +import Text.Xournal.Predefined ++import qualified Data.Map as M++import Data.ByteString hiding (map, minimum, maximum, concat, concatMap, filter )+++import Prelude hiding (fst,snd,curry,uncurry)+++cairoOneStrokeBBoxOnly :: StrokeBBox -> Render () +cairoOneStrokeBBoxOnly 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) + let BBox (x1,y1) (x2,y2) = strokebbox_bbox s+ rectangle x1 y1 (x2-x1) (y2-y1)+ stroke+ +cairoDrawPageBBoxOnly :: PageBBoxMap -> Render () +cairoDrawPageBBoxOnly page = do+ let layers = pageLayers page+ cairoDrawBackground page + mapM_ cairoDrawLayerBBoxOnly layers++cairoDrawLayerBBoxOnly :: LayerBBox -> Render () +cairoDrawLayerBBoxOnly = mapM_ cairoOneStrokeBBoxOnly . layerStrokes ++----++inflate :: BBox -> Double -> BBox +inflate (BBox (x1,y1) (x2,y2)) r = BBox (x1-r,y1-r) (x2+r,y2+r)++----++cairoDrawPageBBox :: Maybe BBox -> PageBBoxMap -> Render ()+cairoDrawPageBBox mbbox page = do + cairoDrawBackgroundBBox mbbox (pageDim page) (pageBkg page) + mapM_ (cairoDrawLayerBBox mbbox) (pageLayers page)+++cairoDrawLayerBBox :: Maybe BBox -> LayerBBox -> Render () +cairoDrawLayerBBox mbbox layer = do + let hittestbbox = case mbbox of + Nothing -> NotHitted [] + :- Hitted (layerbbox_strokes layer) + :- Empty + Just bbox -> mkHitTestBBoxBBox bbox (layerbbox_strokes layer)+ mapM_ drawOneStroke . concatMap unHitted . getB $ hittestbbox+++cairoDrawBackgroundBBox :: Maybe BBox -> Dimension -> Background -> Render ()+cairoDrawBackgroundBBox mbbox (Dim w h) (Background typ col sty) = + case mbbox of + Nothing -> cairoDrawBkg (Dim w h) (Background typ col sty)+ Just bbox@(BBox (x1,y1) (x2,y2)) -> 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 x1 y1 (x2-x1) (y2-y1)+ fill+ cairoDrawRulingBBox bbox w h sty++cairoDrawRulingBBox :: BBox -> Double -> Double -> ByteString -> Render () +cairoDrawRulingBBox bbox@(BBox (x1,y1) (x2,y2)) w h style = do+ let drawonerule y = do + moveTo x1 y + lineTo x2 y+ stroke + let drawonegraphvert x = do + moveTo x y1 + lineTo x y2+ stroke + let drawonegraphhoriz y = do + moveTo x1 y+ lineTo x2 y+ stroke+ fullRuleYs = [ predefined_RULING_TOPMARGIN + , predefined_RULING_TOPMARGIN+predefined_RULING_SPACING+ .. + h-1 ]+ ruleYs = filter (\y-> (y <= y2) && (y >= y1)) fullRuleYs+ fullGraphXs = [0,predefined_RULING_GRAPHSPACING..w-1] + fullGraphYs = [0,predefined_RULING_GRAPHSPACING..h-1]+ graphXs = filter (\x->(x<=x2)&&(x>=x1)) fullGraphXs+ graphYs = filter (\y->(y<=y2)&&(y>=y1)) fullGraphYs + + let drawHorizRules = do + let (r,g,b,a) = predefined_RULING_COLOR + setSourceRGBA r g b a + setLineWidth predefined_RULING_THICKNESS+ mapM_ drawonerule ruleYs+ + + 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+ mapM_ drawonegraphvert graphXs + mapM_ drawonegraphhoriz graphYs+ _ -> return ()
+ src/Graphics/Xournal/Type.hs view
@@ -0,0 +1,148 @@+{-# 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 view
@@ -0,0 +1,55 @@+{-# 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 view
@@ -0,0 +1,100 @@+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
@@ -0,0 +1,38 @@+Name: xournal-render+Version: 0.2.0.0+Synopsis: Xournal file renderer+Description: Xournal file renderer+License: BSD3+License-file: LICENSE+Author: Ian-Woo Kim+Maintainer: Ian-Woo Kim <ianwookim@gmail.com>+Build-Type: Simple+Cabal-Version: >= 1.8++++Library+ hs-source-dirs: src+ ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-prof-options: -caf-all -auto-all+ Build-Depends: + base == 4.*, + mtl == 2.*, + containers == 0.4.*, + xournal-parser == 0.2.*, + cairo == 0.12.*, + strict == 0.3.*, + bytestring == 0.9.*+ Exposed-Modules: + Graphics.Xournal.Render+ Graphics.Xournal.Render.BBox+ Graphics.Xournal.HitTest+ Graphics.Xournal.Type+ Graphics.Xournal.Type.Map+ Graphics.Xournal.Type.Select+++++ +