aendert Types Einordnung, macht Transforms, faengt Triangles an
This commit is contained in:
49
src/IO.hs
49
src/IO.hs
@@ -1,7 +1,7 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module IO (Descriptor, openWindow, shutdownWindow, view) where
|
module IO (openWindow, shutdownWindow, view) where
|
||||||
|
|
||||||
-- IMPORTS --
|
-- IMPORTS --
|
||||||
|
|
||||||
@@ -17,29 +17,29 @@ import Foreign.Storable
|
|||||||
|
|
||||||
import LoadShaders
|
import LoadShaders
|
||||||
import Relude
|
import Relude
|
||||||
import Model
|
import Types
|
||||||
|
|
||||||
-- VIEW --
|
-- VIEW --
|
||||||
|
|
||||||
backgroundColor :: GL.Color4 GL.GLfloat
|
backgroundColor :: GL.Color4 GL.GLfloat
|
||||||
backgroundColor = GL.Color4 0 0 0 1
|
backgroundColor = GL.Color4 0 0 0 1
|
||||||
|
|
||||||
view :: GLFW.Window -> Descriptor -> Model -> IO ()
|
view :: GLFW.Window -> DisplayableObjects -> Model -> IO ()
|
||||||
view window descriptor@(Descriptor vertices firstIndex numVertices) model = do
|
view window objects model = do
|
||||||
GL.clearColor $= backgroundColor
|
GL.clearColor $= backgroundColor
|
||||||
GL.clear [GL.ColorBuffer]
|
GL.clear [GL.ColorBuffer]
|
||||||
GL.bindVertexArrayObject $= Just vertices
|
displayObjects window objects
|
||||||
GL.drawArrays GL.TriangleStrip firstIndex numVertices
|
|
||||||
GLFW.swapBuffers window
|
GLFW.swapBuffers window
|
||||||
GLFW.pollEvents
|
GLFW.pollEvents
|
||||||
|
|
||||||
-- SHADER STUFF --
|
-- SHADER STUFF --
|
||||||
|
|
||||||
data Descriptor =
|
displayObjects :: GLFW.Window -> DisplayableObjects -> IO (DisplayableObjects)
|
||||||
Descriptor
|
displayObjects _ [] = return []
|
||||||
GL.VertexArrayObject
|
displayObjects window ((DisplayableObject vertices firstIndex numVertices _ _ primitiveMode):objects) = do
|
||||||
GL.ArrayIndex
|
GL.bindVertexArrayObject $= Just vertices
|
||||||
GL.NumArrayIndices
|
GL.drawArrays primitiveMode firstIndex numVertices
|
||||||
|
displayObjects window objects
|
||||||
|
|
||||||
-- INIT RENDERER --
|
-- INIT RENDERER --
|
||||||
|
|
||||||
@@ -72,8 +72,8 @@ sizeOfArray [] = 0
|
|||||||
sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x
|
sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x
|
||||||
|
|
||||||
makeBuffer :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.GLuint -> IO ()
|
makeBuffer :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.GLuint -> IO ()
|
||||||
makeBuffer array numComponents i = do
|
makeBuffer array numComponents attributeLocation = do
|
||||||
let vPosition = GL.AttribLocation i
|
let vPosition = GL.AttribLocation attributeLocation
|
||||||
buffer <- GL.genObjectName
|
buffer <- GL.genObjectName
|
||||||
GL.bindBuffer GL.ArrayBuffer $= Just buffer
|
GL.bindBuffer GL.ArrayBuffer $= Just buffer
|
||||||
withArray array $ \ptr ->
|
withArray array $ \ptr ->
|
||||||
@@ -81,18 +81,19 @@ makeBuffer array numComponents i = do
|
|||||||
GL.vertexAttribPointer vPosition $=
|
GL.vertexAttribPointer vPosition $=
|
||||||
(GL.ToFloat, GL.VertexArrayDescriptor numComponents GL.Float 0 (bufferOffset 0))
|
(GL.ToFloat, GL.VertexArrayDescriptor numComponents GL.Float 0 (bufferOffset 0))
|
||||||
GL.vertexAttribArray vPosition $= GL.Enabled
|
GL.vertexAttribArray vPosition $= GL.Enabled
|
||||||
|
|
||||||
|
|
||||||
initResources :: IO Descriptor
|
initResources :: IO DisplayableObject
|
||||||
initResources = do
|
initResources = do
|
||||||
-- vertices array
|
-- vertices array
|
||||||
verticesGLArray <- GL.genObjectName
|
verticesGLArray <- GL.genObjectName
|
||||||
GL.bindVertexArrayObject $= Just verticesGLArray
|
GL.bindVertexArrayObject $= Just verticesGLArray
|
||||||
let verticesDescriptor = Descriptor
|
let verticesObject = DisplayableObject
|
||||||
verticesGLArray
|
verticesGLArray
|
||||||
0
|
0
|
||||||
$ fromIntegral
|
(fromIntegral $ length verticesArray)
|
||||||
$ length verticesArray
|
2
|
||||||
|
(GL.AttribLocation 0)
|
||||||
|
GL.TriangleStrip
|
||||||
|
|
||||||
makeBuffer verticesArray 2 0
|
makeBuffer verticesArray 2 0
|
||||||
makeBuffer (generateRGBA $ length verticesArray) 4 1
|
makeBuffer (generateRGBA $ length verticesArray) 4 1
|
||||||
@@ -105,7 +106,7 @@ initResources = do
|
|||||||
GL.currentProgram $= Just program
|
GL.currentProgram $= Just program
|
||||||
|
|
||||||
-- return descriptor for vertices array
|
-- return descriptor for vertices array
|
||||||
return verticesDescriptor
|
return verticesObject
|
||||||
|
|
||||||
-- INPUT --
|
-- INPUT --
|
||||||
|
|
||||||
@@ -115,7 +116,7 @@ keyPressed _ _ _ _ _ = return ()
|
|||||||
|
|
||||||
-- WINDOW --
|
-- WINDOW --
|
||||||
|
|
||||||
openWindow :: String -> IO (GLFW.Window, Descriptor)
|
openWindow :: String -> IO (GLFW.Window, DisplayableObjects)
|
||||||
openWindow
|
openWindow
|
||||||
title
|
title
|
||||||
= do
|
= do
|
||||||
@@ -133,8 +134,8 @@ openWindow
|
|||||||
GLFW.setWindowCloseCallback window (Just shutdownWindow)
|
GLFW.setWindowCloseCallback window (Just shutdownWindow)
|
||||||
GLFW.setWindowSizeCallback window (Just resizeWindow)
|
GLFW.setWindowSizeCallback window (Just resizeWindow)
|
||||||
GLFW.setKeyCallback window (Just keyPressed)
|
GLFW.setKeyCallback window (Just keyPressed)
|
||||||
descriptor <- initResources
|
object <- initResources
|
||||||
return (window, descriptor)
|
return (window, [object])
|
||||||
|
|
||||||
shutdownWindow :: GLFW.WindowCloseCallback
|
shutdownWindow :: GLFW.WindowCloseCallback
|
||||||
shutdownWindow window =
|
shutdownWindow window =
|
||||||
|
|||||||
22
src/Main.hs
22
src/Main.hs
@@ -6,29 +6,31 @@ module Main (main) where
|
|||||||
-- IMPORTS --
|
-- IMPORTS --
|
||||||
|
|
||||||
import Graphics.UI.GLFW (Window)
|
import Graphics.UI.GLFW (Window)
|
||||||
import IO (Descriptor, openWindow, view)
|
|
||||||
import Model (Model, model)
|
|
||||||
import Relude
|
import Relude
|
||||||
import Relude.Monad (forever)
|
import Relude.Monad (forever)
|
||||||
import Update (update)
|
|
||||||
|
import IO
|
||||||
|
import Transforms
|
||||||
|
import Types
|
||||||
|
import Update
|
||||||
|
|
||||||
-- MAIN --
|
-- MAIN --
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
do
|
do
|
||||||
(window, descriptor) <- openWindow "window :)"
|
(window, objects) <- openWindow "window :)"
|
||||||
_ <- loop window descriptor update view model
|
_ <- loop window objects update view model
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
loop
|
loop
|
||||||
:: Window
|
:: Window
|
||||||
-> Descriptor
|
-> DisplayableObjects
|
||||||
-> (Model -> Model)
|
-> (Model -> Model)
|
||||||
-> (Window -> Descriptor -> Model -> IO ())
|
-> (Window -> DisplayableObjects -> Model -> IO ())
|
||||||
-> Model -> IO Model
|
-> Model -> IO Model
|
||||||
loop window descriptor update view model =
|
loop window objects update view model =
|
||||||
do
|
do
|
||||||
let model = update model
|
let model = update model
|
||||||
view window descriptor model
|
view window objects model
|
||||||
loop window descriptor update view model
|
loop window objects update view model
|
||||||
|
|||||||
30
src/Transforms.hs
Normal file
30
src/Transforms.hs
Normal file
@@ -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
|
||||||
@@ -1,14 +1,31 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Model (Model, model) where
|
module Types (DisplayableObject(..), DisplayableObjects(..), Model, model, Triangle(..), triangle, Point(..), point) where
|
||||||
|
|
||||||
-- IMPORTS --
|
-- IMPORTS --
|
||||||
|
|
||||||
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import Relude
|
import Relude
|
||||||
|
|
||||||
-- TYPES --
|
-- TYPES --
|
||||||
|
|
||||||
|
-- io --
|
||||||
|
|
||||||
|
type DisplayableObjects = [DisplayableObject]
|
||||||
|
|
||||||
|
data DisplayableObject =
|
||||||
|
DisplayableObject
|
||||||
|
GL.VertexArrayObject
|
||||||
|
GL.ArrayIndex
|
||||||
|
GL.NumArrayIndices
|
||||||
|
GL.NumComponents
|
||||||
|
GL.AttribLocation
|
||||||
|
GL.PrimitiveMode
|
||||||
|
|
||||||
|
-- model --
|
||||||
|
|
||||||
data Model = Model
|
data Model = Model
|
||||||
{ counter :: Integer
|
{ counter :: Integer
|
||||||
}
|
}
|
||||||
@@ -5,9 +5,10 @@ module Update (update) where
|
|||||||
|
|
||||||
-- IMPORTS --
|
-- IMPORTS --
|
||||||
|
|
||||||
import Model
|
|
||||||
import Relude
|
import Relude
|
||||||
|
|
||||||
|
import Types
|
||||||
|
|
||||||
-- UPDATE --
|
-- UPDATE --
|
||||||
|
|
||||||
update :: Model -> Model
|
update :: Model -> Model
|
||||||
|
|||||||
Reference in New Issue
Block a user