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