xournal-types 0.4 → 0.5
raw patch · 6 files changed
+233/−162 lines, 6 filesdep +cerealdep +lensdep −fclabels
Dependencies added: cereal, lens
Dependencies removed: fclabels
Files
- CHANGES +2/−1
- src/Data/Xournal/BBox.hs +42/−13
- src/Data/Xournal/Generic.hs +67/−60
- src/Data/Xournal/Select.hs +43/−22
- src/Data/Xournal/Simple.hs +74/−62
- xournal-types.cabal +5/−4
CHANGES view
@@ -4,5 +4,6 @@ * double buffer support 0.3: 15 Jan 2012 * ZipperSelect support -+0.4: 12 Feb 2012 + * Variable width stroke support
src/Data/Xournal/BBox.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies, StandaloneDeriving, RecordWildCards #-} ----------------------------------------------------------------------------- -- |@@ -25,27 +25,36 @@ import Data.Monoid import Prelude hiding (fst,snd) import qualified Prelude as Prelude (fst,snd)-+import Data.Serialize -- | bounding box type data BBox = BBox { bbox_upperleft :: (Double,Double) , bbox_lowerright :: (Double,Double) } - deriving (Show,Eq)+ deriving (Show,Eq,Ord) -- | +instance Serialize BBox where+ put BBox{..} = put bbox_upperleft >> put bbox_lowerright + get = liftM2 BBox get get +++-- | + data StrokeBBox = StrokeBBox { strokebbox_stroke :: Stroke , strokebbox_bbox :: BBox } - deriving (Show)+ deriving (Show,Eq,Ord) -{- - StrokeBBox { strokebbox_tool :: ByteString- , strokebbox_color :: ByteString - , strokebbox_width :: Double- , strokebbox_data :: [Pair Double Double] - , strokebbox_bbox :: BBox } -}+-- | +instance Serialize StrokeBBox where+ put StrokeBBox{..} = put strokebbox_stroke >> put strokebbox_bbox+ get = liftM2 StrokeBBox get get+ +++ type TLayerBBox = GLayer [] StrokeBBox type TPageBBox = GPage Background [] TLayerBBox @@ -56,11 +65,15 @@ gFromStroke = mkStrokeBBoxFromStroke gToStroke = strokeFromStrokeBBox +-- |+ 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) } + +-- | mkbboxF :: (F.Foldable m, Functor m) => m (Double,Double) -> BBox mkbboxF lst = @@ -69,6 +82,8 @@ in BBox{bbox_upperleft=(F.minimum xs, F.minimum ys) ,bbox_lowerright=(F.maximum xs, F.maximum ys)} +-- |+ bboxFromStroke :: Stroke -> BBox bboxFromStroke (Stroke _ _ w dat) = inflate (mkbbox dat) w bboxFromStroke (VWStroke _ _ dat) = @@ -76,6 +91,7 @@ widthmax = F.maximum (map trd3 dat) in inflate (mkbboxF dat') widthmax +-- | dimToBBox :: Dimension -> BBox dimToBBox (Dim w h) = BBox (0,0) (w,h)@@ -100,9 +116,13 @@ 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 ) @@ -113,6 +133,7 @@ y6 = min y2 y4 return (BBox (x5,y5) (x6,y6)) +-- | unionBBox :: BBox -> BBox -> BBox unionBBox (BBox (x1,y1) (x2,y2)) (BBox (x3,y3) (x4,y4)) = @@ -122,16 +143,21 @@ y6 = if y2 < y4 then y4 else y2 in BBox (x5,y5) (x6,y6) +-- | 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) @@ -152,6 +178,8 @@ (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) @@ -173,6 +201,7 @@ fromMaybe Nothing = Union Top fromMaybe (Just x) = Union (Middle x) +-- | mkStrokeBBoxFromStroke :: Stroke -> StrokeBBox mkStrokeBBoxFromStroke str = @@ -180,7 +209,7 @@ , strokebbox_bbox = bboxFromStroke str } +-- |+ strokeFromStrokeBBox :: StrokeBBox -> Stroke strokeFromStrokeBBox = strokebbox_stroke --
src/Data/Xournal/Generic.hs view
@@ -10,107 +10,115 @@ -- Stability : experimental -- Portability : GHC --+----------------------------------------------------------------------------- module Data.Xournal.Generic where -import Data.IntMap hiding (map)--- import Text.Xournal.Type-import Data.Xournal.Simple-import Data.ByteString hiding (map,zip)-+-- from other packages import Control.Applicative-import Data.Functor- import Control.Category-import Data.Label+import Control.Lens +import Data.ByteString hiding (map,zip)+import Data.Functor+import Data.IntMap hiding (map)+-- from this package+import Data.Xournal.Simple+-- import Prelude hiding ((.),id) +-- | data GXournal s a = GXournal { gtitle :: ByteString , gpages :: s a } +-- | data GPage b s a = GPage { gdimension :: Dimension , gbackground :: b , glayers :: 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-+-- | data GSelect a b = GSelect { gselectTitle :: ByteString , gselectAll :: a , gselectSelected :: b } --+-- | type TLayerSimple = GLayer [] Stroke +-- | type TPageSimple = GPage Background [] TLayerSimple +-- | type TXournalSimple = GXournal [] TPageSimple -- |- class GStrokeable a where gFromStroke :: Stroke -> a gToStroke :: a -> Stroke +-- | instance GStrokeable Stroke where gFromStroke = id gToStroke = id -- |- class GListable s where gFromList :: [a] -> s a gToList :: s a -> [a] +-- | instance GListable [] where gFromList = id gToList = id +-- | instance GListable IntMap where gFromList = Data.IntMap.fromList . zip [0..] gToList = Data.IntMap.elems -- |- class GBackgroundable b where gFromBackground :: Background -> b gToBackground :: b -> Background +-- | instance GBackgroundable Background where gFromBackground = id gToBackground = id -- |- fromLayer :: (GStrokeable a, GListable s) => Layer -> GLayer s a fromLayer = GLayer . gFromList . fmap gFromStroke . layer_strokes -- |- fromPage :: (GStrokeable a, GBackgroundable b, GListable s, GListable s') => Page -> GPage b s' (GLayer s a) @@ -120,111 +128,108 @@ in GPage dim bkg ls -- |- class SListable m where chgStreamToList :: (GListable s) => m s a -> m [] a +-- | instance SListable GLayer where chgStreamToList (GLayer xs) = GLayer (gToList xs) +-- | instance SListable (GPage b) where chgStreamToList (GPage d b ls) = GPage d b (gToList ls) +-- | instance SListable GXournal where chgStreamToList (GXournal t ps) = GXournal t (gToList ps) -- |--g_title :: GXournal s a :-> ByteString -g_title = lens gtitle (\a f -> f { gtitle = a } )+g_title :: Simple Lens (GXournal s a) ByteString+g_title = lens gtitle (\f a -> f { gtitle = a } ) -- |-g_pages :: GXournal s a :-> s a -g_pages = lens gpages (\a f -> f { gpages = a } )+g_pages :: Simple Lens (GXournal s a) (s a)+g_pages = lens gpages (\f a -> f { gpages = a } ) -- |--g_dimension :: GPage b s a :-> Dimension -g_dimension = lens gdimension (\a f -> f { gdimension = a } )+g_dimension :: Simple Lens (GPage b s a) Dimension +g_dimension = lens gdimension (\f a -> f { gdimension = a } ) -- |--g_background :: GPage b s a :-> b -g_background = lens gbackground (\a f -> f { gbackground = a } ) +g_background :: Simple Lens (GPage b s a) b +g_background = lens gbackground (\f a -> f { gbackground = a } ) -- |--g_layers :: GPage b s a :-> s a -g_layers = lens glayers (\a f -> f { glayers = a } ) +g_layers :: Simple Lens (GPage b s a) (s a)+g_layers = lens glayers (\f a -> f { glayers = a } ) -- |--g_strokes :: GLayer s a :-> s a -g_strokes = lens gstrokes (\a f -> f { gstrokes = a } )+g_strokes :: Simple Lens (GLayer s a) (s a)+g_strokes = lens gstrokes (\f a -> f { gstrokes = a } ) -- |--g_bstrokes :: GLayerBuf b s a :-> s a -g_bstrokes = lens gbstrokes (\a f -> f { gbstrokes = a } )+g_bstrokes :: Simple Lens (GLayerBuf b s a) (s a)+g_bstrokes = lens gbstrokes (\f a -> f { gbstrokes = a } ) -- |--g_buffer :: GLayerBuf b s a :-> b -g_buffer = lens gbuffer (\a f -> f { gbuffer = a } )+g_buffer :: Simple Lens (GLayerBuf b s a) b +g_buffer = lens gbuffer (\f a -> f { gbuffer = a } ) -- |--g_selectTitle :: GSelect a b :-> ByteString-g_selectTitle = lens gselectTitle (\a f -> f {gselectTitle = a})+g_selectTitle :: Simple Lens (GSelect a b) ByteString+g_selectTitle = lens gselectTitle (\f a -> f {gselectTitle = a}) -- |--g_selectAll :: GSelect a b :-> a -g_selectAll = lens gselectAll (\a f -> f {gselectAll = a} )+g_selectAll :: Simple Lens (GSelect a b) a +g_selectAll = lens gselectAll (\f a -> f {gselectAll = a} ) -- |--g_selectSelected :: GSelect a b :-> b-g_selectSelected = lens gselectSelected (\a f -> f {gselectSelected = a})+g_selectSelected :: Simple Lens (GSelect a b) b+g_selectSelected = lens gselectSelected (\f a -> f {gselectSelected = a}) -- |- 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 bkgchange f p = p { gbackground = f (gbackground p) } +-- | mkTLayerSimpleFromLayer :: Layer -> TLayerSimple mkTLayerSimpleFromLayer = GLayer <$> layer_strokes +-- | mkTPageSimpleFromPage :: Page -> TPageSimple mkTPageSimpleFromPage = GPage <$> page_dim <*> page_bkg <*> map mkTLayerSimpleFromLayer . page_layers +-- | mkTXournalSimpleFromXournal :: Xournal -> TXournalSimple mkTXournalSimpleFromXournal = GXournal <$> xoj_title <*> map mkTPageSimpleFromPage . xoj_pages +-- | layerFromTLayerSimple :: TLayerSimple -> Layer layerFromTLayerSimple = Layer <$> gstrokes +-- | pageFromTPageSimple :: TPageSimple -> Page pageFromTPageSimple = Page <$> gdimension <*> gbackground <*> map layerFromTLayerSimple . glayers +-- | xournalFromTXournalSimple :: TXournalSimple -> Xournal xournalFromTXournalSimple = Xournal <$> gtitle <*> map pageFromTPageSimple . gpages @@ -232,18 +237,20 @@ ---- -- |- emptyPageFromOldPage :: (GListable s) => GPage b s a -> GPage b s a-emptyPageFromOldPage p = GPage (get g_dimension p) (get g_background p) (gFromList [] )+emptyPageFromOldPage = GPage + <$> (^.g_dimension) + <*> (^.g_background) + <*> pure (gFromList []) +-- (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)+ let lyrs = page^.g_layers + lst = fmap (Prelude.length . (^.g_bstrokes)) (gToList lyrs) (Prelude.putStrLn . ("num of layers = "++) . show . Prelude.length . gToList ) lyrs Prelude.putStrLn $ "layer strokes = " ++ show lst
src/Data/Xournal/Select.hs view
@@ -12,6 +12,8 @@ -- Stability : experimental -- Portability : GHC --+-- representing selection of xournal type +-- ----------------------------------------------------------------------------- module Data.Xournal.Select where@@ -19,37 +21,48 @@ import Control.Applicative hiding (empty) import Control.Compose import Data.Foldable-import Data.Traversable import Data.Monoid import Data.Sequence+import Data.Traversable+-- from this package import Data.Xournal.Generic-+-- import Prelude hiding (zipWith, length, splitAt) +-- | newtype SeqZipper a = SZ { unSZ :: (a, (Seq a,Seq a)) } +-- | deriving instance Functor SeqZipper++-- | deriving instance Foldable SeqZipper +-- | instance Applicative SeqZipper where pure = singletonSZ SZ (f,(f1s,f2s)) <*> SZ (x,(y1s,y2s)) = SZ (f x, (zipWith id f1s y1s, zipWith id f2s y2s)) +-- | deriving instance Traversable SeqZipper +-- | singletonSZ :: a -> SeqZipper a singletonSZ x = SZ (x, (empty,empty)) +-- | lengthSZ :: SeqZipper a -> Int lengthSZ (SZ (_x, (x1s,x2s))) = length x1s + length x2s + 1 -+-- | currIndex :: SeqZipper a -> Int currIndex (SZ (_x, (x1s,_x2s))) = length x1s +-- | appendGoLast :: SeqZipper a -> a -> SeqZipper a appendGoLast (SZ (y,(y1s,y2s))) x = SZ (x, ((y1s |> y) >< y2s, empty)) +-- | chopFirst :: SeqZipper a -> Maybe (SeqZipper a) chopFirst (SZ (y,(y1s,y2s))) = case viewl y1s of@@ -58,60 +71,67 @@ z :< zs -> Just (SZ (z,(empty,zs))) _z :< zs -> Just (SZ (y,(zs,y2s))) +-- | moveLeft :: SeqZipper a -> Maybe (SeqZipper a) moveLeft (SZ (x,(x1s,x2s))) = case viewr x1s of EmptyR -> Nothing zs :> z -> Just (SZ (z,(zs,x<|x2s))) +-- | moveRight :: SeqZipper a -> Maybe (SeqZipper a) moveRight (SZ (x,(x1s,x2s))) = case viewl x2s of EmptyL -> Nothing z :< zs -> Just (SZ (z,(x1s|>x,zs))) +-- | moveTo :: Int -> SeqZipper a -> Maybe (SeqZipper a) moveTo n orig@(SZ (x,(x1s,x2s))) = let n_x1s = length x1s n_x2s = length x2s - result | n < 0 || n > n_x1s + n_x2s = Nothing - | n == n_x1s = Just orig - | n < n_x1s = let (x1s1, x1s2) = splitAt n x1s - el :< rm = viewl x1s2- in Just (SZ (el, (x1s1,(rm |> x) >< x2s)))- | n > n_x1s = let (x2s1,x2s2) = splitAt (n-n_x1s-1) x2s- el :< rm = viewl x2s2- in Just (SZ (el, ((x1s |> x) >< x2s1, rm)))- | otherwise = error "error in moveTo"- in result + res | n < 0 || n > n_x1s + n_x2s = Nothing + | n == n_x1s = Just orig + | n < n_x1s = let (x1s1, x1s2) = splitAt n x1s + el :< rm = viewl x1s2+ in Just (SZ (el, (x1s1,(rm |> x) >< x2s)))+ | n > n_x1s = let (x2s1,x2s2) = splitAt (n-n_x1s-1) x2s+ el :< rm = viewl x2s2+ in Just (SZ (el, ((x1s |> x) >< x2s1, rm)))+ | otherwise = error "error in moveTo"+ in res +-- | goFirst :: SeqZipper a -> SeqZipper a goFirst orig@(SZ (x,(x1s,x2s))) = case viewl x1s of EmptyL -> orig z :< zs -> SZ (z,(empty, zs `mappend` (x <| x2s))) +-- | goLast :: SeqZipper a -> SeqZipper a goLast orig@(SZ (x,(x1s,x2s))) = case viewr x2s of EmptyR -> orig zs :> z -> SZ (z,((x1s |> x) `mappend` zs , empty)) --+-- | current :: SeqZipper a -> a current (SZ (x,(_,_))) = x +-- | prev :: SeqZipper a -> Maybe a prev = fmap current . moveLeft +-- | next :: SeqZipper a -> Maybe a next = fmap current . moveRight +-- | replace :: a -> SeqZipper a -> SeqZipper a replace y (SZ (_x,zs)) = SZ (y,zs) -+-- | deleteCurrent :: SeqZipper a -> Maybe (SeqZipper a) deleteCurrent (SZ (_,(xs,ys))) = case viewl ys of @@ -120,36 +140,37 @@ zs :> z -> Just (SZ (z,(zs,ys))) z :< zs -> Just (SZ (z,(xs,zs))) -+-- | data ZipperSelect a = NoSelect { allelems :: [a] } | Select { zipper :: (Maybe :. SeqZipper) a } -+-- | deriving instance Functor ZipperSelect +-- | selectFirst :: ZipperSelect a -> ZipperSelect a selectFirst (NoSelect []) = NoSelect [] selectFirst (NoSelect lst@(_:_)) = Select . gFromList $ lst selectFirst (Select (O Nothing)) = NoSelect [] selectFirst (Select (O msz)) = Select . O $ return . goFirst =<< msz +-- | instance GListable (Maybe :. SeqZipper) where gFromList [] = O Nothing gFromList (x:xs) = O (Just (SZ (x, (empty,fromList xs)))) gToList (O Nothing) = [] gToList (O (Just (SZ (x,(xs,ys))))) = toList xs ++ (x : toList ys) +-- | instance GListable ZipperSelect where gFromList xs = NoSelect xs gToList (NoSelect xs) = xs gToList (Select xs) = gToList xs -+-- | deriving instance Foldable ZipperSelect +-- | deriving instance Traversable ZipperSelect ---- ---- data HeteroSeqZipper a b = HSZ { unHSZ :: (b, (Seq a, Seq a)) }
src/Data/Xournal/Simple.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, OverloadedStrings, TypeOperators, - TypeFamilies, FlexibleContexts #-}+ TypeFamilies, FlexibleContexts, RecordWildCards #-} ----------------------------------------------------------------------------- -- |@@ -15,16 +15,23 @@ module Data.Xournal.Simple where -import Control.Applicative +-- from other packages+import Control.Applicative +import Control.Lens import qualified Data.ByteString as S-import Data.ByteString.Char8 hiding (map)-import Data.Strict.Tuple-import Data.Xournal.Util-import Data.Label+import Data.ByteString.Char8 hiding (map)+-- import Data.Label+import qualified Data.Serialize as SE+import Data.Strict.Tuple+-- from this package+import Data.Xournal.Util+-- import Prelude hiding ((.),id,putStrLn,fst,snd,curry,uncurry) +-- | type Title = S.ByteString +-- | data Stroke = Stroke { stroke_tool :: !S.ByteString , stroke_color :: !S.ByteString , stroke_width :: !Double@@ -34,15 +41,36 @@ , stroke_color :: S.ByteString , stroke_vwdata :: [(Double,Double,Double)] }- deriving Show-+ deriving (Show,Eq,Ord) +-- | +instance SE.Serialize Stroke where+ put Stroke{..} = SE.putWord8 0 + >> SE.put stroke_tool + >> SE.put stroke_color+ >> SE.put stroke_width+ >> SE.put stroke_data+ put VWStroke{..} = SE.putWord8 1 + >> SE.put stroke_tool + >> SE.put stroke_color+ >> SE.put stroke_vwdata+ get = do tag <- SE.getWord8 + case tag of + 0 -> Stroke <$> SE.get <*> SE.get <*> SE.get <*> SE.get+ 1 -> VWStroke <$> SE.get <*> SE.get <*> SE.get+ _ -> fail "err in Stroke parsing"+-- | +instance (SE.Serialize a, SE.Serialize b) => SE.Serialize (Pair a b) where+ put (x :!: y) = SE.put x+ >> SE.put y+ get = (:!:) <$> SE.get <*> SE.get + +-- | data Dimension = Dim { dim_width :: !Double, dim_height :: !Double } deriving Show -- | - data Background = Background { bkg_type :: !S.ByteString , bkg_color :: !S.ByteString , bkg_style :: !S.ByteString @@ -55,93 +83,99 @@ deriving Show -- | - data Xournal = Xournal { xoj_title :: !Title, xoj_pages :: ![Page] } deriving Show -- | - data Page = Page { page_dim :: !Dimension , page_bkg :: !Background , page_layers :: ![Layer] } deriving Show -- | - data Layer = Layer { layer_strokes :: ![Stroke] } deriving Show -- | - getXYtuples :: Stroke -> [(Double,Double)] getXYtuples (Stroke _t _c _w d) = map (\(x :!: y) -> (x,y)) d getXYtuples (VWStroke _t _c d) = map ((,)<$>fst3<*>snd3) d --- | --s_tool :: Stroke :-> ByteString-s_tool = lens stroke_tool (\a f -> f { stroke_tool = a }) +----------------------------+-- Lenses+---------------------------- -- | --s_color :: Stroke :-> ByteString -s_color = lens stroke_color (\a f -> f { stroke_color = a } )---- s_width :: Stroke :-> Double --- s_width = lens stroke_width (\a f -> f { stroke_width = a } )---- s_data :: Stroke :-> [Pair Double Double] --- s_data = lens stroke_data (\a f -> f { stroke_data = a } )+s_tool :: Simple Lens Stroke ByteString+s_tool = lens stroke_tool (\f a -> f { stroke_tool = a }) -s_title :: Xournal :-> Title-s_title = lens xoj_title (\a f -> f { xoj_title = a } )+-- | +s_color :: Simple Lens Stroke ByteString +s_color = lens stroke_color (\f a -> f { stroke_color = a } ) -s_pages :: Xournal :-> [Page]-s_pages = lens xoj_pages (\a f -> f { xoj_pages = a } )+-- | +s_title :: Simple Lens Xournal Title+s_title = lens xoj_title (\f a -> f { xoj_title = a } ) -s_dim :: Page :-> Dimension -s_dim = lens page_dim (\a f -> f { page_dim = a } )+-- | +s_pages :: Simple Lens Xournal [Page]+s_pages = lens xoj_pages (\f a -> f { xoj_pages = a } ) -s_bkg :: Page :-> Background -s_bkg = lens page_bkg (\a f -> f { page_bkg = a } )+-- | +s_dim :: Simple Lens Page Dimension +s_dim = lens page_dim (\f a -> f { page_dim = a } ) -s_layers :: Page :-> [Layer] -s_layers = lens page_layers (\a f -> f { page_layers = a } )+-- | +s_bkg :: Simple Lens Page Background +s_bkg = lens page_bkg (\f a -> f { page_bkg = a } ) -s_strokes :: Layer :-> [Stroke]-s_strokes = lens layer_strokes (\a f -> f { layer_strokes = a } )+-- | +s_layers :: Simple Lens Page [Layer] +s_layers = lens page_layers (\f a -> f { page_layers = a } ) +-- | +s_strokes :: Simple Lens Layer [Stroke]+s_strokes = lens layer_strokes (\f a -> f { layer_strokes = a } ) +--------------------------+-- empty objects+-------------------------- +-- | emptyXournal :: Xournal emptyXournal = Xournal "" [] +-- | emptyLayer :: Layer emptyLayer = Layer { layer_strokes = [] } +-- | emptyStroke :: Stroke emptyStroke = Stroke "pen" "black" 1.4 [] -+-- | defaultBackground :: Background defaultBackground = Background { bkg_type = "solid" , bkg_color = "white" , bkg_style = "lined" } +-- | defaultLayer :: Layer defaultLayer = Layer { layer_strokes = [] } +-- | defaultPage :: Page defaultPage = Page { page_dim = Dim 612.0 792.0 , page_bkg = defaultBackground , page_layers = [ defaultLayer ] } +-- | defaultXournal :: Xournal defaultXournal = Xournal "untitled" [ defaultPage ] -+-- | newPageFromOld :: Page -> Page newPageFromOld page = Page { page_dim = page_dim page @@ -149,25 +183,3 @@ , page_layers = [emptyLayer] } --{--instance IStroke Stroke where- strokeTool = stroke_tool- strokeColor = stroke_color- strokeWidth = stroke_width- strokeData = stroke_data- -instance ILayer Layer where- type TStroke Layer = Stroke- layerStrokes = layer_strokes --instance IPage Page where- type TLayer Page = Layer - pageDim = page_dim - pageBkg = page_bkg - pageLayers = page_layers--instance IXournal Xournal where- type TPage Xournal = Page - xournalPages = xoj_pages --}
xournal-types.cabal view
@@ -1,5 +1,5 @@ Name: xournal-types-Version: 0.4+Version: 0.5 Synopsis: Data types for programs for xournal file format Description: Xournal file format data type including generic interface License: BSD3@@ -17,15 +17,16 @@ Library hs-source-dirs: src- ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans ghc-prof-options: -caf-all -auto-all Build-Depends: base == 4.*, bytestring == 0.9.*, strict == 0.3.*, containers == 0.4.*, - fclabels == 1.0.*, - TypeCompose == 0.9.*+ lens >= 2.4 && < 2.7,+ TypeCompose == 0.9.*, + cereal == 0.3.* Exposed-Modules: Data.Xournal.Generic Data.Xournal.Simple