diff --git a/hoodle-builder.cabal b/hoodle-builder.cabal --- a/hoodle-builder.cabal +++ b/hoodle-builder.cabal @@ -1,5 +1,5 @@ Name: hoodle-builder -Version: 0.2.2.0 +Version: 0.3 Synopsis: text builder for hoodle file format Description: This library builds text xoj format file from hoodle data structure License: BSD3 @@ -19,17 +19,20 @@ ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans ghc-prof-options: -caf-all -auto-all Build-Depends: + double-conversion >= 0.2.0.6, base == 4.*, - hoodle-types >= 0.2.2, - lens >= 2.5, blaze-builder >= 0.3, - strict >= 0.3, bytestring >= 0.9, - double-conversion >= 0.2.0.6 + hoodle-types >= 0.3, + lens >= 2.5, + strict >= 0.3, + text > 0.11 Exposed-Modules: Text.Hoodle.Builder Text.Hoodle.Builder.V0_1_1 + Text.Hoodle.Builder.V0_2_2 + Text.Hoodlet.Builder Other-Modules: diff --git a/src/Text/Hoodle/Builder.hs b/src/Text/Hoodle/Builder.hs --- a/src/Text/Hoodle/Builder.hs +++ b/src/Text/Hoodle/Builder.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Text.Hoodle.Builder --- Copyright : (c) 2011-2013 Ian-Woo Kim +-- Copyright : (c) 2011-2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -16,22 +16,24 @@ module Text.Hoodle.Builder where -- from other packages +import Blaze.ByteString.Builder +import Blaze.ByteString.Builder.Char8 (fromChar, fromString) import Control.Lens import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.Foldable (foldMap) -import Blaze.ByteString.Builder -import Blaze.ByteString.Builder.Char8 (fromChar, fromString) import Data.Double.Conversion.ByteString (toFixed) +import Data.Foldable (foldMap) #if MIN_VERSION_base(4,5,0) import Data.Monoid hiding ((<>)) #else import Data.Monoid #endif import Data.Strict.Tuple --- from this package +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +-- from hoodle platform import Data.Hoodle.Simple - +-- -- | (<>) :: Monoid a => a -> a -> a @@ -45,12 +47,13 @@ -- | buildHoodle :: Hoodle -> Builder -buildHoodle hdl = fromByteString "\n\n fromByteString (view hoodleID hdl) <> fromByteString "\">\n" <> (buildTitle . view title) hdl <> (mconcat . map buildRevision . view revisions) hdl <> (maybe mempty buildEmbeddedPdf . view embeddedPdf) hdl + <> (maybe mempty buildEmbeddedText . view embeddedText) hdl <> (mconcat . map buildPage . view pages) hdl <> fromByteString "\n" @@ -80,6 +83,13 @@ <> fromByteString "\"/>\n" -- | +buildEmbeddedText :: T.Text -> Builder +buildEmbeddedText txt = fromByteString " fromByteString (TE.encodeUtf8 txt) + <> fromByteString "]]>\n" + + +-- | buildPage :: Page -> Builder buildPage pg = fromByteString " fromByteString (toFixed 2 w) @@ -136,7 +146,7 @@ buildItem (ItemImage img) = buildImage img buildItem (ItemSVG svg) = buildSVG svg buildItem (ItemLink lnk) = buildLink lnk - +buildItem (ItemAnchor anc) = buildAnchor anc -- | buildStroke :: Stroke -> Builder @@ -238,8 +248,48 @@ <> fromByteString rdr <> fromByteString "]]>" <> fromByteString "\n" +buildLink (LinkAnchor i docid loc anchorid rdr (x,y) (Dim w h)) = + fromByteString " fromByteString i + <> fromByteString "\" type=\"anchor\" linkedid=\"" + <> fromByteString docid + <> fromByteString "\" location=\"" + <> fromByteString loc + <> fromByteString "\" anchorid=\"" + <> fromByteString anchorid + <> fromByteString "\" x=\"" + <> fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" >\n" + <> fromByteString " fromByteString rdr + <> fromByteString "]]>" + <> fromByteString "\n" +buildAnchor :: Anchor -> Builder +buildAnchor (Anchor i rdr (x,y) (Dim w h)) = + fromByteString " fromByteString i + <> fromByteString "\" x=\"" + <> fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" >\n" + <> fromByteString " fromByteString rdr + <> fromByteString "]]>" + <> fromByteString "\n" + -- | build2D :: Pair Double Double -> Builder build2D (x :!: y) = fromByteString (toFixed 2 x) diff --git a/src/Text/Hoodle/Builder/V0_2_2.hs b/src/Text/Hoodle/Builder/V0_2_2.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodle/Builder/V0_2_2.hs @@ -0,0 +1,260 @@ +{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodle.Builder.V0_2_2 +-- Copyright : (c) 2011-2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Text.Hoodle.Builder.V0_2_2 where + +-- from other packages +import Blaze.ByteString.Builder +import Blaze.ByteString.Builder.Char8 (fromChar, fromString) +import Control.Lens +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import Data.Double.Conversion.ByteString (toFixed) +import Data.Foldable (foldMap) +#if MIN_VERSION_base(4,5,0) +import Data.Monoid hiding ((<>)) +#else +import Data.Monoid +#endif +import Data.Strict.Tuple +-- from hoodle platform +import Data.Hoodle.Simple.V0_2_2 +-- + +-- | +(<>) :: Monoid a => a -> a -> a +(<>) = mappend + +infixl 4 <> + +-- | +builder :: Hoodle -> L.ByteString +builder = toLazyByteString . buildHoodle + +-- | +buildHoodle :: Hoodle -> Builder +buildHoodle hdl = fromByteString "\n fromByteString (view hoodleID hdl) + <> fromByteString "\">\n" + <> (buildTitle . view title) hdl + <> (mconcat . map buildRevision . view revisions) hdl + <> (maybe mempty buildEmbeddedPdf . view embeddedPdf) hdl + <> (mconcat . map buildPage . view pages) hdl + <> fromByteString "\n" + +-- | +buildTitle :: S.ByteString -> Builder +buildTitle ttl = fromByteString "" + <> fromByteString ttl + <> fromByteString "\n" + +-- | +buildRevision :: Revision -> Builder +buildRevision Revision {..} = fromByteString " fromByteString _revmd5 + <> fromByteString "\" revtxt=\"" + <> fromByteString _revtxt + <> fromByteString "\"/>\n" +buildRevision RevisionInk {..} = fromByteString " fromByteString _revmd5 + <> fromByteString "\" type=\"ink\">\n" + <> foldMap buildStroke _revink + <> fromByteString "\n" + +-- | +buildEmbeddedPdf :: S.ByteString -> Builder +buildEmbeddedPdf pdf = fromByteString " fromByteString pdf + <> fromByteString "\"/>\n" + +-- | +buildPage :: Page -> Builder +buildPage pg = fromByteString " fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\">\n" + <> (buildBackground . view background) pg + <> (mconcat . map buildLayer . view layers) pg + <> fromByteString "\n" + where Dim w h = view dimension pg + +-- | +buildBackground :: Background -> Builder +buildBackground bkg = + case bkg of + Background typ col sty -> + fromByteString " fromByteString typ + <> fromByteString "\" color=\"" + <> fromByteString col + <> fromByteString "\" style=\"" + <> fromByteString sty + <> fromByteString "\"/>\n" + BackgroundPdf typ mdom mfile pageno -> + fromByteString " fromByteString typ + <> case mdom of + Nothing -> fromByteString S.empty + Just dom -> fromByteString "\" domain=\"" + <> fromByteString dom + <> case mfile of + Nothing -> fromByteString S.empty + Just file -> fromByteString "\" filename=\"" + <> fromByteString file + <> fromByteString "\" pageno=\"" + <> fromString (show pageno) + <> fromByteString "\"/>\n" + BackgroundEmbedPdf typ pageno -> + fromByteString " fromByteString typ + <> fromByteString "\" pageno=\"" + <> fromString (show pageno) + <> fromByteString "\"/>\n" + + +-- | +buildLayer :: Layer -> Builder +buildLayer layer = fromByteString "\n" + <> (mconcat . map buildItem . view items) layer + <> fromByteString "\n" + +buildItem :: Item -> Builder +buildItem (ItemStroke strk) = buildStroke strk +buildItem (ItemImage img) = buildImage img +buildItem (ItemSVG svg) = buildSVG svg +buildItem (ItemLink lnk) = buildLink lnk + + +-- | +buildStroke :: Stroke -> Builder +buildStroke stroke@(Stroke _ _ _ _) = + fromByteString " fromByteString (stroke_tool stroke) + <> fromByteString "\" color=\"" + <> fromByteString (stroke_color stroke) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 (stroke_width stroke)) + <> fromByteString "\">\n" + <> mconcat (map build2D (stroke_data stroke)) + <> fromByteString "\n\n" +buildStroke stroke@(VWStroke _ _ _) = + fromByteString " fromByteString (stroke_tool stroke) + <> fromByteString "\" color=\"" + <> fromByteString (stroke_color stroke) + <> fromByteString "\" width=\"" + <> mconcat (map buildZFrm3D (stroke_vwdata stroke)) + <> fromByteString "\">\n" + <> mconcat (map buildXYFrm3D (stroke_vwdata stroke)) + <> fromByteString "\n\n" + +buildImage :: Image -> Builder +buildImage (Image bstr (x,y) (Dim w h)) = + fromByteString " fromByteString bstr + <> fromByteString "\" x=\"" + <> fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" />\n" + +buildSVG :: SVG -> Builder +buildSVG (SVG mtxt mcmd rdr (x,y) (Dim w h)) = + fromByteString " fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" >\n" + <> maybe mempty (\txt->fromByteString " fromByteString txt <> fromByteString "]]>") mtxt + <> maybe mempty (\cmd->fromByteString " fromByteString cmd <> fromByteString "]]>") mcmd + <> fromByteString " fromByteString rdr + <> fromByteString "]]>" + <> fromByteString "\n" + +buildLink :: Link -> Builder +buildLink (Link i typ loc mtxt mcmd rdr (x,y) (Dim w h)) = + fromByteString " fromByteString i + <> fromByteString "\" type=\"" + <> fromByteString typ + <> fromByteString "\" location=\"" + <> fromByteString loc + <> fromByteString "\" x=\"" + <> fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" >\n" + <> maybe mempty (\txt->fromByteString " fromByteString txt <> fromByteString "]]>") mtxt + <> maybe mempty (\cmd->fromByteString " fromByteString cmd <> fromByteString "]]>") mcmd + <> fromByteString " fromByteString rdr + <> fromByteString "]]>" + <> fromByteString "\n" +buildLink (LinkDocID i docid loc mtxt mcmd rdr (x,y) (Dim w h)) = + fromByteString " fromByteString i + <> fromByteString "\" type=\"linkdocid\" linkedid=\"" + <> fromByteString docid + <> fromByteString "\" location=\"" + <> fromByteString loc + <> fromByteString "\" x=\"" + <> fromByteString (toFixed 2 x) + <> fromByteString "\" y=\"" + <> fromByteString (toFixed 2 y) + <> fromByteString "\" width=\"" + <> fromByteString (toFixed 2 w) + <> fromByteString "\" height=\"" + <> fromByteString (toFixed 2 h) + <> fromByteString "\" >\n" + <> maybe mempty (\txt->fromByteString " fromByteString txt <> fromByteString "]]>") mtxt + <> maybe mempty (\cmd->fromByteString " fromByteString cmd <> fromByteString "]]>") mcmd + <> fromByteString " fromByteString rdr + <> fromByteString "]]>" + <> fromByteString "\n" + + +-- | +build2D :: Pair Double Double -> Builder +build2D (x :!: y) = fromByteString (toFixed 2 x) + <> fromChar ' ' + <> fromByteString (toFixed 2 y) + <> fromChar ' ' + +-- | +buildXYFrm3D :: (Double,Double,Double) -> Builder +buildXYFrm3D (x,y,_) = fromByteString (toFixed 2 x) + <> fromChar ' ' + <> fromByteString (toFixed 2 y) + <> fromChar ' ' + +-- | +buildZFrm3D :: (Double,Double,Double) -> Builder +buildZFrm3D (_,_,z) = fromByteString (toFixed 2 z) + <> fromChar ' ' diff --git a/src/Text/Hoodlet/Builder.hs b/src/Text/Hoodlet/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodlet/Builder.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodlet.Builder +-- Copyright : (c) 2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Text.Hoodlet.Builder where + +import Blaze.ByteString.Builder +import qualified Data.ByteString.Lazy.Char8 as L +-- +import Data.Hoodle.Simple +-- +import Text.Hoodle.Builder +-- +-- | +builder :: Item -> L.ByteString +builder = toLazyByteString . buildHoodlet + + +buildHoodlet :: Item -> Builder +buildHoodlet item = fromByteString "\n\n" + <> buildItem item + <> fromByteString "\n" +