diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,9 +0,0 @@ -0.1: 18 Dec 2011 - * First public release -0.2: 25 Dec 2011 - * double buffer support -0.3: 15 Jan 2012 - * ZipperSelect support -0.4: 12 Feb 2012 - * Variable width stroke support - diff --git a/hoodle-types.cabal b/hoodle-types.cabal --- a/hoodle-types.cabal +++ b/hoodle-types.cabal @@ -1,5 +1,5 @@ Name: hoodle-types -Version: 0.3 +Version: 0.3.0 Synopsis: Data types for programs for hoodle file format Description: Hoodle file format data type including generic interface License: BSD3 @@ -9,7 +9,7 @@ Category: Data Build-Type: Simple Cabal-Version: >= 1.8 -data-files: CHANGES +data-files: Source-repository head type: git location: https://www.github.com/wavewave/hoodle-types @@ -32,13 +32,14 @@ Exposed-Modules: Data.Hoodle.BBox Data.Hoodle.Generic - Data.Hoodle.Generic.Simple + Data.Hoodle.Hashed Data.Hoodle.Predefined Data.Hoodle.Primitive Data.Hoodle.Select Data.Hoodle.Simple Data.Hoodle.Simple.V0_1_1 Data.Hoodle.Simple.V0_2_2 + Data.Hoodle.Simple.V0_3 Data.Hoodle.Util Data.Hoodle.Zipper diff --git a/src/Data/Hoodle/Generic.hs b/src/Data/Hoodle/Generic.hs --- a/src/Data/Hoodle/Generic.hs +++ b/src/Data/Hoodle/Generic.hs @@ -32,12 +32,16 @@ -- import Prelude hiding ((.),id) +data PDFData = PDFData { pdfBase64 :: ByteString + , pdfNumPages :: Int } + + -- | Generic Hoodle data having generic pages data GHoodle cntnr pg = GHoodle { ghoodle_id :: ByteString , ghoodle_ttl :: ByteString , ghoodle_revisions :: [Revision] - , ghoodle_embeddedpdf :: Maybe ByteString + , ghoodle_embeddedpdf :: Maybe PDFData , ghoodle_embeddedtext :: Maybe T.Text , ghoodle_pgs :: cntnr pg } @@ -83,7 +87,7 @@ grevisions = lens ghoodle_revisions (\f a -> f { ghoodle_revisions = a } ) -- | -gembeddedpdf :: Simple Lens (GHoodle cntnr pg) (Maybe ByteString) +gembeddedpdf :: Simple Lens (GHoodle cntnr pg) (Maybe PDFData) gembeddedpdf = lens ghoodle_embeddedpdf (\f a -> f { ghoodle_embeddedpdf = a } ) -- | diff --git a/src/Data/Hoodle/Generic/Simple.hs b/src/Data/Hoodle/Generic/Simple.hs deleted file mode 100644 --- a/src/Data/Hoodle/Generic/Simple.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE TypeFamilies, TypeOperators, MultiParamTypeClasses #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Hoodle.Generic.Simple --- Copyright : (c) 2011, 2012, 2014 Ian-Woo Kim --- --- License : BSD3 --- Maintainer : Ian-Woo Kim --- Stability : experimental --- Portability : GHC --- --- Simple Hoodle Type in Generic parameterized type --- ------------------------------------------------------------------------------ - -module Data.Hoodle.Generic.Simple where - -import Control.Applicative -import Control.Lens --- from this package -import Data.Hoodle.Generic -import Data.Hoodle.Simple - --- | -type SLayer = GLayer () [] Item -- Strokes - --- | -type SPage = GPage Background [] SLayer - --- | -type SHoodle = GHoodle [] SPage - --- | smart constructor for SLayer -mkSLayer :: Layer -> SLayer -mkSLayer = GLayer () <$> view items -- strokes - --- | smart constructor for SPage -mkSPage :: Page -> SPage -mkSPage = GPage - <$> view dimension - <*> view background - <*> map mkSLayer . view layers - --- | smart constructor for SHoodle -mkSHoodle :: Hoodle -> SHoodle -mkSHoodle = GHoodle - <$> view hoodleID - <*> view title - <*> view revisions - <*> view embeddedPdf - <*> view embeddedText - <*> map mkSPage . view pages - --- | -slayer2Layer :: SLayer -> Layer -slayer2Layer (GLayer _ itms) = Layer itms - --- | -spage2Page :: SPage -> Page -spage2Page (GPage dim bkg lyrs) = Page dim bkg (map slayer2Layer lyrs) - --- | -shoodle2Hoodle :: SHoodle -> Hoodle -shoodle2Hoodle (GHoodle hid ttl revs pdf txt pgs) = Hoodle hid ttl revs pdf txt (map spage2Page pgs) - diff --git a/src/Data/Hoodle/Hashed.hs b/src/Data/Hoodle/Hashed.hs new file mode 100644 --- /dev/null +++ b/src/Data/Hoodle/Hashed.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Hoodle.Hashed +-- Copyright : (c) 2011-2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Data.Hoodle.Hashed where + +-- from other packages +import Control.Applicative +import Control.Lens +import Data.ByteString.Char8 hiding (map) +import Data.UUID.V4 +import qualified Data.Serialize as SE +import Data.Strict.Tuple +import qualified Data.Text as T +-- from this package +import Data.Hoodle.Util +-- +import Prelude hiding (putStrLn,fst,snd,curry,uncurry) + +-- | +type Title = ByteString + +-- | wrapper of object embeddable in Layer +data Item = ItemStroke Stroke + | ItemImage Image + | ItemSVG SVG + | ItemLink Link + | ItemAnchor Anchor + deriving (Show,Eq,Ord) + + +-- | Pen stroke item +data Stroke = Stroke { stroke_tool :: !ByteString + , stroke_color :: !ByteString + , stroke_width :: !Double + , stroke_data :: ![Pair Double Double] + } + | VWStroke { stroke_tool :: ByteString + , stroke_color :: ByteString + , stroke_vwdata :: [(Double,Double,Double)] + } + deriving (Show,Eq,Ord) + +-- | Image item +data Image = Image { img_src :: ByteString + , img_pos :: (Double,Double) + , img_dim :: !Dimension + } + deriving (Show,Eq,Ord) + +data SVG = SVG { svg_text :: Maybe ByteString + , svg_command :: Maybe ByteString + , svg_render :: ByteString + , svg_pos :: (Double,Double) + , svg_dim :: !Dimension } + deriving (Show,Eq,Ord) + + +data Link = Link { link_id :: ByteString + , link_type :: ByteString + , link_location :: ByteString + , link_text :: Maybe ByteString + , link_command :: Maybe ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension } + | LinkDocID { link_id :: ByteString + , link_linkeddocid :: ByteString + , link_location :: ByteString + , link_text :: Maybe ByteString + , link_command :: Maybe ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension } + | LinkAnchor { link_id :: ByteString + , link_linkeddocid :: ByteString + , link_location :: ByteString + , link_anchorid :: ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension + } + + deriving (Show,Eq,Ord) + +data Anchor = Anchor { anchor_id :: ByteString + , anchor_render :: ByteString + , anchor_pos :: (Double, Double) + , anchor_dim :: !Dimension + } + 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 Image where + put Image {..} = SE.put img_src + >> SE.put img_pos + >> SE.put img_dim + get = Image <$> SE.get <*> SE.get <*> SE.get + +-- | +instance SE.Serialize SVG where + put SVG {..} = SE.put svg_text + >> SE.put svg_command + >> SE.put svg_render + >> SE.put svg_pos + >> SE.put svg_dim + get = SVG <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get + + + +-- | +instance SE.Serialize Link where + put Link {..} = SE.putWord8 0 + >> SE.put link_id + >> SE.put link_type + >> SE.put link_location + >> SE.put link_text + >> SE.put link_command + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + put LinkDocID {..} = SE.putWord8 1 + >> SE.put link_id + >> SE.put link_linkeddocid + >> SE.put link_location + >> SE.put link_text + >> SE.put link_command + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + put LinkAnchor {..} = SE.putWord8 2 + >> SE.put link_id + >> SE.put link_linkeddocid + >> SE.put link_location + >> SE.put link_anchorid + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + get = do tag <- SE.getWord8 + case tag of + 0 -> Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get + 1 -> LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get + 2 -> LinkAnchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get + _ -> fail "err in Link parsing" + + + +instance SE.Serialize Anchor where + put Anchor {..} = SE.put anchor_id + >> SE.put anchor_render + >> SE.put anchor_pos + >> SE.put anchor_dim + get = Anchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get + + +-- | +instance SE.Serialize Item where + put (ItemStroke str) = SE.putWord8 0 + >> SE.put str + put (ItemImage img) = SE.putWord8 1 + >> SE.put img + put (ItemSVG svg) = SE.putWord8 2 + >> SE.put svg + put (ItemLink lnk) = SE.putWord8 3 + >> SE.put lnk + put (ItemAnchor anc) = SE.putWord8 4 + >> SE.put anc + get = do tag <- SE.getWord8 + case tag of + 0 -> ItemStroke <$> SE.get + 1 -> ItemImage <$> SE.get + 2 -> ItemSVG <$> SE.get + 3 -> ItemLink <$> SE.get + 4 -> ItemAnchor <$> SE.get + _ -> fail "err in Item 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,Eq,Ord) + +-- | +instance SE.Serialize Dimension where + put (Dim w h) = SE.put w >> SE.put h + get = Dim <$> SE.get <*> SE.get + +-- | +data Background = Background { bkg_type :: !ByteString + , bkg_color :: !ByteString + , bkg_style :: !ByteString + } + | BackgroundPdf { bkg_type :: ByteString + , bkg_domain :: Maybe ByteString + , bkg_filename :: Maybe ByteString + , bkg_pageno :: Int + } + | BackgroundEmbedPdf { bkg_type :: ByteString + , bkg_pageno :: Int } + deriving Show +-- | +data Revision = Revision { _revmd5 :: !ByteString + , _revtxt :: !ByteString + } + | RevisionInk { _revmd5 :: !ByteString + , _revink :: [Stroke] } + deriving Show + +-- | +data Hoodle = Hoodle { hoodle_id :: ByteString + , hoodle_title :: !Title + , hoodle_revisions :: [Revision] + , hoodle_embeddedpdf :: Maybe ByteString + , hoodle_embeddedtext :: Maybe T.Text + , hoodle_pages :: ![Page] } + deriving Show + +-- | +data Page = Page { page_dim :: !Dimension + , page_bkg :: !Background + , page_layers :: ![Layer] } + deriving Show + +-- | +data Layer = Layer { layer_items :: ![Item] } + 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 + + +---------------------------- +-- Lenses +---------------------------- + +-- | +tool :: Simple Lens Stroke ByteString +tool = lens stroke_tool (\f a -> f { stroke_tool = a }) + +-- | +color :: Simple Lens Stroke ByteString +color = lens stroke_color (\f a -> f { stroke_color = a } ) + +-- | +hoodleID :: Simple Lens Hoodle ByteString +hoodleID = lens hoodle_id (\f a -> f { hoodle_id = a } ) + +-- | +title :: Simple Lens Hoodle Title +title = lens hoodle_title (\f a -> f { hoodle_title = a } ) + +-- | +revisions :: Simple Lens Hoodle [Revision] +revisions = lens hoodle_revisions (\f a -> f { hoodle_revisions = a } ) + +-- | +revmd5 :: Simple Lens Revision ByteString +revmd5 = lens _revmd5 (\f a -> f { _revmd5 = a } ) + +-- | +embeddedPdf :: Simple Lens Hoodle (Maybe ByteString) +embeddedPdf = lens hoodle_embeddedpdf (\f a -> f { hoodle_embeddedpdf = a} ) + +-- | +embeddedText :: Simple Lens Hoodle (Maybe T.Text) +embeddedText = lens hoodle_embeddedtext (\f a -> f { hoodle_embeddedtext = a} ) + +-- | +pages :: Simple Lens Hoodle [Page] +pages = lens hoodle_pages (\f a -> f { hoodle_pages = a } ) + + +-- | +dimension :: Simple Lens Page Dimension +dimension = lens page_dim (\f a -> f { page_dim = a } ) + +-- | +background :: Simple Lens Page Background +background = lens page_bkg (\f a -> f { page_bkg = a } ) + +-- | +layers :: Simple Lens Page [Layer] +layers = lens page_layers (\f a -> f { page_layers = a } ) + +-- | +items :: Simple Lens Layer [Item] +items = lens layer_items (\f a -> f { layer_items = a } ) + + +-------------------------- +-- empty objects +-------------------------- + +-- | +emptyHoodle :: IO Hoodle +emptyHoodle = do + uuid <- nextRandom + return $ Hoodle ((pack.show) uuid) "" [] Nothing Nothing [] + +-- | +emptyLayer :: Layer +emptyLayer = Layer { layer_items = [] } + +-- | +emptyStroke :: Stroke +emptyStroke = Stroke "pen" "black" 1.4 [] + +-- | +defaultBackground :: Background +defaultBackground = Background { bkg_type = "solid" + , bkg_color = "white" + , bkg_style = "lined" + } + +-- | +defaultPage :: Page +defaultPage = Page { page_dim = Dim 612.0 792.0 + , page_bkg = defaultBackground + , page_layers = [ emptyLayer ] + } + +-- | +defaultHoodle :: IO Hoodle +defaultHoodle = + (set title "untitled".set embeddedPdf Nothing . set pages [defaultPage]) + <$> emptyHoodle + +-- | +newPageFromOld :: Page -> Page +newPageFromOld page = + Page { page_dim = page_dim page + , page_bkg = page_bkg page + , page_layers = [emptyLayer] } + + diff --git a/src/Data/Hoodle/Select.hs b/src/Data/Hoodle/Select.hs --- a/src/Data/Hoodle/Select.hs +++ b/src/Data/Hoodle/Select.hs @@ -27,7 +27,7 @@ data GSelect a b = GSelect { gselect_id :: ByteString , gselect_ttl :: ByteString , gselect_revisions :: [Revision] - , gselect_embeddedpdf :: Maybe ByteString + , gselect_embeddedpdf :: Maybe PDFData -- Maybe ByteString , gselect_embeddedtext :: Maybe T.Text , gselect_all :: a , gselect_selected :: b @@ -45,7 +45,7 @@ gselRevisions = lens gselect_revisions (\f a -> f {gselect_revisions = a } ) -- | -gselEmbeddedPdf :: Simple Lens (GSelect a b) (Maybe ByteString) +gselEmbeddedPdf :: Simple Lens (GSelect a b) (Maybe PDFData) gselEmbeddedPdf = lens gselect_embeddedpdf (\f a -> f {gselect_embeddedpdf = a}) -- | diff --git a/src/Data/Hoodle/Simple.hs b/src/Data/Hoodle/Simple.hs --- a/src/Data/Hoodle/Simple.hs +++ b/src/Data/Hoodle/Simple.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Simple --- Copyright : (c) 2011-2014 Ian-Woo Kim +-- Copyright : (c) 2011-2015 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim diff --git a/src/Data/Hoodle/Simple/V0_3.hs b/src/Data/Hoodle/Simple/V0_3.hs new file mode 100644 --- /dev/null +++ b/src/Data/Hoodle/Simple/V0_3.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Hoodle.Simple.V0_3 +-- Copyright : (c) 2011-2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Data.Hoodle.Simple.V0_3 where + +-- from other packages +import Control.Applicative +import Control.Lens +import Data.ByteString.Char8 hiding (map) +import Data.UUID.V4 +import qualified Data.Serialize as SE +import Data.Strict.Tuple +import qualified Data.Text as T +-- from this package +import Data.Hoodle.Util +-- +import Prelude hiding (putStrLn,fst,snd,curry,uncurry) + +-- | +type Title = ByteString + +-- | wrapper of object embeddable in Layer +data Item = ItemStroke Stroke + | ItemImage Image + | ItemSVG SVG + | ItemLink Link + | ItemAnchor Anchor + deriving (Show,Eq,Ord) + + +-- | Pen stroke item +data Stroke = Stroke { stroke_tool :: !ByteString + , stroke_color :: !ByteString + , stroke_width :: !Double + , stroke_data :: ![Pair Double Double] + } + | VWStroke { stroke_tool :: ByteString + , stroke_color :: ByteString + , stroke_vwdata :: [(Double,Double,Double)] + } + deriving (Show,Eq,Ord) + +-- | Image item +data Image = Image { img_src :: ByteString + , img_pos :: (Double,Double) + , img_dim :: !Dimension + } + deriving (Show,Eq,Ord) + +data SVG = SVG { svg_text :: Maybe ByteString + , svg_command :: Maybe ByteString + , svg_render :: ByteString + , svg_pos :: (Double,Double) + , svg_dim :: !Dimension } + deriving (Show,Eq,Ord) + + +data Link = Link { link_id :: ByteString + , link_type :: ByteString + , link_location :: ByteString + , link_text :: Maybe ByteString + , link_command :: Maybe ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension } + | LinkDocID { link_id :: ByteString + , link_linkeddocid :: ByteString + , link_location :: ByteString + , link_text :: Maybe ByteString + , link_command :: Maybe ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension } + | LinkAnchor { link_id :: ByteString + , link_linkeddocid :: ByteString + , link_location :: ByteString + , link_anchorid :: ByteString + , link_render :: ByteString + , link_pos :: (Double,Double) + , link_dim :: !Dimension + } + + deriving (Show,Eq,Ord) + +data Anchor = Anchor { anchor_id :: ByteString + , anchor_render :: ByteString + , anchor_pos :: (Double, Double) + , anchor_dim :: !Dimension + } + 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 Image where + put Image {..} = SE.put img_src + >> SE.put img_pos + >> SE.put img_dim + get = Image <$> SE.get <*> SE.get <*> SE.get + +-- | +instance SE.Serialize SVG where + put SVG {..} = SE.put svg_text + >> SE.put svg_command + >> SE.put svg_render + >> SE.put svg_pos + >> SE.put svg_dim + get = SVG <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get + + + +-- | +instance SE.Serialize Link where + put Link {..} = SE.putWord8 0 + >> SE.put link_id + >> SE.put link_type + >> SE.put link_location + >> SE.put link_text + >> SE.put link_command + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + put LinkDocID {..} = SE.putWord8 1 + >> SE.put link_id + >> SE.put link_linkeddocid + >> SE.put link_location + >> SE.put link_text + >> SE.put link_command + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + put LinkAnchor {..} = SE.putWord8 2 + >> SE.put link_id + >> SE.put link_linkeddocid + >> SE.put link_location + >> SE.put link_anchorid + >> SE.put link_render + >> SE.put link_pos + >> SE.put link_dim + get = do tag <- SE.getWord8 + case tag of + 0 -> Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get + 1 -> LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get + 2 -> LinkAnchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get + _ -> fail "err in Link parsing" + + + +instance SE.Serialize Anchor where + put Anchor {..} = SE.put anchor_id + >> SE.put anchor_render + >> SE.put anchor_pos + >> SE.put anchor_dim + get = Anchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get + + +-- | +instance SE.Serialize Item where + put (ItemStroke str) = SE.putWord8 0 + >> SE.put str + put (ItemImage img) = SE.putWord8 1 + >> SE.put img + put (ItemSVG svg) = SE.putWord8 2 + >> SE.put svg + put (ItemLink lnk) = SE.putWord8 3 + >> SE.put lnk + put (ItemAnchor anc) = SE.putWord8 4 + >> SE.put anc + get = do tag <- SE.getWord8 + case tag of + 0 -> ItemStroke <$> SE.get + 1 -> ItemImage <$> SE.get + 2 -> ItemSVG <$> SE.get + 3 -> ItemLink <$> SE.get + 4 -> ItemAnchor <$> SE.get + _ -> fail "err in Item 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,Eq,Ord) + +-- | +instance SE.Serialize Dimension where + put (Dim w h) = SE.put w >> SE.put h + get = Dim <$> SE.get <*> SE.get + +-- | +data Background = Background { bkg_type :: !ByteString + , bkg_color :: !ByteString + , bkg_style :: !ByteString + } + | BackgroundPdf { bkg_type :: ByteString + , bkg_domain :: Maybe ByteString + , bkg_filename :: Maybe ByteString + , bkg_pageno :: Int + } + | BackgroundEmbedPdf { bkg_type :: ByteString + , bkg_pageno :: Int } + deriving Show +-- | +data Revision = Revision { _revmd5 :: !ByteString + , _revtxt :: !ByteString + } + | RevisionInk { _revmd5 :: !ByteString + , _revink :: [Stroke] } + deriving Show + +-- | +data Hoodle = Hoodle { hoodle_id :: ByteString + , hoodle_title :: !Title + , hoodle_revisions :: [Revision] + , hoodle_embeddedpdf :: Maybe ByteString + , hoodle_embeddedtext :: Maybe T.Text + , hoodle_pages :: ![Page] } + deriving Show + +-- | +data Page = Page { page_dim :: !Dimension + , page_bkg :: !Background + , page_layers :: ![Layer] } + deriving Show + +-- | +data Layer = Layer { layer_items :: ![Item] } + 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 + + +---------------------------- +-- Lenses +---------------------------- + +-- | +tool :: Simple Lens Stroke ByteString +tool = lens stroke_tool (\f a -> f { stroke_tool = a }) + +-- | +color :: Simple Lens Stroke ByteString +color = lens stroke_color (\f a -> f { stroke_color = a } ) + +-- | +hoodleID :: Simple Lens Hoodle ByteString +hoodleID = lens hoodle_id (\f a -> f { hoodle_id = a } ) + +-- | +title :: Simple Lens Hoodle Title +title = lens hoodle_title (\f a -> f { hoodle_title = a } ) + +-- | +revisions :: Simple Lens Hoodle [Revision] +revisions = lens hoodle_revisions (\f a -> f { hoodle_revisions = a } ) + +-- | +revmd5 :: Simple Lens Revision ByteString +revmd5 = lens _revmd5 (\f a -> f { _revmd5 = a } ) + +-- | +embeddedPdf :: Simple Lens Hoodle (Maybe ByteString) +embeddedPdf = lens hoodle_embeddedpdf (\f a -> f { hoodle_embeddedpdf = a} ) + +-- | +embeddedText :: Simple Lens Hoodle (Maybe T.Text) +embeddedText = lens hoodle_embeddedtext (\f a -> f { hoodle_embeddedtext = a} ) + +-- | +pages :: Simple Lens Hoodle [Page] +pages = lens hoodle_pages (\f a -> f { hoodle_pages = a } ) + + +-- | +dimension :: Simple Lens Page Dimension +dimension = lens page_dim (\f a -> f { page_dim = a } ) + +-- | +background :: Simple Lens Page Background +background = lens page_bkg (\f a -> f { page_bkg = a } ) + +-- | +layers :: Simple Lens Page [Layer] +layers = lens page_layers (\f a -> f { page_layers = a } ) + +-- | +items :: Simple Lens Layer [Item] +items = lens layer_items (\f a -> f { layer_items = a } ) + + +-------------------------- +-- empty objects +-------------------------- + +-- | +emptyHoodle :: IO Hoodle +emptyHoodle = do + uuid <- nextRandom + return $ Hoodle ((pack.show) uuid) "" [] Nothing Nothing [] + +-- | +emptyLayer :: Layer +emptyLayer = Layer { layer_items = [] } + +-- | +emptyStroke :: Stroke +emptyStroke = Stroke "pen" "black" 1.4 [] + +-- | +defaultBackground :: Background +defaultBackground = Background { bkg_type = "solid" + , bkg_color = "white" + , bkg_style = "lined" + } + +-- | +defaultPage :: Page +defaultPage = Page { page_dim = Dim 612.0 792.0 + , page_bkg = defaultBackground + , page_layers = [ emptyLayer ] + } + +-- | +defaultHoodle :: IO Hoodle +defaultHoodle = + (set title "untitled".set embeddedPdf Nothing . set pages [defaultPage]) + <$> emptyHoodle + +-- | +newPageFromOld :: Page -> Page +newPageFromOld page = + Page { page_dim = page_dim page + , page_bkg = page_bkg page + , page_layers = [emptyLayer] } + + diff --git a/src/Data/Hoodle/Zipper.hs b/src/Data/Hoodle/Zipper.hs --- a/src/Data/Hoodle/Zipper.hs +++ b/src/Data/Hoodle/Zipper.hs @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Zipper --- Copyright : (c) 2011-2013 Ian-Woo Kim +-- Copyright : (c) 2011-2013,2015 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -39,7 +39,11 @@ deriving instance Functor SeqZipper -- | -deriving instance Foldable SeqZipper +-- deriving instance Foldable SeqZipper + +instance Foldable SeqZipper where + foldr f acc (SZ (x,(y1s,y2s))) = Data.Foldable.foldr f acc (y1s <> singleton x <> y2s) + -- | instance Applicative SeqZipper where