diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,6 @@ +0.1: 18 Dec 2011 + * First public release. +0.1.1: 12 Feb 2012 + * variable width stroke support +0.1.1.1: 3 Sep 2012 + * fix duplicated (<>) problem with Data.Monoid in base>4.5 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2011, Ian-Woo Kim. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO +EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,10 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> import Distribution.PackageDescription +> --import System.Process +> main = defaultMain +> --main = defaultMainWithHooks testUserHooks +> --testUserHooks = simpleUserHooks { +> -- preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo +> -- } diff --git a/hoodle-builder.cabal b/hoodle-builder.cabal new file mode 100644 --- /dev/null +++ b/hoodle-builder.cabal @@ -0,0 +1,35 @@ +Name: hoodle-builder +Version: 0.1 +Synopsis: text builder for hoodle file format +Description: This library builds text xoj format file from hoodle data structure +License: BSD3 +License-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Category: Text +Build-Type: Simple +Cabal-Version: >= 1.8 +data-files: CHANGES +Source-repository head + type: git + location: http://www.github.com/wavewave/hoodle-builder + +Library + hs-source-dirs: src + 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.*, + hoodle-types >= 0.0.999 && < 0.2, + lens >= 2.4 && < 2.7, + blaze-builder == 0.3.*, + strict == 0.3.*, + -- double-conversion == 0.2.*, + bytestring == 0.9.* + + Exposed-Modules: + Text.Hoodle.Builder + Other-Modules: + + + diff --git a/src/Text/Hoodle/Builder.hs b/src/Text/Hoodle/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodle/Builder.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE CPP, OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodle.Builder +-- Copyright : (c) 2011, 2012 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +----------------------------------------------------------------------------- + +module Text.Hoodle.Builder 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 + +infixl 4 <> + +-- | +(<>) :: Monoid a => a -> a -> a +(<>) = mappend + +-- | +toFixed :: Int -> Double -> S.ByteString +toFixed 2 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 + +-- | +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" + + + +-- | +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 ' '