xournal-types (empty) → 0.1
raw patch · 9 files changed
+603/−0 lines, 9 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, fclabels, strict
Files
- CHANGES +4/−0
- LICENSE +25/−0
- Setup.lhs +10/−0
- src/Data/Xournal/BBox.hs +62/−0
- src/Data/Xournal/Generic.hs +162/−0
- src/Data/Xournal/Map.hs +70/−0
- src/Data/Xournal/Predefined.hs +91/−0
- src/Data/Xournal/Simple.hs +141/−0
- xournal-types.cabal +38/−0
+ CHANGES view
@@ -0,0 +1,4 @@+0.1: 18 Dec 2011+ * First public release. ++
+ 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+> -- }
+ src/Data/Xournal/BBox.hs view
@@ -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] } +-}+
+ src/Data/Xournal/Generic.hs view
@@ -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 +
+ src/Data/Xournal/Map.hs view
@@ -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 + +-} + +
+ src/Data/Xournal/Predefined.hs view
@@ -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
+ src/Data/Xournal/Simple.hs view
@@ -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 +-}
+ xournal-types.cabal view
@@ -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 <ianwookim@gmail.com>+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: ++ +