packages feed

xournal-types 0.1 → 0.2

raw patch · 7 files changed

+131/−55 lines, 7 files

Files

CHANGES view
@@ -1,4 +1,6 @@ 0.1: 18 Dec 2011-   * First public release. +   * First public release +0.2: 25 Dec 2011+   * double buffer support
src/Data/Xournal/BBox.hs view
@@ -1,9 +1,13 @@+{-# LANGUAGE TypeFamilies #-}+ module Data.Xournal.BBox where +import Control.Monad import Data.ByteString hiding (map,maximum,minimum) import Data.Xournal.Generic import Data.Xournal.Simple import Data.Strict.Tuple +import Data.Monoid import Prelude hiding (fst,snd)  data BBox = BBox { bbox_upperleft :: (Double,Double) @@ -32,6 +36,78 @@                  ys = map snd lst              in  BBox { bbox_upperleft = (minimum xs, minimum ys)                       , bbox_lowerright = (maximum xs, maximum ys) } ++dimToBBox :: Dimension -> BBox +dimToBBox (Dim w h) = BBox (0,0) (w,h)++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 )+  let x5 = if x1 <= x3 then x3 else x1 +      y5 = if y1 <= y3 then y3 else y1 +      x6 = min x2 x4 +      y6 = min y2 y4+  return (BBox (x5,y5) (x6,y6))+  +{- +  let x5 = if x1 <= x3 && x2 <= x3  && xthen x3 else x1+      y5 = if y1 < y3 then y3 else y1+      x6 = if x2 < x4 then x2 else x4+      y6 = if y2 < y4 then y2 else y4+  in BBox (x5,y5) (x6,y6) -}+     +unionBBox :: BBox -> BBox -> BBox+unionBBox (BBox (x1,y1) (x2,y2)) (BBox (x3,y3) (x4,y4)) = +  let x5 = if x1 < x3 then x1 else x3+      y5 = if y1 < y3 then y1 else y3+      x6 = if x2 < x4 then x4 else x2+      y6 = if y2 < y4 then y4 else y2+  in BBox (x5,y5) (x6,y6)+  +     +data ULMaybe a = Bottom | Middle a | Top      +     +newtype IntersectBBox = Intersect { unIntersect :: ULMaybe BBox } ++newtype UnionBBox = Union { unUnion :: ULMaybe BBox }+     +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)+  mempty = Intersect Top +  +instance Monoid (UnionBBox) where+  (Union Bottom) `mappend` x = x +  x `mappend` (Union Bottom) = x+  (Union Top) `mappend` _ = Union Top+  _ `mappend` (Union Top) = Union Top +  (Union (Middle x)) `mappend` (Union (Middle y)) = Union (Middle (x `unionBBox` y))+  mempty = Union Bottom+  +class Maybeable a where+  type ElemType a :: *+  toMaybe :: a -> Maybe (ElemType a) +  fromMaybe :: Maybe (ElemType a) -> a +  +instance Maybeable IntersectBBox where+  type ElemType IntersectBBox = BBox+  toMaybe (Intersect Bottom) = error "empty intersectbbox"+  toMaybe (Intersect Top) = Nothing +  toMaybe (Intersect (Middle x)) = Just x +  fromMaybe Nothing = Intersect Top +  fromMaybe (Just x) = Intersect (Middle x)+  +instance Maybeable UnionBBox where+  type ElemType UnionBBox = BBox+  toMaybe (Union Bottom) = error "empty unionbbox"+  toMaybe (Union Top) = Nothing +  toMaybe (Union (Middle x)) = Just x +  fromMaybe Nothing = Union Top +  fromMaybe (Just x) = Union (Middle x)   mkStrokeBBoxFromStroke :: Stroke -> StrokeBBox
+ src/Data/Xournal/Buffer.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}++module Data.Xournal.Buffer where++import Data.IntMap +import Data.Xournal.Simple+import Data.Xournal.Generic+import Data.Xournal.BBox+import Data.Xournal.Map++type TLayerBBoxBuf buf = GLayerBuf buf [] StrokeBBox++type TPageBBoxMapBkgBuf bkg buf = GPage bkg IntMap (TLayerBBoxBuf buf)++type TXournalBBoxMapBkgBuf bkg buf = +  GXournal IntMap (TPageBBoxMapBkgBuf bkg buf)+
src/Data/Xournal/Generic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, TypeOperators #-}+{-# LANGUAGE TypeFamilies, TypeOperators, MultiParamTypeClasses #-}  module Data.Xournal.Generic where @@ -21,17 +21,27 @@                          , gbackground :: b                           , glayers :: s a }   -newtype GLayer s a = GLayer { gstrokes :: s a } +data GLayer s a = GLayer { gstrokes :: s a } +            +data GLayerBuf b s a = GLayerBuf { gbuffer :: b +                                 , gbstrokes :: s a +                                 } +                         instance (Functor s) => Functor (GLayer s) where   fmap f (GLayer strs) = GLayer (fmap f strs)   +instance (Functor s) => Functor (GLayerBuf b s) where+  fmap f (GLayerBuf b strs) = GLayerBuf b (fmap f strs) +   instance (Functor s) => Functor (GPage b s) where   fmap f (GPage d b ls) = GPage d b (fmap f ls)    instance (Functor s) => Functor (GXournal s) where   fmap f (GXournal t ps) = GXournal t (fmap f ps) +class GCast a b where +  gcast :: a -> b    -- data GBackground b = GBackground b@@ -42,6 +52,7 @@                            }  + type TLayerSimple = GLayer [] Stroke   type TPageSimple = GPage Background [] TLayerSimple @@ -120,6 +131,12 @@ g_strokes :: GLayer s a :-> s a  g_strokes = lens gstrokes (\a f -> f { gstrokes = a } ) +g_bstrokes :: GLayerBuf b s a :-> s a +g_bstrokes = lens gbstrokes (\a f -> f { gbstrokes = a } )++g_buffer :: GLayerBuf b s a :-> b +g_buffer = lens gbuffer (\a f -> f { gbuffer = a } )+ g_selectTitle :: GSelect a b :-> ByteString g_selectTitle = lens gselectTitle (\a f -> f {gselectTitle = a}) @@ -131,12 +148,22 @@   ++ toLayer :: (GStrokeable a, GListable s) => GLayer s a -> Layer toLayer = layerFromTLayerSimple . fmap gToStroke . chgStreamToList  +toNoBufferLayer :: GLayerBuf b s a -> GLayer s a +toNoBufferLayer (GLayerBuf b s) = GLayer s ++ toPage :: (GStrokeable a, GBackgroundable b, GListable s, GListable s', Functor s') =>            (b->Background) -> GPage b s' (GLayer s a) -> Page toPage f = pageFromTPageSimple . bkgchange f . chgStreamToList . fmap (fmap gToStroke . chgStreamToList) ++toPageFromBuf :: (GStrokeable a, GBackgroundable b, GListable s, GListable s', Functor s') => +              (b->Background) -> GPage b s' (GLayerBuf buf s a) -> Page+toPageFromBuf f = pageFromTPageSimple . bkgchange f . chgStreamToList . fmap (fmap gToStroke . chgStreamToList . toNoBufferLayer)    bkgchange :: (b -> b') -> GPage b s a -> GPage b' s a
src/Data/Xournal/Map.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, OverloadedStrings #-}  module Data.Xournal.Map where @@ -20,51 +20,5 @@ type TXournalBBoxMapBkg b = GXournal IntMap (TPageBBoxMapBkg b)  -{--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 - --}  -  -  +emptyGXournalMap :: GXournal IntMap a+emptyGXournalMap = GXournal "" empty
src/Data/Xournal/Simple.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BangPatterns, OverloadedStrings,  TypeOperators,               TypeFamilies, FlexibleContexts  #-}-+  module Data.Xournal.Simple where  import qualified Data.ByteString as S
xournal-types.cabal view
@@ -1,5 +1,5 @@ Name:		xournal-types-Version:	0.1+Version:	0.2 Synopsis:	Data types for programs for xournal file format Description: 	Xournal file format data type including generic interface License: 	BSD3@@ -30,7 +30,7 @@                    Data.Xournal.Simple                    Data.Xournal.BBox                    Data.Xournal.Map---                    Data.Xournal.Select+                   Data.Xournal.Buffer                    Data.Xournal.Predefined    Other-Modules: