87 lines
2.2 KiB
Haskell
87 lines
2.2 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
--{-# LANGUAGE Strict #-}
|
|
module Picture.Data
|
|
where
|
|
import Data.Monoid
|
|
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 Geometry.Data
|
|
|
|
import Control.Lens
|
|
|
|
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 #-}
|
|
|
|
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 #-}
|
|
instance Functor LTree where
|
|
fmap f (LBranches ts) = LBranches $ (fmap (fmap f)) ts
|
|
fmap f (LLeaf x) = LLeaf (f x)
|
|
|
|
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 (x,y) = [x,y]
|
|
flat3 (x,y,z) = [x,y,z]
|
|
flat4 (x,y,z,w) = [x,y,z,w]
|
|
{-# INLINE flat2 #-}
|
|
{-# INLINE flat3 #-}
|
|
{-# INLINE flat4 #-}
|
|
|
|
data RenderType
|
|
= RenderPoly [(Point3,Point4)]
|
|
| RenderText [(Point3,Point4,Point2)]
|
|
| RenderCirc (Point3,Point4,Float)
|
|
| RenderArc (Point3,Point4,Point4)
|
|
| RenderLine [(Point3,Point4)]
|
|
| RenderBlank
|
|
|
|
data Picture
|
|
= Blank
|
|
| Text Int String
|
|
| Polygon Int [Point2]
|
|
| PolygonCol Int [(Point2,RGBA)]
|
|
| Circle Int Float
|
|
| ThickArc Int Float Float Float Float
|
|
| Line Int [Point2]
|
|
| Scale Float Float Picture
|
|
| Translate Float Float Picture
|
|
| Rotate Float Picture
|
|
| SetDepth Float Picture
|
|
| Color RGBA Picture
|
|
| Pictures [Picture]
|
|
| OverPic (Point3 -> Point3) (Float -> Float) (Point4 -> Point4) Picture
|
|
| OnLayer Int Picture
|
|
|
|
|
|
blank :: Picture
|
|
{-# INLINE blank #-}
|
|
blank = Blank
|