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.1.1 +Version: 0.2 Synopsis: text builder for hoodle file format Description: This library builds text xoj format file from hoodle data structure License: BSD3 @@ -20,14 +20,17 @@ ghc-prof-options: -caf-all -auto-all Build-Depends: base == 4.*, - hoodle-types >= 0.1.1, + hoodle-types >= 0.2, lens >= 2.5, blaze-builder == 0.3.*, strict == 0.3.*, - bytestring >= 0.9 + bytestring >= 0.9, + double-conversion >= 0.2.0.6 Exposed-Modules: Text.Hoodle.Builder + Text.Hoodle.Builder.V0_1_1 + -- Text.Hoodle.Builder.V0_1_999 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 @@ -17,11 +17,11 @@ -- from other packages import Control.Lens import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as SC +-- import qualified Data.ByteString.Char8 as SC import qualified Data.ByteString.Lazy as L import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char8 (fromChar, fromString) --- import Data.Double.Conversion.ByteString +import Data.Double.Conversion.ByteString #if MIN_VERSION_base(4,5,0) import Data.Monoid hiding ((<>)) #else @@ -38,10 +38,12 @@ (<>) = mappend -- | -toFixed :: Int -> Double -> S.ByteString -toFixed 2 x = SC.pack . show . (*0.01) . fromIntegral . floor - $ x*100 +{- toFixed :: Int -> Double -> S.ByteString +toFixed 2 x = printf "%.2f" x + -- SC.pack . show . (*0.01) . fromIntegral . floor + -- $ x*100 toFixed _ _ = error "undefined toFixed" +-} -- | builder :: Hoodle -> L.ByteString @@ -49,8 +51,11 @@ -- | buildHoodle :: Hoodle -> Builder -buildHoodle hdl = fromByteString "\n\n" +buildHoodle hdl = fromByteString "\n fromByteString (view hoodleID hdl) + <> fromByteString "\">\n" <> (buildTitle . view title) hdl + <> (maybe mempty buildEmbeddedPdf . view embeddedPdf) hdl <> (mconcat . map buildPage . view pages) hdl <> fromByteString "\n" @@ -61,6 +66,12 @@ <> fromByteString "\n" -- | +buildEmbeddedPdf :: S.ByteString -> Builder +buildEmbeddedPdf pdf = fromByteString " fromByteString pdf + <> fromByteString "\"/>\n" + +-- | buildPage :: Page -> Builder buildPage pg = fromByteString " fromByteString (toFixed 2 w) @@ -98,6 +109,13 @@ <> fromByteString "\" pageno=\"" <> fromString (show pageno) <> fromByteString "\"/>\n" + BackgroundEmbedPdf typ pageno -> + fromByteString " fromByteString typ + <> fromByteString "\" pageno=\"" + <> fromString (show pageno) + <> fromByteString "\"/>\n" + -- | buildLayer :: Layer -> Builder @@ -109,7 +127,9 @@ 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 _ _ _ _) = @@ -163,7 +183,54 @@ <> fromByteString " fromByteString rdr <> fromByteString "]]>" - <> 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 diff --git a/src/Text/Hoodle/Builder/V0_1_1.hs b/src/Text/Hoodle/Builder/V0_1_1.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodle/Builder/V0_1_1.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE CPP, OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodle.Builder.V0_1_1 +-- Copyright : (c) 2011-2013 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Text.Hoodle.Builder.V0_1_1 where + +-- from other packages +import Control.Lens +import qualified Data.ByteString as S +-- import qualified Data.ByteString.Char8 as SC +import qualified Data.ByteString.Lazy as L +import Blaze.ByteString.Builder +import Blaze.ByteString.Builder.Char8 (fromChar, fromString) +import Data.Double.Conversion.ByteString +#if MIN_VERSION_base(4,5,0) +import Data.Monoid hiding ((<>)) +#else +import Data.Monoid +#endif +import Data.Strict.Tuple +-- from this package +import Data.Hoodle.Simple.V0_1_1 + +infixl 4 <> + +-- | +(<>) :: Monoid a => a -> a -> a +(<>) = mappend + +-- | +{- toFixed :: Int -> Double -> S.ByteString +toFixed 2 x = printf "%.2f" x + -- SC.pack . show . (*0.01) . fromIntegral . floor + -- $ x*100 +toFixed _ _ = error "undefined toFixed" +-} + +-- | +builder :: Hoodle -> L.ByteString +builder = toLazyByteString . buildHoodle + +-- | +buildHoodle :: Hoodle -> Builder +buildHoodle hdl = fromByteString "\n\n" + <> (buildTitle . view title) hdl + <> (mconcat . map buildPage . view pages) hdl + <> fromByteString "\n" + +-- | +buildTitle :: S.ByteString -> Builder +buildTitle ttl = fromByteString "" + <> fromByteString ttl + <> 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" + +-- | +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 + +-- | +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 "" + +-- | +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 ' '