aendert Types Einordnung, macht Transforms, faengt Triangles an

src/IO.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module IO (Descriptor, openWindow, shutdownWindow, view) where
+module IO (openWindow, shutdownWindow, view) where
 
 -- IMPORTS --
 
@@ -17,29 +17,29 @@ import Foreign.Storable
 
 import LoadShaders
 import Relude
-import Model
+import Types
 
 -- VIEW --
 
 backgroundColor :: GL.Color4 GL.GLfloat
 backgroundColor = GL.Color4 0 0 0 1
 
-view :: GLFW.Window -> Descriptor -> Model -> IO ()
-view window descriptor@(Descriptor vertices firstIndex numVertices) model = do
+view :: GLFW.Window -> DisplayableObjects -> Model -> IO ()
+view window objects model = do
   GL.clearColor $= backgroundColor
   GL.clear [GL.ColorBuffer]
-  GL.bindVertexArrayObject $= Just vertices
-  GL.drawArrays GL.TriangleStrip firstIndex numVertices
+  displayObjects window objects
   GLFW.swapBuffers window
   GLFW.pollEvents
 
 -- SHADER STUFF --
 
-data Descriptor =
-  Descriptor
-    GL.VertexArrayObject
-    GL.ArrayIndex
-    GL.NumArrayIndices
+displayObjects :: GLFW.Window -> DisplayableObjects -> IO (DisplayableObjects)
+displayObjects _ [] = return []
+displayObjects window ((DisplayableObject vertices firstIndex numVertices _ _ primitiveMode):objects) = do
+  GL.bindVertexArrayObject $= Just vertices
+  GL.drawArrays primitiveMode firstIndex numVertices
+  displayObjects window objects
 
 -- INIT RENDERER --
 
@@ -72,8 +72,8 @@ sizeOfArray [] = 0
 sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x
 
 makeBuffer :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.GLuint -> IO ()
-makeBuffer array numComponents i = do
-  let vPosition = GL.AttribLocation i
+makeBuffer array numComponents attributeLocation = do
+  let vPosition = GL.AttribLocation attributeLocation
   buffer <- GL.genObjectName
   GL.bindBuffer GL.ArrayBuffer $= Just buffer
   withArray array $ \ptr ->
@@ -82,17 +82,18 @@ makeBuffer array numComponents i = do
     (GL.ToFloat, GL.VertexArrayDescriptor numComponents GL.Float 0 (bufferOffset 0))
   GL.vertexAttribArray vPosition $= GL.Enabled
 
-
-initResources :: IO Descriptor
+initResources :: IO DisplayableObject
 initResources = do
   -- vertices array
   verticesGLArray <- GL.genObjectName
   GL.bindVertexArrayObject $= Just verticesGLArray
-  let verticesDescriptor = Descriptor
-                             verticesGLArray
-                             0
-                             $ fromIntegral
-                               $ length verticesArray
+  let verticesObject = DisplayableObject
+                         verticesGLArray
+                         0
+                         (fromIntegral $ length verticesArray)
+                         2
+                         (GL.AttribLocation 0)
+                         GL.TriangleStrip
 
   makeBuffer verticesArray 2 0
   makeBuffer (generateRGBA $ length verticesArray) 4 1
@@ -105,7 +106,7 @@ initResources = do
   GL.currentProgram $= Just program
 
   -- return descriptor for vertices array
-  return verticesDescriptor
+  return verticesObject
 
 -- INPUT --
 
@@ -115,7 +116,7 @@ keyPressed _ _ _ _ _ = return ()
 
 -- WINDOW --
 
-openWindow :: String -> IO (GLFW.Window, Descriptor)
+openWindow :: String -> IO (GLFW.Window, DisplayableObjects)
 openWindow
   title
   = do
@@ -133,8 +134,8 @@ openWindow
     GLFW.setWindowCloseCallback window (Just shutdownWindow)
     GLFW.setWindowSizeCallback window (Just resizeWindow)
     GLFW.setKeyCallback window (Just keyPressed)
-    descriptor <- initResources
-    return (window, descriptor)
+    object <- initResources
+    return (window, [object])
 
 shutdownWindow :: GLFW.WindowCloseCallback
 shutdownWindow window =

src/Main.hs

@@ -6,29 +6,31 @@ module Main (main) where
 -- IMPORTS --
 
 import Graphics.UI.GLFW (Window)
-import IO (Descriptor, openWindow, view)
-import Model (Model, model)
 import Relude
 import Relude.Monad (forever)
-import Update (update)
+
+import IO
+import Transforms
+import Types
+import Update
 
 -- MAIN --
 
 main :: IO ()
 main =
   do
-    (window, descriptor) <- openWindow "window :)"
-    _ <- loop window descriptor update view model
+    (window, objects) <- openWindow "window :)"
+    _ <- loop window objects update view model
     return ()
 
 loop
   :: Window
-  -> Descriptor
+  -> DisplayableObjects
   -> (Model -> Model)
-  -> (Window -> Descriptor -> Model -> IO ())
+  -> (Window -> DisplayableObjects -> Model -> IO ())
   -> Model -> IO Model
-loop window descriptor update view model =
+loop window objects update view model =
   do
     let model = update model
-    view window descriptor model
-    loop window descriptor update view model
+    view window objects model
+    loop window objects update view model

src/Transforms.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Transforms (displayableObjectFromTriangles) where
+
+-- IMPORTS --
+
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=))
+
+import Relude
+
+import IO
+import Types
+
+displayableObjectFromTriangles :: [Triangle] -> GL.GLuint -> IO DisplayableObject
+displayableObjectFromTriangles triangles attribLocation = do
+  let array = [ pointToVertex p | (Triangle a b c) <- triangles, p <- [a, b, c] ]
+  glArray <- GL.genObjectName
+  GL.bindVertexArrayObject $= Just glArray
+  return $ DisplayableObject
+             glArray
+             0
+             (fromIntegral $ length array)
+             4
+             (GL.AttribLocation attribLocation)
+             GL.Triangles
+
+pointToVertex :: Point -> GL.Vertex4 GL.GLfloat
+pointToVertex (Point x y z k) = GL.Vertex4 x y z k

src/Types.hs

@@ -1,14 +1,31 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Model (Model, model) where
+module Types (DisplayableObject(..), DisplayableObjects(..), Model, model, Triangle(..), triangle, Point(..), point) where
 
 -- IMPORTS --
 
+import qualified Graphics.Rendering.OpenGL as GL
+
 import Relude
 
 -- TYPES --
 
+-- io --
+
+type DisplayableObjects = [DisplayableObject]
+
+data DisplayableObject =
+  DisplayableObject
+    GL.VertexArrayObject
+    GL.ArrayIndex
+    GL.NumArrayIndices
+    GL.NumComponents
+    GL.AttribLocation
+    GL.PrimitiveMode
+
+-- model --
+
 data Model = Model
                { counter :: Integer
                }

src/Update.hs

@@ -5,9 +5,10 @@ module Update (update) where
 
 -- IMPORTS --
 
-import Model
 import Relude
 
+import Types
+
 -- UPDATE --
 
 update :: Model -> Model