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-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/src/Text/Xournal/Parse.hs b/src/Text/Xournal/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Text/Xournal/Parse.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Text.Xournal.Parse where + +import Control.Applicative hiding (many) + + +import Data.Attoparsec +import Data.Attoparsec.Char8 (char, double, skipSpace, isHorizontalSpace) +import qualified Data.ByteString.Char8 as B hiding (map) + + +import qualified Data.Iteratee as Iter +import Data.Iteratee.Char + +import qualified Data.Attoparsec.Iteratee as AI +import Data.Char + + +import Text.Xournal.Type +import Text.Xournal.Parse.Zlib + +import Data.Strict.Tuple + +import Prelude hiding (takeWhile) + +skipSpaces :: Parser () +skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace + +trim_starting_space :: Parser () +trim_starting_space = do try endOfInput + <|> takeWhile (inClass " \n") *> return () + + +-- <|> (many . satisfy . inClass ) " \n" *> return () + +langle :: Parser Char +langle = char '<' + +rangle :: Parser Char +rangle = char '>' + +xmlheader :: Parser B.ByteString +xmlheader = string " takeTill (inClass "?>") <* string "?>" + +headercontentWorker :: B.ByteString -> Parser B.ByteString +headercontentWorker bstr = do + h <- takeWhile1 (notInClass "?>") + ((string "?>" >>= return . (bstr `B.append` h `B.append`)) + <|> headercontentWorker (bstr `B.append` h)) + +headercontent :: Parser B.ByteString +headercontent = headercontentWorker B.empty + +stroketagopen :: Parser Stroke -- B.ByteString +stroketagopen = do + trim + string "' + return $ Stroke tool color width [] + +stroketagclose :: Parser B.ByteString +stroketagclose = string "" + +onestroke :: Parser Stroke +onestroke = do trim + strokeinit <- stroketagopen + coordlist <- many $ do trim_starting_space + x <- double + skipSpace + y <- double + skipSpace + return (x :!: y) + stroketagclose + return $ strokeinit { stroke_data = coordlist } + +trim :: Parser () +trim = trim_starting_space + +parser_xournal :: Parser Xournal +parser_xournal = do trim + xmlheader + trim + xournal + + +xournal :: Parser Xournal +xournal = do trim + xournalheader + trim + t <- title + trim + (try (preview >> return ()) + <|> return ()) + pgs <- many1 page + trim + xournalclose + return $ Xournal t pgs + +page :: Parser Page +page = do trim + dim <- pageheader + trim + bkg <- background + trim + layers <- many1 layer + trim + pageclose + return $ Page dim bkg layers + + +layer :: Parser Layer +layer = do trim + layerheader + trim + strokes <- many onestroke + trim + layerclose + return $ Layer strokes + + +title :: Parser B.ByteString +title = do trim + titleheader + str <- takeTill (inClass "<") -- (many . satisfy . notInClass ) "<" + titleclose + return str + +titleheader :: Parser B.ByteString +titleheader = string "" + +titleclose :: Parser B.ByteString +titleclose = string "" + +preview :: Parser () +preview = do trim + previewheader + str <- takeTill (inClass "<") + previewclose + trim + +previewheader :: Parser B.ByteString +previewheader = string "" + +previewclose :: Parser B.ByteString +previewclose = string "" + +xournalheader :: Parser B.ByteString +xournalheader = xournalheaderstart *> takeTill (inClass ">") <* xournalheaderend + +xournalheaderstart :: Parser B.ByteString +xournalheaderstart = string "' + +xournalclose :: Parser B.ByteString +xournalclose = string "" + +pageheader :: Parser Dimension +pageheader = do pageheaderstart + trim + string "width=" + char '"' + w <- double + char '"' + trim + string "height=" + char '"' + h <- double + char '"' + takeTill (inClass ">") + pageheaderend + return $ Dim w h + +pageheaderstart :: Parser B.ByteString +pageheaderstart = string "' + +pageclose :: Parser B.ByteString +pageclose = string "" + +layerheader :: Parser B.ByteString +layerheader = string "" + +layerclose :: Parser B.ByteString +layerclose = string "" + +background :: Parser Background +background = do trim + backgroundheader + trim + string "type=" + char '"' + typ <- alphabet + char '"' + trim + string "color=" + char '"' + col <- alphanumsharp + char '"' + trim + string "style=" + trim + char '"' + sty <- alphabet + char '"' + trim + takeTill (inClass "/>") -- ( many . satisfy . notInClass ) "/>" + backgroundclose + return $ Background typ col sty + +alphabet :: Parser B.ByteString +alphabet = takeWhile1 (\w -> (w >= 65 && w <= 90) || (w >= 97 && w <= 122)) + +alphanumsharp :: Parser B.ByteString +alphanumsharp = takeWhile1 (\w -> (w >= 65 && w <= 90) + || (w >= 97 && w <= 122) + || ( w >= 48 && w<= 57 ) + || ( w== 35) ) + +backgroundheader :: Parser B.ByteString +backgroundheader = string "" + +iter_xournal :: Iter.Iteratee B.ByteString IO Xournal +iter_xournal = AI.parserToIteratee parser_xournal + +read_xournal :: String -> IO Xournal +read_xournal str = Iter.fileDriver iter_xournal str + +read_xojgz :: String -> IO Xournal +read_xojgz str = Iter.fileDriver (Iter.joinIM (ungzipXoj iter_xournal)) str + + +cat_xournalgz :: String -> IO () +cat_xournalgz str = Iter.fileDriver + (Iter.joinIM (ungzipXoj printLinesUnterminated)) str + + +-- printIter :: Iter.Iteratee B.ByteString IO () +-- printIter = + + + + +onlyresult (Done _ r) = r + diff --git a/src/Text/Xournal/Parse/Enumerator.hs b/src/Text/Xournal/Parse/Enumerator.hs new file mode 100644 --- /dev/null +++ b/src/Text/Xournal/Parse/Enumerator.hs @@ -0,0 +1,21 @@ +module Text.Xournal.Parse.Enumerator where + +import Text.XML.Enumerator.Parse +import qualified Data.ByteString as S +import Data.Enumerator +import qualified Data.Enumerator as E +import Control.Monad.IO.Class + + +parseXojFile :: FilePath -> IO () +parseXojFile fn = do + x <- S.readFile fn + run_ $ enumList 1 [x] $$ joinI $ parseBytes decodeEntities $$ iterPrint + where + iterPrint = do + x <- E.head + case x of + Nothing -> return () + Just y -> liftIO (print y) >> iterPrint + + diff --git a/src/Text/Xournal/Parse/Zlib.hs b/src/Text/Xournal/Parse/Zlib.hs new file mode 100644 --- /dev/null +++ b/src/Text/Xournal/Parse/Zlib.hs @@ -0,0 +1,13 @@ +module Text.Xournal.Parse.Zlib where + +import Control.Monad.IO.Class +import Data.Iteratee.ZLib +import Data.Iteratee +import Data.ByteString +-- import Codec.Zlib.Enum +-- import Data.Enumerator +-- import Data.ByteString + +ungzipXoj :: MonadIO m => Enumerator ByteString m a +ungzipXoj = enumInflate GZip defaultDecompressParams + diff --git a/src/Text/Xournal/Predefined.hs b/src/Text/Xournal/Predefined.hs new file mode 100644 --- /dev/null +++ b/src/Text/Xournal/Predefined.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + +module Text.Xournal.Predefined where + +import qualified Data.Map as M +import qualified Data.ByteString.Char8 as B + +import Text.Printf + +hexToRGBA :: Integer -> (Double,Double,Double,Double) +hexToRGBA n = + let r = n `div` (256*256*256) + g = (n-r*256*256*256) `div` (256*256) + b = (n-r*256*256*256-g*256*256) `div` 256 + a = n-r*256*256*256-g*256*256-b*256 + in (fromIntegral r/255.0,fromIntegral g/255.0,fromIntegral b/255.0,fromIntegral a/255.0) + +rgbaToHEX :: (Double,Double,Double,Double) -> String +rgbaToHEX (r,g,b,a) = + let i :: Integer = round (255*a) + round (256*255*b) + round (256*256*255*g) + round (256*256*256*255*r) + in printf "#%08x" i + +predefined_pencolor :: M.Map B.ByteString (Double,Double,Double,Double) +predefined_pencolor = + M.fromList [ ("black" , hexToRGBA 0x000000ff) + , ("blue" , hexToRGBA 0x3333ccff) + , ("red" , hexToRGBA 0xff0000ff) + , ("green" , hexToRGBA 0x008000ff) + , ("gray" , hexToRGBA 0x808080ff) + , ("lightblue" , hexToRGBA 0x00c0ffff) + , ("lightgreen", hexToRGBA 0x00ff00ff) + , ("magenta" , hexToRGBA 0xff00ffff) + , ("orange" , hexToRGBA 0xff8000ff) + , ("yellow" , hexToRGBA 0xffff00ff) + , ("white" , hexToRGBA 0xffffffff) ] + +{- +getPenColor :: B.ByteString -> Maybe (Double,Double,Double,Double) +getPenColor b | (not . B.null) b = + case B.head b of + '#' -> B.tail b +-} + +predefined_bkgcolor :: M.Map B.ByteString (Double,Double,Double,Double) +predefined_bkgcolor = + M.fromList [ ("" , hexToRGBA 0xffffffff) + , ("blue" , hexToRGBA 0xa0e8ffff) + , ("pink" , hexToRGBA 0xffc0d4ff) + , ("green" , hexToRGBA 0x80ffc0ff) + , ("orange", hexToRGBA 0xffc080ff) + , ("yellow", hexToRGBA 0xffff80ff) + , ("white" , hexToRGBA 0xffffffff) ] + +predefined_veryfine :: Double +predefined_veryfine = 0.42 + +predefined_fine :: Double +predefined_fine = 0.85 + +predefined_medium :: Double +predefined_medium = 1.41 + +predefined_thick :: Double +predefined_thick = 2.26 + +predefined_verythick :: Double +predefined_verythick = 5.67 + +predefined_RULING_MARGIN_COLOR :: (Double,Double,Double,Double) +predefined_RULING_MARGIN_COLOR = hexToRGBA 0xff0080ff + +predefined_RULING_COLOR :: (Double,Double,Double,Double) +predefined_RULING_COLOR = hexToRGBA 0x40a0ffff + +predefined_RULING_THICKNESS :: Double +predefined_RULING_THICKNESS = 0.5 + +predefined_RULING_LEFTMARGIN :: Double +predefined_RULING_LEFTMARGIN = 72.0 + +predefined_RULING_TOPMARGIN :: Double +predefined_RULING_TOPMARGIN = 80.0 + +predefined_RULING_SPACING :: Double +predefined_RULING_SPACING = 24.0 + +predefined_RULING_BOTTOMMARGIN :: Double +predefined_RULING_BOTTOMMARGIN = predefined_RULING_SPACING + +predefined_RULING_GRAPHSPACING :: Double +predefined_RULING_GRAPHSPACING = 14.17 diff --git a/src/Text/Xournal/Type.hs b/src/Text/Xournal/Type.hs new file mode 100644 --- /dev/null +++ b/src/Text/Xournal/Type.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE BangPatterns, OverloadedStrings, + TypeFamilies, FlexibleContexts #-} + +module Text.Xournal.Type where + +import qualified Data.ByteString as S +import Data.Strict.Tuple + +import Prelude hiding (fst,snd,curry,uncurry) + +class IStroke a where + strokeTool :: a -> S.ByteString + strokeColor :: a -> S.ByteString + strokeWidth :: a -> Double + strokeData :: a -> [Pair Double Double] + +class (IStroke (TStroke a)) => ILayer a where + type TStroke a :: * + layerStrokes :: a -> [TStroke a] + +class (ILayer (TLayer a)) => IPage a where + type TLayer a :: * + pageDim :: a -> Dimension + pageBkg :: a -> Background + pageLayers :: a -> [TLayer a] + +class (IPage (TPage a)) => IXournal a where + type TPage a :: * + xournalPages :: a -> [TPage a] + +type Title = S.ByteString + +data Stroke = Stroke { stroke_tool :: !S.ByteString + , stroke_color :: !S.ByteString + , stroke_width :: !Double + , stroke_data :: ![Pair Double Double] + } + deriving Show + +data Dimension = Dim { dim_width :: !Double, dim_height :: !Double } + deriving Show + +data Background = Background { bkg_type :: !S.ByteString + , bkg_color :: !S.ByteString + , bkg_style :: !S.ByteString + } + deriving Show + +data Xournal = Xournal { xoj_title :: !Title, xoj_pages :: ![Page] } + deriving Show + +data Page = Page { page_dim :: !Dimension + , page_bkg :: !Background + , page_layers :: ![Layer] } + deriving Show + +data Layer = Layer { layer_strokes :: ![Stroke] } + deriving Show + +emptyXournal :: Xournal +emptyXournal = Xournal "" [] + +defaultBackground :: Background +defaultBackground = Background { bkg_type = "solid" + , bkg_color = "white" + , bkg_style = "lined" + } + +defaultLayer :: Layer +defaultLayer = Layer { layer_strokes = [] } + +defaultPage :: Page +defaultPage = Page { page_dim = Dim 612.0 792.0 + , page_bkg = defaultBackground + , page_layers = [ defaultLayer ] + } + +defaultXournal :: Xournal +defaultXournal = Xournal "untitled" [ defaultPage ] + +instance IStroke Stroke where + strokeTool = stroke_tool + strokeColor = stroke_color + strokeWidth = stroke_width + strokeData = stroke_data + +instance ILayer Layer where + type TStroke Layer = Stroke + layerStrokes = layer_strokes + +instance IPage Page where + type TLayer Page = Layer + pageDim = page_dim + pageBkg = page_bkg + pageLayers = page_layers + +instance IXournal Xournal where + type TPage Xournal = Page + xournalPages = xoj_pages diff --git a/xournal-parser.cabal b/xournal-parser.cabal new file mode 100644 --- /dev/null +++ b/xournal-parser.cabal @@ -0,0 +1,39 @@ +Name: xournal-parser +Version: 0.2 +Synopsis: Xournal file parser +Description: Define Xournal type and parser for xournal xml file +License: BSD3 +License-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Build-Type: Simple +Cabal-Version: >= 1.8 + +Library + hs-source-dirs: src + ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind + ghc-prof-options: -caf-all -auto-all + Build-Depends: base == 4.*, + mtl == 2.*, + transformers == 0.2.*, + attoparsec == 0.9.*, + attoparsec-iteratee == 0.3.*, + iteratee >= 0.7 && < 0.9, + bytestring == 0.9.*, + containers == 0.4.*, + xml-enumerator < 0.4, + enumerator >= 0.4.13 && < 0.5, + strict == 0.3.*, + iteratee-compress == 0.2.1.* + Exposed-Modules: + Text.Xournal.Type + Text.Xournal.Parse + Text.Xournal.Predefined + Text.Xournal.Parse.Enumerator + Text.Xournal.Parse.Zlib + + + + + +