hoodle-builder (empty) → 0.1
raw patch · 5 files changed
+244/−0 lines, 5 filesdep +basedep +blaze-builderdep +bytestringsetup-changed
Dependencies added: base, blaze-builder, bytestring, hoodle-types, lens, strict
Files
- CHANGES +6/−0
- LICENSE +25/−0
- Setup.lhs +10/−0
- hoodle-builder.cabal +35/−0
- src/Text/Hoodle/Builder.hs +168/−0
+ CHANGES view
@@ -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
+ LICENSE view
@@ -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.
+ Setup.lhs view
@@ -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+> -- }
+ hoodle-builder.cabal view
@@ -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 <ianwookim@gmail.com>+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: ++ +
+ src/Text/Hoodle/Builder.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module : Text.Hoodle.Builder +-- Copyright : (c) 2011, 2012 Ian-Woo Kim+--+-- License : BSD3+-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>+-- 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 "<?xml version=\"1.0\" standalone=\"no\"?>\n<hoodle version=\"0.1\">\n"+ <> (buildTitle . view title) hdl + <> (mconcat . map buildPage . view pages) hdl+ <> fromByteString "</hoodle>\n"+ +-- | +buildTitle :: S.ByteString -> Builder+buildTitle ttl = fromByteString "<title>"+ <> fromByteString ttl+ <> fromByteString "</title>\n"++-- | +buildPage :: Page -> Builder +buildPage pg = fromByteString "<page width=\""+ <> fromByteString (toFixed 2 w)+ <> fromByteString "\" height=\""+ <> fromByteString (toFixed 2 h)+ <> fromByteString "\">\n" + <> (buildBackground . view background) pg + <> (mconcat . map buildLayer . view layers) pg + <> fromByteString "</page>\n"+ where Dim w h = view dimension pg+ +-- | +buildBackground :: Background -> Builder +buildBackground bkg = + case bkg of + Background typ col sty -> + fromByteString "<background type=\""+ <> fromByteString typ+ <> fromByteString "\" color=\""+ <> fromByteString col+ <> fromByteString "\" style=\""+ <> fromByteString sty+ <> fromByteString "\"/>\n"+ BackgroundPdf typ mdom mfile pageno -> + fromByteString "<background type=\""+ <> 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 "<layer>\n"+ <> (mconcat . map buildItem . view items) layer+ <> fromByteString "</layer>\n"++buildItem :: Item -> Builder+buildItem (ItemStroke strk) = buildStroke strk+buildItem (ItemImage img) = buildImage img++-- | +buildStroke :: Stroke -> Builder+buildStroke stroke@(Stroke _ _ _ _) = + fromByteString "<stroke tool=\""+ <> 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</stroke>\n"+buildStroke stroke@(VWStroke _ _ _) =+ fromByteString "<stroke tool=\""+ <> 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</stroke>\n"++buildImage :: Image -> Builder +buildImage (Image bstr (x,y) (Dim w h)) =+ fromByteString "<img src=\""+ <> 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 ' '