xournal-types 0.2 → 0.3
raw patch · 6 files changed
+157/−4 lines, 6 filesdep +TypeCompose
Dependencies added: TypeCompose
Files
- CHANGES +2/−0
- src/Data/Xournal/Buffer.hs +2/−1
- src/Data/Xournal/Generic.hs +6/−0
- src/Data/Xournal/Map.hs +1/−0
- src/Data/Xournal/Select.hs +141/−0
- xournal-types.cabal +5/−3
CHANGES view
@@ -2,5 +2,7 @@ * First public release 0.2: 25 Dec 2011 * double buffer support+0.3: 15 Jan 2012 + * ZipperSelect support
src/Data/Xournal/Buffer.hs view
@@ -3,6 +3,7 @@ module Data.Xournal.Buffer where import Data.IntMap +import Data.Xournal.Select import Data.Xournal.Simple import Data.Xournal.Generic import Data.Xournal.BBox@@ -10,7 +11,7 @@ type TLayerBBoxBuf buf = GLayerBuf buf [] StrokeBBox -type TPageBBoxMapBkgBuf bkg buf = GPage bkg IntMap (TLayerBBoxBuf buf)+type TPageBBoxMapBkgBuf bkg buf = GPage bkg ZipperSelect (TLayerBBoxBuf buf) type TXournalBBoxMapBkgBuf bkg buf = GXournal IntMap (TPageBBoxMapBkgBuf bkg buf)
src/Data/Xournal/Generic.hs view
@@ -187,3 +187,9 @@ xournalFromTXournalSimple :: TXournalSimple -> Xournal xournalFromTXournalSimple = Xournal <$> gtitle <*> map pageFromTPageSimple . gpages ++---- ++emptyPageFromOldPage :: (GListable s) => GPage b s a -> GPage b s a+emptyPageFromOldPage p = GPage (get g_dimension p) (get g_background p) (gFromList [] )+
src/Data/Xournal/Map.hs view
@@ -22,3 +22,4 @@ emptyGXournalMap :: GXournal IntMap a emptyGXournalMap = GXournal "" empty+
+ src/Data/Xournal/Select.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE TypeSynonymInstances, TypeOperators, FlexibleInstances, + StandaloneDeriving, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}++module Data.Xournal.Select where++import Control.Applicative hiding (empty)+import Control.Compose+import Data.Foldable+import Data.Traversable+import Data.Monoid+import Data.Sequence+import Data.Xournal.Generic++import Prelude hiding (zipWith, length, splitAt)++newtype SeqZipper a = SZ { unSZ :: (a, (Seq a,Seq a)) } ++deriving instance Functor SeqZipper+deriving instance Foldable SeqZipper ++instance Applicative SeqZipper where+ pure = singletonSZ + SZ (f,(f1s,f2s)) <*> SZ (x,(y1s,y2s)) = SZ (f x, (zipWith id f1s y1s, zipWith id f2s y2s))++deriving instance Traversable SeqZipper ++singletonSZ :: a -> SeqZipper a +singletonSZ x = SZ (x, (empty,empty))++lengthSZ :: SeqZipper a -> Int +lengthSZ (SZ (x, (x1s,x2s))) = length x1s + length x2s + 1 +++currIndex :: SeqZipper a -> Int+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))++chopFirst :: SeqZipper a -> Maybe (SeqZipper a)+chopFirst (SZ (y,(y1s,y2s))) = + case viewl y1s of+ EmptyL -> case viewl y2s of + EmptyL -> Nothing + z :< zs -> Just (SZ (z,(empty,zs)))+ z :< zs -> Just (SZ (y,(zs,y2s)))+ +moveLeft :: SeqZipper a -> Maybe (SeqZipper a)+moveLeft (SZ (x,(x1s,x2s))) = + case viewr x1s of+ EmptyR -> Nothing + zs :> z -> Just (SZ (z,(zs,x<|x2s)))++moveRight :: SeqZipper a -> Maybe (SeqZipper a) +moveRight (SZ (x,(x1s,x2s))) = + case viewl x2s of + EmptyL -> Nothing+ z :< zs -> Just (SZ (z,(x1s|>x,zs)))++moveTo :: Int -> SeqZipper a -> Maybe (SeqZipper a) +moveTo n orig@(SZ (x,(x1s,x2s))) = + let n_x1s = length x1s + n_x2s = length x2s + result | n < 0 || n > n_x1s + n_x2s = Nothing + | n == n_x1s = Just orig + | n < n_x1s = let (x1s1, x1s2) = splitAt n x1s + el :< rm = viewl x1s2+ in Just (SZ (el, (x1s1,(rm |> x) >< x2s)))+ | n > n_x1s = let (x2s1,x2s2) = splitAt (n-n_x1s-1) x2s+ el :< rm = viewl x2s2+ in Just (SZ (el, ((x1s |> x) >< x2s1, rm)))+ in result ++goFirst :: SeqZipper a -> SeqZipper a +goFirst orig@(SZ (x,(x1s,x2s))) =+ case viewl x1s of + EmptyL -> orig+ z :< zs -> SZ (z,(empty, zs `mappend` (x <| x2s))) ++goLast :: SeqZipper a -> SeqZipper a +goLast orig@(SZ (x,(x1s,x2s))) = + case viewr x2s of + EmptyR -> orig+ zs :> z -> SZ (z,((x1s |> x) `mappend` zs , empty))+ +++current :: SeqZipper a -> a +current (SZ (x,(_,_))) = x++prev :: SeqZipper a -> Maybe a +prev = fmap current . moveLeft++next :: SeqZipper a -> Maybe a +next = fmap current . moveRight++replace :: a -> SeqZipper a -> SeqZipper a +replace y (SZ (x,zs)) = SZ (y,zs)+++deleteCurrent :: SeqZipper a -> Maybe (SeqZipper a)+deleteCurrent orig@(SZ (_,(xs,ys))) = + case viewl ys of + EmptyL -> case viewr xs of + EmptyR -> Nothing + zs :> z -> Just (SZ (z,(zs,ys)))+ z :< zs -> Just (SZ (z,(xs,zs)))+++data ZipperSelect a = NoSelect { allelems :: [a] } + | Select { zipper :: (Maybe :. SeqZipper) a }+++deriving instance Functor ZipperSelect ++selectFirst :: ZipperSelect a -> ZipperSelect a +selectFirst (NoSelect []) = NoSelect []+selectFirst (NoSelect lst@(x:xs)) = Select . gFromList $ lst+selectFirst (Select (O Nothing)) = NoSelect []+selectFirst (Select (O msz)) = Select . O $ return . goFirst =<< msz++instance GListable (Maybe :. SeqZipper) where+ gFromList [] = O Nothing + gFromList (x:xs) = O (Just (SZ (x, (empty,fromList xs))))+ gToList (O Nothing) = [] + gToList (O (Just (SZ (x,(xs,ys))))) = toList xs ++ (x : toList ys)++instance GListable ZipperSelect where+ gFromList xs = NoSelect xs+ gToList (NoSelect xs) = xs + gToList (Select xs) = gToList xs+++deriving instance Foldable ZipperSelect++deriving instance Traversable ZipperSelect++--- ++-- data HeteroSeqZipper a b = HSZ { unHSZ :: (b, (Seq a, Seq a)) } +
xournal-types.cabal view
@@ -1,5 +1,5 @@ Name: xournal-types-Version: 0.2+Version: 0.3 Synopsis: Data types for programs for xournal file format Description: Xournal file format data type including generic interface License: BSD3@@ -17,14 +17,15 @@ Library hs-source-dirs: src- ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-options: -Wall -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.*+ fclabels == 1.0.*, + TypeCompose == 0.9.* Exposed-Modules: Data.Xournal.Generic Data.Xournal.Simple@@ -32,6 +33,7 @@ Data.Xournal.Map Data.Xournal.Buffer Data.Xournal.Predefined + Data.Xournal.Select Other-Modules: