{-# 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