packages feed

xournal-types 0.3.1 → 0.3.2

raw patch · 4 files changed

+57/−8 lines, 4 files

Files

src/Data/Xournal/BBox.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -10,16 +10,20 @@ -- Stability   : experimental -- Portability : GHC --+-----------------------------------------------------------------------------  module Data.Xournal.BBox where  import Control.Monad import Data.ByteString hiding (map,maximum,minimum)+-- import qualified Data.Sequence as Seq import Data.Xournal.Generic import Data.Xournal.Simple import Data.Strict.Tuple +import qualified Data.Foldable as F import Data.Monoid import Prelude hiding (fst,snd)+import qualified Prelude as Prelude (fst,snd)  data BBox = BBox { bbox_upperleft :: (Double,Double)                   , bbox_lowerright :: (Double,Double) } @@ -48,13 +52,38 @@              in  BBox { bbox_upperleft = (minimum xs, minimum ys)                       , bbox_lowerright = (maximum xs, maximum ys) }  +mkbboxF :: (F.Foldable m, Functor m) => m (Double,Double) -> BBox +mkbboxF lst = +  let xs = fmap Prelude.fst lst  +      ys = fmap Prelude.snd lst +  in BBox{bbox_upperleft=(F.minimum xs, F.minimum ys)+         ,bbox_lowerright=(F.maximum xs, F.maximum ys)}+ dimToBBox :: Dimension -> BBox  dimToBBox (Dim w h) = BBox (0,0) (w,h) +-- | transform BBox+         +xformBBox :: ((Double,Double) -> (Double,Double)) -> BBox -> BBox +xformBBox f (BBox c1 c2) = BBox (f c1) (f c2)++-- | ++moveBBoxToOrigin :: BBox -> BBox +moveBBoxToOrigin (BBox (x0,y0) (x1,y1)) = BBox (0,0) (x1-x0,y1-y0)++-- |++moveBBoxByOffset :: (Double,Double) -> BBox -> BBox +moveBBoxByOffset (xoff,yoff) (BBox (x0,y0) (x1,y1)) = BBox (x0+xoff,y0+yoff) (x1+xoff,y1+yoff)++moveBBoxULCornerTo :: (Double,Double) -> BBox -> BBox +moveBBoxULCornerTo (x,y) b@(BBox (x0,y0) _) = moveBBoxByOffset (x-x0,y-y0) b + intersectBBox :: BBox -> BBox -> Maybe BBox intersectBBox (BBox (x1,y1) (x2,y2)) (BBox (x3,y3) (x4,y4)) = do    guard $ (x1 <= x3 && x3 <= x2) || (x3 <= x1 && x1 <= x4 ) -  guard $ (y1 <= y3 && y3 <= y4) || (y3 <= y1 && y1 <= y4 )+  guard $ (y1 <= y3 && y3 <= y2) || (y3 <= y1 && y1 <= y4 )   let x5 = if x1 <= x3 then x3 else x1        y5 = if y1 <= y3 then y3 else y1        x6 = min x2 x4 @@ -79,16 +108,23 @@       data ULMaybe a = Bottom | Middle a | Top            +deriving instance Show a => Show (ULMaybe a)++deriving instance Eq a => Eq (ULMaybe a)+                                      newtype IntersectBBox = Intersect { unIntersect :: ULMaybe BBox } +                        deriving (Show,Eq)  newtype UnionBBox = Union { unUnion :: ULMaybe BBox }+                    deriving (Show,Eq)       instance Monoid (IntersectBBox) where    (Intersect Bottom) `mappend` _ = Intersect Bottom   _ `mappend` (Intersect Bottom) = Intersect Bottom    (Intersect Top) `mappend` x = x    x `mappend` (Intersect Top) = x -  (Intersect (Middle x)) `mappend` (Intersect (Middle y)) = fromMaybe (x `intersectBBox` y)+  (Intersect (Middle x)) `mappend` (Intersect (Middle y)) = +    maybe (Intersect Bottom) (Intersect . Middle) (x `intersectBBox` y)   mempty = Intersect Top     instance Monoid (UnionBBox) where@@ -106,7 +142,7 @@    instance Maybeable IntersectBBox where   type ElemType IntersectBBox = BBox-  toMaybe (Intersect Bottom) = error "empty intersectbbox"+  toMaybe (Intersect Bottom) = Nothing  -- error "empty intersectbbox"   toMaybe (Intersect Top) = Nothing    toMaybe (Intersect (Middle x)) = Just x    fromMaybe Nothing = Intersect Top @@ -114,7 +150,7 @@    instance Maybeable UnionBBox where   type ElemType UnionBBox = BBox-  toMaybe (Union Bottom) = error "empty unionbbox"+  toMaybe (Union Bottom) = Nothing -- error "empty unionbbox"   toMaybe (Union Top) = Nothing    toMaybe (Union (Middle x)) = Just x    fromMaybe Nothing = Union Top 
src/Data/Xournal/Buffer.hs view
@@ -15,10 +15,10 @@  import Data.IntMap  import Data.Xournal.Select-import Data.Xournal.Simple+-- import Data.Xournal.Simple import Data.Xournal.Generic import Data.Xournal.BBox-import Data.Xournal.Map+-- import Data.Xournal.Map  type TLayerBBoxBuf buf = GLayerBuf buf [] StrokeBBox 
src/Data/Xournal/Generic.hs view
@@ -201,6 +201,19 @@  ----  +-- |+ emptyPageFromOldPage :: (GListable s) => GPage b s a -> GPage b s a emptyPageFromOldPage p = GPage (get g_dimension p) (get g_background p) (gFromList [] ) +----++-- | ++printLayerStructureInPage :: (GListable s) => +                              GPage b s (GLayerBuf buf [] a) -> IO () +printLayerStructureInPage page = do +  let lyrs = get g_layers page +      lst = fmap (Prelude.length . get g_bstrokes) (gToList lyrs)+  (Prelude.putStrLn . ("num of layers = "++) . show . Prelude.length . gToList ) lyrs +  Prelude.putStrLn $ "layer strokes = " ++ show lst 
xournal-types.cabal view
@@ -1,5 +1,5 @@ Name:		xournal-types-Version:	0.3.1+Version:	0.3.2 Synopsis:	Data types for programs for xournal file format Description: 	Xournal file format data type including generic interface License: 	BSD3