module Data.Scene where

import Definitive
import Data.Vertex
import Data.Texture

type Scene t = [Widget t]
data Widget t = Shape [ShapeProp] (Shape t)
              | SubScene [Transform t] (Scene t)
              | Cached (IO ())
data Shape t = Polygon [Vertex t]
             | Quads [V4 (Vertex t)]
             | Triangles [V3 (Vertex t)]
             | TriangleStrip [Vertex t]
data Vertex t = Vertex [VertexProp t] !t !t !t
data VertexProp t = Color (V4 t)
                  | TexCoord (V2 t)
data ShapeProp = Texture Texture
data Transform t = Translate !t !t !t
                 | Rotate !t (V3 t)
                 | Zoom !t !t !t

_Vertex :: Iso ([VertexProp t],t,t,t) ([VertexProp t'],t',t',t') (Vertex t) (Vertex t')
_Vertex = iso (\(Vertex ps x y z) -> (ps,x,y,z)) (\(ps,x,y,z) -> Vertex ps x y z)

vert = Vertex []
cvert c = Vertex [c]

vProps :: Lens' (Vertex t) [VertexProp t]
vProps = _Vertex.l'1

pQuad p a b c d = V4 a b c d <&> \c@(x,y,z) -> Vertex (p c) x y z 
pSquare p (x,y) w = pQuad p (x,y,0) (x',y,0) (x',y',0) (x,y',0)
  where x' = x+w ; y' = y+w
quad = pQuad (const [])
square = pSquare (const [])

textured = liftA2 f texMap
  where texMap = V4 (txc 0 0) (txc 1 0) (txc 1 1) (txc 0 1)
        txc = map2 TexCoord V2
        f c v = v & vProps%~(c:)

cube (x,y,z) (w,h,j) = [
  quad a b c d,
  quad a b b' a',
  quad b' b c c',
  quad d' c' c d,
  quad a a' d' d,
  quad d' c' b' a'
  ]
  where x' = x+w ; y' = y+h ; z' = z+j
        [a,a',b,b',d,d',c,c'] = liftA3 (,,) [x,x'] [y,y'] [z,z']

rgb r g b = V4 r g b 1
grey g = rgb g g g
gray = grey
black = grey 0
white = grey 1

red = rgb 1 0 0
green = rgb 0 1 0
blue = rgb 0 0 1
yellow = green+red
magenta = red+blue
cyan = green+blue

zoom = (join.join) Zoom