diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,4 @@ +0.1: 18 Dec 2011 + * First public release. + + 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/src/Data/Xournal/BBox.hs b/src/Data/Xournal/BBox.hs new file mode 100644 --- /dev/null +++ b/src/Data/Xournal/BBox.hs @@ -0,0 +1,62 @@ +module Data.Xournal.BBox where + +import Data.ByteString hiding (map,maximum,minimum) +import Data.Xournal.Generic +import Data.Xournal.Simple +import Data.Strict.Tuple +import Prelude hiding (fst,snd) + +data BBox = BBox { bbox_upperleft :: (Double,Double) + , bbox_lowerright :: (Double,Double) } + deriving (Show) + +data StrokeBBox = StrokeBBox { strokebbox_tool :: ByteString + , strokebbox_color :: ByteString + , strokebbox_width :: Double + , strokebbox_data :: [Pair Double Double] + , strokebbox_bbox :: BBox } + deriving (Show) + +type TLayerBBox = GLayer [] StrokeBBox + +type TPageBBox = GPage Background [] TLayerBBox + +type TXournalBBox = GXournal [] TPageBBox + +instance GStrokeable StrokeBBox where + gFromStroke = mkStrokeBBoxFromStroke + gToStroke = strokeFromStrokeBBox + +mkbbox :: [Pair Double Double] -> BBox +mkbbox lst = let xs = map fst lst + ys = map snd lst + in BBox { bbox_upperleft = (minimum xs, minimum ys) + , bbox_lowerright = (maximum xs, maximum ys) } + + +mkStrokeBBoxFromStroke :: Stroke -> StrokeBBox +mkStrokeBBoxFromStroke str = + StrokeBBox { strokebbox_tool = stroke_tool str + , strokebbox_color = stroke_color str + , strokebbox_width = stroke_width str + , strokebbox_data = stroke_data str + , strokebbox_bbox = mkbbox (stroke_data str) } + +strokeFromStrokeBBox :: StrokeBBox -> Stroke +strokeFromStrokeBBox strbbox = + Stroke { stroke_tool = strokebbox_tool strbbox + , stroke_color = strokebbox_color strbbox + , stroke_width= strokebbox_width strbbox + , stroke_data = strokebbox_data strbbox } + + +{- +data XournalBBox = XournalBBox { xojbbox_pages :: [PageBBox] } + +data PageBBox = PageBBox { pagebbox_dim :: Dimension + , pagebbox_bkg :: Background + , pagebbox_layers :: [LayerBBox] } + +data LayerBBox = LayerBBox { layerbbox_strokes :: [StrokeBBox] } +-} + diff --git a/src/Data/Xournal/Generic.hs b/src/Data/Xournal/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Xournal/Generic.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE TypeFamilies, TypeOperators #-} + +module Data.Xournal.Generic where + +import Data.IntMap hiding (map) +-- import Text.Xournal.Type +import Data.Xournal.Simple +import Data.ByteString hiding (map,zip) + +import Control.Applicative +import Data.Functor + +import Control.Category +import Data.Label +import Prelude hiding ((.),id) + +data GXournal s a = GXournal { gtitle :: ByteString + , gpages :: s a } + +data GPage b s a = GPage { gdimension :: Dimension + , gbackground :: b + , glayers :: s a } + +newtype GLayer s a = GLayer { gstrokes :: s a } + +instance (Functor s) => Functor (GLayer s) where + fmap f (GLayer strs) = GLayer (fmap f strs) + +instance (Functor s) => Functor (GPage b s) where + fmap f (GPage d b ls) = GPage d b (fmap f ls) + +instance (Functor s) => Functor (GXournal s) where + fmap f (GXournal t ps) = GXournal t (fmap f ps) + + + +-- data GBackground b = GBackground b + +data GSelect a b = GSelect { gselectTitle :: ByteString + , gselectAll :: a + , gselectSelected :: b + } + + +type TLayerSimple = GLayer [] Stroke + +type TPageSimple = GPage Background [] TLayerSimple + +type TXournalSimple = GXournal [] TPageSimple + +class GStrokeable a where + gFromStroke :: Stroke -> a + gToStroke :: a -> Stroke + +instance GStrokeable Stroke where + gFromStroke = id + gToStroke = id + + +class GListable s where + gFromList :: [a] -> s a + gToList :: s a -> [a] + +instance GListable [] where + gFromList = id + gToList = id + +instance GListable IntMap where + gFromList = Data.IntMap.fromList . zip [0..] + gToList = Data.IntMap.elems + + +class GBackgroundable b where + gFromBackground :: Background -> b + gToBackground :: b -> Background + +instance GBackgroundable Background where + gFromBackground = id + gToBackground = id + +fromLayer :: (GStrokeable a, GListable s) => Layer -> GLayer s a +fromLayer = GLayer . gFromList . fmap gFromStroke . layer_strokes + +fromPage :: (GStrokeable a, GBackgroundable b, + GListable s, GListable s') => + Page -> GPage b s' (GLayer s a) +fromPage p = let bkg = gFromBackground $ page_bkg p + dim = page_dim p + ls = gFromList . fmap fromLayer . page_layers $ p + in GPage dim bkg ls + + +class SListable m where + chgStreamToList :: (GListable s) => m s a -> m [] a + +instance SListable GLayer where + chgStreamToList (GLayer xs) = GLayer (gToList xs) + +instance SListable (GPage b) where + chgStreamToList (GPage d b ls) = GPage d b (gToList ls) + +instance SListable GXournal where + chgStreamToList (GXournal t ps) = GXournal t (gToList ps) + +g_title :: GXournal s a :-> ByteString +g_title = lens gtitle (\a f -> f { gtitle = a } ) + +g_pages :: GXournal s a :-> s a +g_pages = lens gpages (\a f -> f { gpages = a } ) + +g_dimension :: GPage b s a :-> Dimension +g_dimension = lens gdimension (\a f -> f { gdimension = a } ) + +g_background :: GPage b s a :-> b +g_background = lens gbackground (\a f -> f { gbackground = a } ) + +g_layers :: GPage b s a :-> s a +g_layers = lens glayers (\a f -> f { glayers = a } ) + +g_strokes :: GLayer s a :-> s a +g_strokes = lens gstrokes (\a f -> f { gstrokes = a } ) + +g_selectTitle :: GSelect a b :-> ByteString +g_selectTitle = lens gselectTitle (\a f -> f {gselectTitle = a}) + +g_selectAll :: GSelect a b :-> a +g_selectAll = lens gselectAll (\a f -> f {gselectAll = a} ) + +g_selectSelected :: GSelect a b :-> b +g_selectSelected = lens gselectSelected (\a f -> f {gselectSelected = a}) + + + +toLayer :: (GStrokeable a, GListable s) => GLayer s a -> Layer +toLayer = layerFromTLayerSimple . fmap gToStroke . chgStreamToList + +toPage :: (GStrokeable a, GBackgroundable b, GListable s, GListable s', Functor s') => + (b->Background) -> GPage b s' (GLayer s a) -> Page +toPage f = pageFromTPageSimple . bkgchange f . chgStreamToList . fmap (fmap gToStroke . chgStreamToList) + + +bkgchange :: (b -> b') -> GPage b s a -> GPage b' s a +bkgchange f p = p { gbackground = f (gbackground p) } + +mkTLayerSimpleFromLayer :: Layer -> TLayerSimple +mkTLayerSimpleFromLayer = GLayer <$> layer_strokes + +mkTPageSimpleFromPage :: Page -> TPageSimple +mkTPageSimpleFromPage = GPage <$> page_dim <*> page_bkg <*> map mkTLayerSimpleFromLayer . page_layers + +mkTXournalSimpleFromXournal :: Xournal -> TXournalSimple +mkTXournalSimpleFromXournal = GXournal <$> xoj_title <*> map mkTPageSimpleFromPage . xoj_pages + +layerFromTLayerSimple :: TLayerSimple -> Layer +layerFromTLayerSimple = Layer <$> gstrokes + +pageFromTPageSimple :: TPageSimple -> Page +pageFromTPageSimple = Page <$> gdimension <*> gbackground <*> map layerFromTLayerSimple . glayers + +xournalFromTXournalSimple :: TXournalSimple -> Xournal +xournalFromTXournalSimple = Xournal <$> gtitle <*> map pageFromTPageSimple . gpages + diff --git a/src/Data/Xournal/Map.hs b/src/Data/Xournal/Map.hs new file mode 100644 --- /dev/null +++ b/src/Data/Xournal/Map.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE TypeFamilies #-} + +module Data.Xournal.Map where + +import Data.IntMap +import Data.Xournal.Simple +import Data.Xournal.Generic +import Data.Xournal.BBox + +type TPageMap = GPage Background IntMap TLayerSimple + +type TXournalMap = GXournal [] TPageMap + +type TPageBBoxMap = GPage Background IntMap TLayerBBox + +type TXournalBBoxMap = GXournal IntMap TPageBBoxMap + +type TPageBBoxMapBkg b = GPage b IntMap TLayerBBox + +type TXournalBBoxMapBkg b = GXournal IntMap (TPageBBoxMapBkg b) + + +{- +data XournalBBoxMap = XournalBBoxMap { xbm_pages :: M.IntMap PageBBoxMap } + +data PageBBoxMap = PageBBoxMap { pbm_dim :: Dimension + , pbm_bkg :: Background + , pbm_layers :: M.IntMap LayerBBox } +-} + +{- +instance IPage PageBBoxMap where + type TLayer PageBBoxMap = LayerBBox + pageDim = pbm_dim + pageBkg = pbm_bkg + pageLayers = M.elems . pbm_layers + +instance IXournal XournalBBoxMap where + type TPage XournalBBoxMap = PageBBoxMap + xournalPages = M.elems . xbm_pages + +mkXournalBBoxMapFromXournalBBox :: XournalBBox -> XournalBBoxMap +mkXournalBBoxMapFromXournalBBox xoj = + XournalBBoxMap { xbm_pages = M.map mkPageBBoxMapFromPageBBox + . M.fromList + $ zip [0..] (xojbbox_pages xoj) } + +mkPageBBoxMapFromPageBBox :: PageBBox -> PageBBoxMap +mkPageBBoxMapFromPageBBox page = + PageBBoxMap { pbm_dim = pagebbox_dim page + , pbm_bkg = pagebbox_bkg page + , pbm_layers = M.fromList $ zip [0..] (pagebbox_layers page) } + +mkXournalBBoxMapFromXournal :: Xournal -> XournalBBoxMap +mkXournalBBoxMapFromXournal = mkXournalBBoxMapFromXournalBBox . mkXournalBBoxFromXournal + +xournalFromXournalBBoxMap :: XournalBBoxMap -> Xournal +xournalFromXournalBBoxMap xoj = + emptyXournal { xoj_pages = map pageFromPageBBoxMap (xournalPages xoj) } + +pageFromPageBBoxMap :: PageBBoxMap -> Page +pageFromPageBBoxMap page = + let pbox = PageBBox { pagebbox_dim = pbm_dim page + , pagebbox_bkg = pbm_bkg page + , pagebbox_layers = pageLayers page } + in pageFromPageBBox pbox + +-} + + diff --git a/src/Data/Xournal/Predefined.hs b/src/Data/Xournal/Predefined.hs new file mode 100644 --- /dev/null +++ b/src/Data/Xournal/Predefined.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + +module Data.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/Data/Xournal/Simple.hs b/src/Data/Xournal/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Data/Xournal/Simple.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE BangPatterns, OverloadedStrings, TypeOperators, + TypeFamilies, FlexibleContexts #-} + +module Data.Xournal.Simple where + +import qualified Data.ByteString as S +import Data.ByteString.Char8 +import Data.Strict.Tuple + +import Control.Category +import Data.Label +import Prelude hiding ((.),id,putStrLn) + + + +import Prelude hiding (fst,snd,curry,uncurry) + +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 + } + | BackgroundPdf { bkg_type :: S.ByteString + , bkg_domain :: Maybe S.ByteString + , bkg_filename :: Maybe S.ByteString + , bkg_pageno :: Int + } + 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 + +s_tool :: Stroke :-> ByteString +s_tool = lens stroke_tool (\a f -> f { stroke_tool = a }) + +s_color :: Stroke :-> ByteString +s_color = lens stroke_color (\a f -> f { stroke_color = a } ) + +s_width :: Stroke :-> Double +s_width = lens stroke_width (\a f -> f { stroke_width = a } ) + +s_data :: Stroke :-> [Pair Double Double] +s_data = lens stroke_data (\a f -> f { stroke_data = a } ) + +s_title :: Xournal :-> Title +s_title = lens xoj_title (\a f -> f { xoj_title = a } ) + +s_pages :: Xournal :-> [Page] +s_pages = lens xoj_pages (\a f -> f { xoj_pages = a } ) + +s_dim :: Page :-> Dimension +s_dim = lens page_dim (\a f -> f { page_dim = a } ) + +s_bkg :: Page :-> Background +s_bkg = lens page_bkg (\a f -> f { page_bkg = a } ) + +s_layers :: Page :-> [Layer] +s_layers = lens page_layers (\a f -> f { page_layers = a } ) + +s_strokes :: Layer :-> [Stroke] +s_strokes = lens layer_strokes (\a f -> f { layer_strokes = a } ) + + + +emptyXournal :: Xournal +emptyXournal = Xournal "" [] + +emptyLayer :: Layer +emptyLayer = Layer { layer_strokes = [] } + +emptyStroke :: Stroke +emptyStroke = Stroke "pen" "black" 1.4 [] + + +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 ] + + +newPageFromOld :: Page -> Page +newPageFromOld page = + Page { page_dim = page_dim page + , page_bkg = page_bkg page + , page_layers = [emptyLayer] } + + + +{- +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-types.cabal b/xournal-types.cabal new file mode 100644 --- /dev/null +++ b/xournal-types.cabal @@ -0,0 +1,38 @@ +Name: xournal-types +Version: 0.1 +Synopsis: Data types for programs for xournal file format +Description: Xournal file format data type including generic interface +License: BSD3 +License-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Category: Data +Build-Type: Simple +Cabal-Version: >= 1.8 +data-files: CHANGES +Source-repository head + type: git + location: https://www.github.com/wavewave/hxournal + + +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.*, + bytestring == 0.9.*, + strict == 0.3.*, + containers == 0.4.*, + fclabels == 1.0.* + Exposed-Modules: + Data.Xournal.Generic + Data.Xournal.Simple + Data.Xournal.BBox + Data.Xournal.Map +-- Data.Xournal.Select + Data.Xournal.Predefined + Other-Modules: + + +