packages feed

xournal-types 0.3.2 → 0.4

raw patch · 7 files changed

+159/−58 lines, 7 files

Files

src/Data/Xournal/BBox.hs view
@@ -14,27 +14,37 @@  module Data.Xournal.BBox where +import Control.Applicative  import Control.Monad-import Data.ByteString hiding (map,maximum,minimum) -- import qualified Data.Sequence as Seq import Data.Xournal.Generic import Data.Xournal.Simple+import Data.Xournal.Util import Data.Strict.Tuple  import qualified Data.Foldable as F import Data.Monoid import Prelude hiding (fst,snd) import qualified Prelude as Prelude (fst,snd) ++-- | bounding box type + data BBox = BBox { bbox_upperleft :: (Double,Double)                   , bbox_lowerright :: (Double,Double) }            deriving (Show,Eq) -data StrokeBBox = StrokeBBox { strokebbox_tool :: ByteString+-- | ++data StrokeBBox = StrokeBBox { strokebbox_stroke :: Stroke +                             , strokebbox_bbox :: BBox } +                deriving (Show)+  +{-  +  StrokeBBox { strokebbox_tool :: ByteString                              , strokebbox_color :: ByteString                               , strokebbox_width :: Double                              , strokebbox_data :: [Pair Double Double] -                             , strokebbox_bbox :: BBox }-                deriving (Show)+                             , strokebbox_bbox :: BBox } -}  type TLayerBBox = GLayer [] StrokeBBox  @@ -59,6 +69,14 @@   in BBox{bbox_upperleft=(F.minimum xs, F.minimum ys)          ,bbox_lowerright=(F.maximum xs, F.maximum ys)} +bboxFromStroke :: Stroke -> BBox +bboxFromStroke (Stroke _ _ w dat) = inflate (mkbbox dat) w+bboxFromStroke (VWStroke _ _ dat) = +  let dat' = map ((,) <$> fst3 <*> snd3) dat +      widthmax = F.maximum (map trd3 dat)+  in inflate (mkbboxF dat') widthmax+   + dimToBBox :: Dimension -> BBox  dimToBBox (Dim w h) = BBox (0,0) (w,h) @@ -67,6 +85,11 @@ xformBBox :: ((Double,Double) -> (Double,Double)) -> BBox -> BBox  xformBBox f (BBox c1 c2) = BBox (f c1) (f c2) +-- |++inflate :: BBox -> Double -> BBox +inflate (BBox (x1,y1) (x2,y2)) r = BBox (x1-r,y1-r) (x2+r,y2+r)+ -- |   moveBBoxToOrigin :: BBox -> BBox @@ -90,12 +113,6 @@       y6 = min y2 y4   return (BBox (x5,y5) (x6,y6))   -{- -  let x5 = if x1 <= x3 && x2 <= x3  && xthen x3 else x1-      y5 = if y1 < y3 then y3 else y1-      x6 = if x2 < x4 then x2 else x4-      y6 = if y2 < y4 then y2 else y4-  in BBox (x5,y5) (x6,y6) -}       unionBBox :: BBox -> BBox -> BBox unionBBox (BBox (x1,y1) (x2,y2)) (BBox (x3,y3) (x4,y4)) = @@ -142,7 +159,7 @@    instance Maybeable IntersectBBox where   type ElemType IntersectBBox = BBox-  toMaybe (Intersect Bottom) = Nothing  -- error "empty intersectbbox"+  toMaybe (Intersect Bottom) = Nothing     toMaybe (Intersect Top) = Nothing    toMaybe (Intersect (Middle x)) = Just x    fromMaybe Nothing = Intersect Top @@ -150,7 +167,7 @@    instance Maybeable UnionBBox where   type ElemType UnionBBox = BBox-  toMaybe (Union Bottom) = Nothing -- error "empty unionbbox"+  toMaybe (Union Bottom) = Nothing    toMaybe (Union Top) = Nothing    toMaybe (Union (Middle x)) = Just x    fromMaybe Nothing = Union Top @@ -159,27 +176,11 @@  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) } +  StrokeBBox { strokebbox_stroke = str +             , strokebbox_bbox = bboxFromStroke 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] } +strokeFromStrokeBBox = strokebbox_stroke  -data LayerBBox = LayerBBox { layerbbox_strokes :: [StrokeBBox] } --}
src/Data/Xournal/Generic.hs view
@@ -70,6 +70,8 @@  type TXournalSimple = GXournal [] TPageSimple  +-- |+ class GStrokeable a where   gFromStroke :: Stroke -> a    gToStroke :: a -> Stroke @@ -78,6 +80,7 @@   gFromStroke = id   gToStroke = id  +-- |  class GListable s where     gFromList :: [a] -> s a @@ -91,6 +94,7 @@   gFromList = Data.IntMap.fromList . zip [0..]    gToList = Data.IntMap.elems  +-- |  class GBackgroundable b where   gFromBackground :: Background -> b @@ -100,9 +104,13 @@   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)  @@ -111,6 +119,7 @@                  ls =  gFromList . fmap fromLayer . page_layers $ p               in  GPage dim bkg ls  +-- |  class SListable m where   chgStreamToList :: (GListable s) => m s a -> m [] a @@ -124,48 +133,69 @@ 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_bstrokes :: GLayerBuf b s a :-> s a  g_bstrokes = lens gbstrokes (\a f -> f { gbstrokes = a } ) +-- |+ g_buffer :: GLayerBuf b s a :-> b  g_buffer = lens gbuffer (\a f -> f { gbuffer = 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  +-- |+ toNoBufferLayer :: GLayerBuf b s a -> GLayer s a -toNoBufferLayer (GLayerBuf b s) = GLayer s +toNoBufferLayer (GLayerBuf _b s) = GLayer s    toPage :: (GStrokeable a, GBackgroundable b, GListable s, GListable s', Functor s') =>
src/Data/Xournal/Predefined.hs view
@@ -18,6 +18,13 @@  import Text.Printf  +-- | ++predefinedPenShapeAspectXY :: (Double,Double)+predefinedPenShapeAspectXY = (cos (pi/6.0), sin (pi/6.0))++-- | + hexToRGBA :: Integer -> (Double,Double,Double,Double)  hexToRGBA n =    let r = n `div` (256*256*256)@@ -72,7 +79,7 @@ predefined_fine = 0.85  predefined_medium :: Double-predefined_medium = 1.41+predefined_medium = 1.41   predefined_thick :: Double predefined_thick = 2.26@@ -80,6 +87,9 @@ predefined_verythick :: Double  predefined_verythick = 5.67 +predefined_ultrathick :: Double +predefined_ultrathick = 15.41+ ---- for Highlighter  predefined_highlighter_veryfine :: Double@@ -97,6 +107,10 @@ predefined_highlighter_verythick :: Double  predefined_highlighter_verythick = 19.84 +predefined_highlighter_ultrathick :: Double +predefined_highlighter_ultrathick = 30.84++ ---- for Eraser  predefined_eraser_veryfine :: Double@@ -114,6 +128,8 @@ predefined_eraser_verythick :: Double  predefined_eraser_verythick = 19.84 +predefined_eraser_ultrathick :: Double +predefined_eraser_ultrathick = 30.84
src/Data/Xournal/Select.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TypeSynonymInstances, TypeOperators, FlexibleInstances, -             StandaloneDeriving, DeriveFunctor, DeriveFoldable, DeriveTraversable  #-}+             StandaloneDeriving, DeriveFunctor, DeriveFoldable, +             DeriveTraversable  #-}  ----------------------------------------------------------------------------- -- |@@ -11,6 +12,7 @@ -- Stability   : experimental -- Portability : GHC --+-----------------------------------------------------------------------------  module Data.Xournal.Select where @@ -39,11 +41,11 @@ singletonSZ x = SZ (x, (empty,empty))  lengthSZ :: SeqZipper a -> Int -lengthSZ (SZ (x, (x1s,x2s))) = length x1s + length x2s + 1 +lengthSZ (SZ (_x, (x1s,x2s))) = length x1s + length x2s + 1    currIndex :: SeqZipper a -> Int-currIndex (SZ (x, (x1s,x2s))) = length x1s +currIndex (SZ (_x, (x1s,_x2s))) = length x1s   appendGoLast :: SeqZipper a -> a -> SeqZipper a appendGoLast (SZ (y,(y1s,y2s))) x = SZ (x, ((y1s |> y) >< y2s, empty))@@ -54,7 +56,7 @@     EmptyL -> case viewl y2s of                  EmptyL -> Nothing                  z :< zs -> Just (SZ (z,(empty,zs)))-    z :< zs -> Just (SZ (y,(zs,y2s)))+    _z :< zs -> Just (SZ (y,(zs,y2s)))      moveLeft :: SeqZipper a -> Maybe (SeqZipper a) moveLeft (SZ (x,(x1s,x2s))) = @@ -80,6 +82,7 @@              | n > n_x1s = let (x2s1,x2s2) = splitAt (n-n_x1s-1) x2s                                el :< rm = viewl x2s2                            in Just (SZ (el, ((x1s |> x) >< x2s1, rm)))+             | otherwise = error "error in moveTo"   in result   goFirst :: SeqZipper a -> SeqZipper a @@ -106,11 +109,11 @@ next = fmap current . moveRight  replace :: a -> SeqZipper a -> SeqZipper a -replace y (SZ (x,zs)) = SZ (y,zs)+replace y (SZ (_x,zs)) = SZ (y,zs)   deleteCurrent :: SeqZipper a -> Maybe (SeqZipper a)-deleteCurrent orig@(SZ (_,(xs,ys))) = +deleteCurrent (SZ (_,(xs,ys))) =    case viewl ys of      EmptyL -> case viewr xs of                  EmptyR -> Nothing @@ -126,7 +129,7 @@  selectFirst :: ZipperSelect a -> ZipperSelect a  selectFirst (NoSelect []) = NoSelect []-selectFirst (NoSelect lst@(x:xs))  = Select . gFromList $ lst+selectFirst (NoSelect lst@(_:_))  = Select . gFromList $ lst selectFirst (Select (O Nothing)) = NoSelect [] selectFirst (Select (O msz)) = Select . O $ return . goFirst =<<  msz
src/Data/Xournal/Simple.hs view
@@ -11,20 +11,17 @@ -- Stability   : experimental -- Portability : GHC --- +----------------------------------------------------------------------------- + module Data.Xournal.Simple where +import Control.Applicative  import qualified Data.ByteString as S-import Data.ByteString.Char8+import Data.ByteString.Char8 hiding (map) import Data.Strict.Tuple--import Control.Category+import Data.Xournal.Util import Data.Label-import Prelude hiding ((.),id,putStrLn)----import Prelude hiding (fst,snd,curry,uncurry)+import Prelude hiding ((.),id,putStrLn,fst,snd,curry,uncurry)  type Title = S.ByteString @@ -33,11 +30,19 @@                      , stroke_width :: !Double                      , stroke_data  :: ![Pair Double Double]                      }+            | VWStroke { stroke_tool :: S.ByteString +                       , stroke_color :: S.ByteString +                       , stroke_vwdata :: [(Double,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 @@ -49,28 +54,44 @@                                 }                 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  +-- | ++getXYtuples :: Stroke -> [(Double,Double)]+getXYtuples (Stroke _t _c _w d) = map (\(x :!: y) -> (x,y)) d+getXYtuples (VWStroke _t _c d) = map ((,)<$>fst3<*>snd3) d ++-- | + 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_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_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 } )
+ src/Data/Xournal/Util.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Xournal.Util+-- Copyright   : (c) 2011, 2012 Ian-Woo Kim+--+-- License     : BSD3+-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------++module Data.Xournal.Util where++-- |++fst3 :: (a,b,c) -> a+fst3 (x,_,_) = x ++-- |++snd3 :: (a,b,c) -> b+snd3 (_,y,_) = y ++-- |++trd3 :: (a,b,c) -> c+trd3 (_,_,z) = z+
xournal-types.cabal view
@@ -1,5 +1,5 @@ Name:		xournal-types-Version:	0.3.2+Version:	0.4 Synopsis:	Data types for programs for xournal file format Description: 	Xournal file format data type including generic interface License: 	BSD3@@ -34,6 +34,7 @@                    Data.Xournal.Buffer                    Data.Xournal.Predefined                     Data.Xournal.Select+                   Data.Xournal.Util   Other-Modules: