Idea for making 3D objects

RotatingCube.elm

import Graphics.WebGL as GL
import Math.Vector3 as GL
import Math.Matrix4 as GL

type Point = {
  x : Float,
  y : Float,
  z : Float
}

(<+>) p q = Point (p.x + q.x) (p.y + q.y) (p.z + q.z)
(<->) p q = Point (p.x - q.x) (p.y - q.y) (p.z - q.z)

data Triangle = Triangle Point Point Point

data Rectangle = Rectangle Triangle Triangle
  
data Top = Top Rectangle
data Bottom = Bottom Rectangle
data Front = Front Rectangle
data Back = Back Rectangle
data Left = Left Rectangle 
data Right = Right Rectangle

data Cube = Cube Top Bottom Front Back Left Right



cube : Point -> Float -> Cube
cube center size = 
  let hs = size / 2
      ftl = center <+> Point (-hs) (hs)  (-hs)
      ftr = center <+> Point (hs)  (hs)  (-hs)
      fbr = center <+> Point (hs)  (-hs) (-hs)
      fbl = center <+> Point (-hs) (-hs) (-hs)
      btl = center <+> Point (-hs) (hs)  (hs)
      btr = center <+> Point (hs)  (hs)  (hs)
      bbr = center <+> Point (hs)  (-hs) (hs)
      bbl = center <+> Point (-hs) (-hs) (hs)
      topf = Rectangle (Triangle ftl ftr btr) (Triangle btr btl ftl)
      botf = Rectangle (Triangle fbl fbr bbr) (Triangle bbr bbl fbl)
      frof = Rectangle (Triangle ftl fbl fbr) (Triangle fbr ftr ftl)
      bacf = Rectangle (Triangle btr btl bbl) (Triangle bbl bbr btr)
      leff = Rectangle (Triangle btl bbl fbl) (Triangle fbl ftl btl)
      rigf = Rectangle (Triangle btr bbr fbr) (Triangle fbr ftr btr)
  in Cube (Top topf) (Bottom botf) (Front frof) (Back bacf) (Left leff) (Right rigf)
  

scene : [GL.Entity] -> Element
scene = GL.webgl (400,400)
  

type Attribute = {
  position : GL.Vec3
}

type Varying = {
  vColor : GL.Vec3
}

type Uniform = {
  matrix : GL.Mat4
}


triangleToMesh : Triangle -> [GL.Triangle Attribute]
triangleToMesh (Triangle p q r) = 
  [({ position = GL.vec3 p.x p.y p.z },
    { position = GL.vec3 q.x q.y q.z },
    { position = GL.vec3 r.x r.y r.z })]
    

rectangleToMesh : Rectangle -> [GL.Triangle Attribute]
rectangleToMesh (Rectangle a b) =
  triangleToMesh a ++ triangleToMesh b
  

cubeToMesh : Cube -> [GL.Triangle Attribute]
cubeToMesh (Cube (Top topFace) (Bottom bottomFace) (Front frontFace) (Back backFace) (Left leftFace) (Right rightFace)) =
  concatMap rectangleToMesh [topFace, bottomFace, frontFace, backFace, leftFace, rightFace]
  
  
drawMesh : Float -> [GL.Triangle Attribute] -> GL.Entity
drawMesh t mesh = GL.entity vertexShader fragmentShader mesh { matrix = GL.makeRotate t (GL.vec3 -1 1 1)} 

drawTriangle : Float -> Triangle -> GL.Entity
drawTriangle t = drawMesh t << triangleToMesh

drawRectangle : Float -> Rectangle -> GL.Entity
drawRectangle t = drawMesh t << rectangleToMesh

drawCube : Float -> Cube -> GL.Entity
drawCube t = drawMesh t << cubeToMesh



vertexShader : GL.Shader Attribute Uniform Varying
vertexShader = [glsl| 
  
attribute vec3 position;
uniform mat4 matrix;
varying vec3 vColor;
 

vec3 getColor (vec3 pos){
  return normalize(vec3(1.0,1.0,1.0) - pos);
}
  
void main () {

  gl_Position = matrix * vec4(position, 1.0);
  vColor = getColor(position);

}
  
|]


fragmentShader : GL.Shader {} Uniform Varying
fragmentShader = [glsl| 

precision mediump float;
varying vec3 vColor;

void main (){

  gl_FragColor = vec4(vColor,1.0);

}

|]

testCube = cube (Point 0 0 0) 1

render : Float -> Element
render t = scene [drawCube t testCube]


angle = (*) 0.001 <~ foldp (+) 0 (fps 60)
main = render <~ angle


{- cube (Point 0 0 0) 1

Cube 
  (Top 
    (Rectangle 
      (Triangle 
        { x = -0.5, y = 0.5 , z = -0.5 } 
        { x = 0.5 , y = 0.5 , z = -0.5 } 
        { x = 0.5 , y = 0.5 , z = 0.5  }
      ) 
      (Triangle 
        { x = 0.5 , y = 0.5 , z = 0.5  } 
        { x = -0.5, y = 0.5 , z = 0.5  } 
        { x = -0.5, y = 0.5 , z = -0.5 }
      )
    )
  ) 
  (Bottom 
    (Rectangle 
      (Triangle 
        { x = -0.5, y = -0.5, z = -0.5 } 
        { x = 0.5 , y = -0.5, z = -0.5 } 
        { x = 0.5 , y = -0.5, z = 0.5  }
      ) 
      (Triangle 
        { x = 0.5 , y = -0.5, z = 0.5  } 
        { x = -0.5, y = -0.5, z = 0.5  } 
        { x = -0.5, y = -0.5, z = -0.5 }
      )
    )
  ) 
  (Front 
    (Rectangle 
      (Triangle 
        { x = -0.5, y = 0.5 , z = -0.5 } 
        { x = -0.5, y = -0.5, z = -0.5 } 
        { x = 0.5 , y = -0.5, z = -0.5 }
      ) 
      (Triangle 
        { x = 0.5 , y = -0.5, z = -0.5 } 
        { x = 0.5 , y = 0.5 , z = -0.5 } 
        { x = -0.5, y = 0.5 , z = -0.5 }
      )
    )
  ) 
  (Back 
    (Rectangle 
      (Triangle 
        { x = 0.5 , y = 0.5 , z = 0.5  } 
        { x = -0.5, y = 0.5 , z = 0.5  } 
        { x = -0.5, y = -0.5, z = 0.5  }
      ) 
      (Triangle 
        { x = -0.5, y = -0.5, z = 0.5  } 
        { x = 0.5 , y = -0.5, z = 0.5  } 
        { x = 0.5 , y = 0.5 , z = 0.5  }
      )
    )
  ) 
  (Left 
    (Rectangle 
      (Triangle 
        { x = -0.5, y = 0.5 , z = 0.5  } 
        { x = -0.5, y = -0.5, z = 0.5  } 
        { x = -0.5, y = -0.5, z = -0.5 }
      ) 
      (Triangle 
        { x = -0.5, y = -0.5, z = -0.5 } 
        { x = -0.5, y = 0.5 , z = -0.5 } 
        { x = -0.5, y = 0.5 , z = 0.5  }
      )
    )
  ) 
  (Right 
    (Rectangle 
      (Triangle 
        { x = 0.5 , y = 0.5 , z = 0.5  } 
        { x = 0.5 , y = -0.5, z = 0.5  } 
        { x = 0.5 , y = -0.5, z = -0.5 }
      ) 
      (Triangle 
        { x = 0.5 , y = -0.5, z = -0.5 } 
        { x = 0.5 , y = 0.5 , z = -0.5 } 
        { x = 0.5 , y = 0.5 , z = 0.5  }
      )
    )
  )

-}