111 lines
3.2 KiB
Haskell
111 lines
3.2 KiB
Haskell
--{-# LANGUAGE TemplateHaskell #-}
|
|
--{-# LANGUAGE Strict #-}
|
|
module Picture.Data
|
|
where
|
|
import Geometry.Data
|
|
|
|
import Data.Foldable
|
|
--import qualified Data.List as L
|
|
--import Data.Monoid
|
|
--import Data.Traversable
|
|
--import qualified Data.Foldable as F
|
|
--import qualified Data.Sequence as Se
|
|
--import qualified Data.DList as DL
|
|
--import qualified Data.Vector as V
|
|
--import Control.Lens
|
|
--import Control.Monad
|
|
|
|
data RenderType
|
|
= RenderPoly [(Point3,Point4)]
|
|
| RenderPolyZ [(Point3,Point4,Float)]
|
|
| RenderBezQ [(Point3,Point4,Point4)]
|
|
| RenderText [(Point3,Point4,Point2)]
|
|
| RenderArc [(Point3,Point4,Point3)]
|
|
| RenderLine [(Point3,Point4)]
|
|
| RenderEllipse [(Point3,Point4)]
|
|
| Render3 [Point3]
|
|
| RenderConst
|
|
| Render1111 {_unRender1111 :: (Float,Float,Float,Float)}
|
|
| Render22 {_unRender22 :: (Point2,Point2)}
|
|
| Render2221 {_unRender2221 :: (Point2,Point2,Point2,Float)}
|
|
| Render22x4 {_unRender22x4 :: ((Point2,Point2),Point4)}
|
|
| Render3x2 {_unRender3x2 :: (Point3,Point2)}
|
|
| Render3x3 {_unRender3x3 :: (Point3,Point3)}
|
|
|
|
type RGBA = (Float,Float,Float,Float)
|
|
type Color = (Float,Float,Float,Float)
|
|
|
|
data FTree a
|
|
= FBranch (a -> a) (FTree a)
|
|
| FBranches [FTree a]
|
|
| FLeaf a
|
|
|
|
instance Foldable FTree where
|
|
foldMap g (FBranch f t) = foldMap (g . f) t
|
|
foldMap g (FBranches ts) = mconcat $ map (foldMap g) ts
|
|
foldMap g (FLeaf x) = g x
|
|
{-# INLINE foldMap #-}
|
|
|
|
{- Tree with values at and only at the leaves. -}
|
|
data LTree a
|
|
= LBranches [LTree a]
|
|
| LLeaf !a
|
|
instance Foldable LTree where
|
|
foldMap g (LBranches ts) = mconcat $ map (foldMap g) ts
|
|
foldMap g (LLeaf a) = g a
|
|
{-# INLINE foldMap #-}
|
|
foldr _ x (LBranches []) = x
|
|
foldr g x (LBranches (t:ts)) = foldr g (foldr g x t) (LBranches ts)
|
|
--foldr g x (LBranches (t:ts)) = foldr g (foldr g x (LBranches ts)) t
|
|
foldr g x (LLeaf y) = g y x
|
|
{-# INLINE foldr #-}
|
|
foldl' _ x (LBranches []) = x
|
|
foldl' g x (LBranches (t:ts)) = foldl' g x t `seq` foldl' g (foldl' g x t) (LBranches ts)
|
|
foldl' g x (LLeaf y) = g x y
|
|
{-# INLINE foldl' #-}
|
|
instance Functor LTree where
|
|
fmap f (LBranches ts) = LBranches $ fmap (fmap f) ts
|
|
fmap f (LLeaf x) = LLeaf (f x)
|
|
{-# INLINE fmap #-}
|
|
|
|
data RTree a b
|
|
= RBranches a [RTree a b]
|
|
| RLeaf b
|
|
instance Foldable (RTree a) where
|
|
foldMap g (RBranches _ ts) = mconcat $ map (foldMap g) ts
|
|
foldMap g (RLeaf x) = g x
|
|
{-# INLINE foldMap #-}
|
|
instance Functor (RTree a) where
|
|
fmap f (RBranches i ts) = RBranches i $ fmap (fmap f) ts
|
|
fmap f (RLeaf x) = RLeaf (f x)
|
|
|
|
flat2 :: (a,a) -> [a]
|
|
flat2 (x,y) = [x,y]
|
|
flat3 :: (a,a,a) -> [a]
|
|
flat3 (x,y,z) = [x,y,z]
|
|
flat4 :: (a,a,a,a) -> [a]
|
|
flat4 (x,y,z,w) = [x,y,z,w]
|
|
{-# INLINE flat2 #-}
|
|
{-# INLINE flat3 #-}
|
|
{-# INLINE flat4 #-}
|
|
|
|
data Picture
|
|
= Blank
|
|
| Text String
|
|
| Polygon [Point2]
|
|
| PolygonZ [Point2] Float
|
|
| BezierQuad [(Point2,RGBA,Point2,Point2)]
|
|
| PolygonCol [(Point2,RGBA)]
|
|
| Poly3D [(Point3,RGBA)]
|
|
| Circle RGBA RGBA Float
|
|
| ThickArc Float Float Float Float
|
|
| Line [Point2]
|
|
| LineCol [(Point2,RGBA)]
|
|
| Pictures [Picture]
|
|
| OverPic (Point3 -> Point3) (Point4 -> Point4) Picture
|
|
| OnLayer Int Picture
|
|
|
|
blank :: Picture
|
|
{-# INLINE blank #-}
|
|
blank = Blank
|