diff --git a/package.nix b/package.nix index 3630d53..5d49ded 100644 --- a/package.nix +++ b/package.nix @@ -54,12 +54,12 @@ in ''; buildPhase = '' ghc ${ghcExeOptions} ./src/Haskengl/Main.hs -o ./Main + haddock ${haddockOptions} ''; installPhase = '' mkdir -p $out/bin cp ./Main $out/bin/haskengl - #haddock ${haddockOptions} - #cp ./docs $out/docs -r + cp ./docs $out/docs -r ''; meta = { diff --git a/src/Haskengl/IO.hs b/src/Haskengl/IO.hs deleted file mode 100644 index 89d2e5c..0000000 --- a/src/Haskengl/IO.hs +++ /dev/null @@ -1,247 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module Haskengl.IO (openWindow, shutdownWindow, view) where - --- IMPORTS -- - -import qualified Graphics.Rendering.OpenGL as GL -import Graphics.Rendering.OpenGL (($=)) -import qualified Graphics.GLUtil as GLU (readTexture, texture2DWrap) -import qualified Graphics.UI.GLFW as GLFW -import qualified Language.GLSL as GLSL -import qualified Linear as L -import Linear.V4 (V4(..)) - -import Control.Exception -import Control.Monad -import Data.Text (unpack) -import Foreign.Ptr -import Foreign.Marshal.Array -import Foreign.Storable - -import Relude - -import Haskengl.IO.Shaders.LoadShaders -import Haskengl.IO.Shaders.Shaders -import Haskengl.Types -import Haskengl.Math.Transforms - --- VIEW -- - -backgroundColor :: GL.Color4 GL.GLfloat -backgroundColor = GL.Color4 1 0 1 1 - -view :: GLFW.Window -> DisplayableObjects -> Model -> IO () -view window objects model = do - GL.clearColor $= backgroundColor - GL.clear [GL.ColorBuffer] - displayObjects objects - GLFW.swapBuffers window - GLFW.pollEvents - --- SHADER STUFF -- - -projection :: L.M44 GL.GLfloat -projection = L.perspective (45 * 3.141592653 / 180) 1 0.1 100 - -displayObjects :: DisplayableObjects -> IO (DisplayableObjects) -displayObjects [] = return [] -displayObjects ((DisplayableObject vao _ numVertices _ primitiveMode):objects) = do - GL.bindVertexArrayObject $= Just vao - GL.drawArrays primitiveMode 0 numVertices - displayObjects objects - --- INIT RENDERER -- - -bufferOffset :: Integral a => a -> Ptr b -bufferOffset integral = plusPtr nullPtr $ fromIntegral integral - -toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat] -toGLMatrix (V4 (V4 c00 c01 c02 c03) - (V4 c10 c11 c12 c13) - (V4 c20 c21 c22 c23) - (V4 c30 c31 c32 c33)) = - [ c00, c01, c02, c03 - , c10, c11, c12, c13 - , c20, c21, c22, c23 - , c30, c31, c32, c33 - ] - -verticesArray :: [GL.Vertex3 GL.GLfloat] -verticesArray = - [ GL.Vertex3 0.3 0.3 0.5 - , GL.Vertex3 (-0.3) 0.3 0 - , GL.Vertex3 0.3 (-0.3) 0 - , GL.Vertex3 (-0.3) (-0.3) (-0.5) - ] - -testArray :: [GL.Vertex3 GL.GLfloat] -testArray = - [ GL.Vertex3 1.5 1.5 0 - , GL.Vertex3 0.5 1.5 0 - , GL.Vertex3 1.5 0.5 0 - , GL.Vertex3 0.5 0.5 0 - ] - -verticesUVArray :: [GL.Vertex2 GL.GLfloat] -verticesUVArray = - [ GL.Vertex2 0 0 - , GL.Vertex2 1 0 - , GL.Vertex2 0 1 - , GL.Vertex2 1 1 - ] - -generateRGBA :: Int -> [GL.Color4 GL.GLfloat] -generateRGBA i = - take i $ cycle rgba - -rgba :: [GL.Color4 GL.GLfloat] -rgba = - [ GL.Color4 1.0 0.0 0.0 1.0 - , GL.Color4 0.0 1.0 0.0 1.0 - , GL.Color4 0.0 0.0 1.0 1.0 - ] - -sizeOfArray :: (Storable a, Num b) => [a] -> b -sizeOfArray [] = 0 -sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x - -createVBO :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.AttribLocation -> IO GL.BufferObject -createVBO array numComponents attribLocation = do - buffer <- GL.genObjectName - GL.bindBuffer GL.ArrayBuffer $= Just buffer - withArray - array - $ \ptr -> - GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw) - GL.vertexAttribPointer attribLocation $= - ( GL.ToFloat - , GL.VertexArrayDescriptor - numComponents - GL.Float - 0 - (bufferOffset 0) - ) - GL.vertexAttribArray attribLocation $= GL.Enabled - return buffer - -createDisplayableObject :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.PrimitiveMode -> IO DisplayableObject -createDisplayableObject array numComponents primitiveMode = do - vao <- GL.genObjectName - GL.bindVertexArrayObject $= Just vao - vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0 - vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 - vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 - return - (DisplayableObject - vao - (AbsoluteObject $ map (AbsolutePoint . toPoint) array) - (fromIntegral $ length array) - numComponents - primitiveMode - ) - -loadTexture :: FilePath -> IO GL.TextureObject -loadTexture f = do - Right t <- GLU.readTexture f - GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Nearest) - GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge) - return t - -initResources :: GLFW.Window -> IO DisplayableObjects -initResources window = do - -- init objects - - verticesObject <- createDisplayableObject verticesArray 3 GL.TriangleStrip - testObject <- createDisplayableObject testArray 3 GL.TriangleStrip - - putStrLn (unpack $ GLSL.generateGLSL vertShader) - putStrLn (unpack $ GLSL.generateGLSL fragShader) - - GL.activeTexture $= GL.TextureUnit 0 - let tex = "assets/flag.png" - tx <- loadTexture tex - GL.texture GL.Texture2D $= GL.Enabled - GL.textureBinding GL.Texture2D $= Just tx - - -- load shaders - program <- loadShaders - [ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader) - , ShaderInfo GL.FragmentShader (StringSource $ unpack $ GLSL.generateGLSL fragShader) - ] - - GL.currentProgram $= Just program - - GLFW.swapBuffers window - GLFW.swapBuffers window - GLFW.swapBuffers window - (w, h) <- GLFW.getFramebufferSize window - - let - perspectiveMatrix = toGLMatrix $ L.perspective (78 * 3.141592653 / 180) ((fromIntegral w) / (fromIntegral h)) 0.1 100 L.!*! L.lookAt (L.V3 0 0 (-2)) (L.V3 0 0 0) (L.V3 0 1 0) - putStrLn $ show perspectiveMatrix - - let - projectionMatrix = - [ 1, 0, 0.0, 0.0 - , 0, 1, 0.0, 0.0 - , 0, 0, 1.0, 0.3 - , 0, 0, (-0.3), 1.0] :: [GL.GLfloat] - - projection <- GL.newMatrix GL.ColumnMajor perspectiveMatrix :: IO (GL.GLmatrix GL.GLfloat) - location0 <- GL.get $ GL.uniformLocation program "projection" - GL.uniform location0 $= projection - - location1 <- GL.get $ GL.uniformLocation program "tex" - GL.uniform location1 $= (GL.TextureUnit 0) - - putStrLn $ show projection - putStrLn $ show location0 - - return [verticesObject, testObject] - --- INPUT -- - -keyPressed :: GLFW.KeyCallback -keyPressed window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window -keyPressed _ _ _ _ _ = return () - --- WINDOW -- - -openWindow :: String -> IO (GLFW.Window, DisplayableObjects) -openWindow - title - = do - GLFW.init - GLFW.defaultWindowHints - GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) - GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) - GLFW.windowHint (GLFW.WindowHint'Samples (Just 16)) - GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core) - monitor <- GLFW.getPrimaryMonitor - Just window <- GLFW.createWindow 256 256 title monitor Nothing - GLFW.makeContextCurrent (Just window) - GLFW.setWindowCloseCallback window (Just shutdownWindow) - GLFW.setWindowSizeCallback window (Just resizeWindow) - GLFW.setKeyCallback window (Just keyPressed) - objects <- initResources window - return (window, objects) - -shutdownWindow :: GLFW.WindowCloseCallback -shutdownWindow window = - do - closeWindow window - _ <- exitSuccess - return () - -resizeWindow :: GLFW.WindowSizeCallback -resizeWindow _ w h = - do - GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) - -closeWindow :: GLFW.Window -> IO () -closeWindow window = - do - GLFW.destroyWindow window - GLFW.terminate diff --git a/src/Haskengl/Internal/Bindings/GLFW.hs b/src/Haskengl/Internal/Bindings/GLFW.hs new file mode 100644 index 0000000..f8a37ad --- /dev/null +++ b/src/Haskengl/Internal/Bindings/GLFW.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.Bindings.GLFW + - Description : Reexports GLFW + -} +module Haskengl.Internal.Bindings.GLFW (module GLFW) where + +import Graphics.UI.GLFW as GLFW diff --git a/src/Haskengl/Internal/Bindings/GLUtil.hs b/src/Haskengl/Internal/Bindings/GLUtil.hs new file mode 100644 index 0000000..e32e584 --- /dev/null +++ b/src/Haskengl/Internal/Bindings/GLUtil.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.Bindings.GLUtil + - Description : Reexports OpenGL + -} +module Haskengl.Internal.Bindings.GLUtil (module GLU) where + +import Graphics.GLUtil as GLU diff --git a/src/Haskengl/Internal/Bindings/OpenGL.hs b/src/Haskengl/Internal/Bindings/OpenGL.hs new file mode 100644 index 0000000..027036f --- /dev/null +++ b/src/Haskengl/Internal/Bindings/OpenGL.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.Bindings.OpenGL + - Description : Reexports OpenGL + -} +module Haskengl.Internal.Bindings.OpenGL (module GL) where + +import Graphics.Rendering.OpenGL as GL diff --git a/src/Haskengl/Internal/IO/Interrupts.hs b/src/Haskengl/Internal/IO/Interrupts.hs new file mode 100644 index 0000000..391fd99 --- /dev/null +++ b/src/Haskengl/Internal/IO/Interrupts.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.IO.Interrupts + - Description : manages interrupts + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.Interrupts where + +import Relude + +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Bindings.OpenGL (($=)) +import qualified Haskengl.Internal.Bindings.GLFW as GLFW + +-- | handles keypresses +keyPressed :: GLFW.KeyCallback +keyPressed window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window +keyPressed _ _ _ _ _ = return () + +-- | close callback +shutdownWindow :: GLFW.WindowCloseCallback +shutdownWindow window = + do + closeWindow window + _ <- exitSuccess + return () + +-- | resize callback +resizeWindow :: GLFW.WindowSizeCallback +resizeWindow _ w h = + do + GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) + +-- | close window inentionally +closeWindow :: GLFW.Window -> IO () +closeWindow window = + do + GLFW.destroyWindow window + GLFW.terminate diff --git a/src/Haskengl/Internal/IO/Shaders/Init.hs b/src/Haskengl/Internal/IO/Shaders/Init.hs new file mode 100644 index 0000000..47c683f --- /dev/null +++ b/src/Haskengl/Internal/IO/Shaders/Init.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.IO.Shaders.Init + - Description : Initialises Shaders, Textures, ... + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.Shaders.Init where + +import Relude + +import qualified Language.GLSL as GLSL +import qualified Linear as L +import Linear.V4 (V4(..)) + +import Data.Text (unpack) + +import Foreign.Ptr +import Foreign.Marshal.Array +import Foreign.Storable + +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Bindings.OpenGL (($=)) +import qualified Haskengl.Internal.Bindings.GLFW as GLFW +import qualified Haskengl.Internal.Bindings.GLUtil as GLU +import Haskengl.Internal.IO.Shaders.LoadShaders +import Haskengl.Internal.IO.Shaders.Shaders +import Haskengl.Internal.Types +import Haskengl.Internal.Math.Classes + +-- | magic ptr stuff +bufferOffset :: Integral a => a -> Ptr b +bufferOffset integral = plusPtr nullPtr $ fromIntegral integral + +-- | should move to Haskengl.Internal.Math probably +toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat] +toGLMatrix (V4 (V4 c00 c01 c02 c03) + (V4 c10 c11 c12 c13) + (V4 c20 c21 c22 c23) + (V4 c30 c31 c32 c33)) = + [ c00, c01, c02, c03 + , c10, c11, c12, c13 + , c20, c21, c22, c23 + , c30, c31, c32, c33 + ] + +-- | random test shape with a more serious name +verticesArray :: [GL.Vertex3 GL.GLfloat] +verticesArray = + [ GL.Vertex3 0.3 0.3 0.5 + , GL.Vertex3 (-0.3) 0.3 0 + , GL.Vertex3 0.3 (-0.3) 0 + , GL.Vertex3 (-0.3) (-0.3) (-0.5) + ] + +-- | random test shape +testArray :: [GL.Vertex3 GL.GLfloat] +testArray = + [ GL.Vertex3 1.5 1.5 0 + , GL.Vertex3 0.5 1.5 0 + , GL.Vertex3 1.5 0.5 0 + , GL.Vertex3 0.5 0.5 0 + ] + +-- | uv array for a square +verticesUVArray :: [GL.Vertex2 GL.GLfloat] +verticesUVArray = + [ GL.Vertex2 0 0 + , GL.Vertex2 1 0 + , GL.Vertex2 0 1 + , GL.Vertex2 1 1 + ] + +-- | generates repeating RGB points +generateRGBA :: Int -> [GL.Color4 GL.GLfloat] +generateRGBA i = + take i + $ cycle + [ GL.Color4 1.0 0.0 0.0 1.0 + , GL.Color4 0.0 1.0 0.0 1.0 + , GL.Color4 0.0 0.0 1.0 1.0 + ] + +-- | memory size of an array +sizeOfArray :: (Storable a, Num b) => [a] -> b +sizeOfArray [] = 0 +sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x + +-- | creates a buffer from an array +createVBO :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.AttribLocation -> IO GL.BufferObject +createVBO array numComponents attribLocation = do + buffer <- GL.genObjectName + GL.bindBuffer GL.ArrayBuffer $= Just buffer + withArray + array + $ \ptr -> + GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw) + GL.vertexAttribPointer attribLocation $= + ( GL.ToFloat + , GL.VertexArrayDescriptor + numComponents + GL.Float + 0 + (bufferOffset 0) + ) + GL.vertexAttribArray attribLocation $= GL.Enabled + return buffer + +-- | turn a vector array into a DisplayableObject with a vao and the like +createDisplayableObject :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.PrimitiveMode -> IO DisplayableObject +createDisplayableObject array numComponents primitiveMode = do + vao <- GL.genObjectName + GL.bindVertexArrayObject $= Just vao + vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0 + vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB + vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 -- Texture + return + (DisplayableObject + vao + (fromIntegral $ length array) + numComponents + primitiveMode + ) + +-- | pull texture from filepath +loadTexture :: FilePath -> IO GL.TextureObject +loadTexture filepath = do + -- TODO handle Left case + Right texture <- GLU.readTexture filepath + GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') + GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge) + return texture + +-- | creates objects, shaders, etc. as appropriate +initResources :: GLFW.Window -> IO DisplayableObjects +initResources window = do + -- create objects + verticesObject <- createDisplayableObject verticesArray 3 GL.TriangleStrip + testObject <- createDisplayableObject testArray 3 GL.TriangleStrip + let objects = [verticesObject, testObject] -- return value + + -- load shader program + program <- loadShaders + [ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader) + , ShaderInfo GL.FragmentShader (StringSource $ unpack $ GLSL.generateGLSL fragShader) + ] + putTextLn "vertex shader:" + putTextLn $ GLSL.generateGLSL vertShader + putTextLn "fragment shader:" + putTextLn $ GLSL.generateGLSL fragShader + GL.currentProgram $= Just program + putTextLn "compiled shader program with success" + + -- load texture + GL.activeTexture $= GL.TextureUnit 0 + let tex = "./assets/flag.png" + tx <- loadTexture tex + GL.texture GL.Texture2D $= GL.Enabled + GL.textureBinding GL.Texture2D $= Just tx + location1 <- GL.get $ GL.uniformLocation program "tex" + GL.uniform location1 $= (GL.TextureUnit 0) + putTextLn "loaded textures successfully" + + -- load projection matrix + GLFW.swapBuffers window + GLFW.swapBuffers window + GLFW.swapBuffers window + (w, h) <- GLFW.getFramebufferSize window + putTextLn "got buffer size" + let + perspectiveMatrix = + toGLMatrix + $ L.perspective + (78 * 3.141592653 / 180) -- 78 degree FOV + ((fromIntegral w) / (fromIntegral h)) -- aspect ratio + 0.1 -- near plane + 100 -- far plane + L.!*! + L.lookAt + (L.V3 0 0 (-2)) -- camera position + (L.V3 0 0 0) -- point to look at + (L.V3 0 1 0) -- up vector + putTextLn "created perspective matrix" + projection <- GL.newMatrix GL.ColumnMajor perspectiveMatrix :: IO (GL.GLmatrix GL.GLfloat) + location0 <- GL.get $ GL.uniformLocation program "projection" + GL.uniform location0 $= projection + putTextLn "passed projection buffer" + + -- return all objects created earlier + return objects diff --git a/src/Haskengl/IO/Shaders/LoadShaders.hs b/src/Haskengl/Internal/IO/Shaders/LoadShaders.hs similarity index 98% rename from src/Haskengl/IO/Shaders/LoadShaders.hs rename to src/Haskengl/Internal/IO/Shaders/LoadShaders.hs index bb99c85..a080ee3 100644 --- a/src/Haskengl/IO/Shaders/LoadShaders.hs +++ b/src/Haskengl/Internal/IO/Shaders/LoadShaders.hs @@ -13,7 +13,7 @@ -- -------------------------------------------------------------------------------- -module Haskengl.IO.Shaders.LoadShaders ( +module Haskengl.Internal.IO.Shaders.LoadShaders ( ShaderSource(..), ShaderInfo(..), loadShaders ) where diff --git a/src/Haskengl/IO/Shaders/Shaders.hs b/src/Haskengl/Internal/IO/Shaders/Shaders.hs similarity index 68% rename from src/Haskengl/IO/Shaders/Shaders.hs rename to src/Haskengl/Internal/IO/Shaders/Shaders.hs index 5a78f05..6b05bcb 100644 --- a/src/Haskengl/IO/Shaders/Shaders.hs +++ b/src/Haskengl/Internal/IO/Shaders/Shaders.hs @@ -1,14 +1,27 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} - -module Haskengl.IO.Shaders.Shaders (fragShader, vertShader) where - --- IMPORTS -- +{- | + - Module + - Description : declarative shaders for Haskengl + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.Shaders.Shaders where import Relude import Language.GLSL +-- | fragment shader +-- inputs: +-- - vec4 float fragColorOut +-- - vec2 float uv +-- outputs: +-- - vec4 float fragColor +-- uniform: +-- - sampler2D tex fragShader :: Program fragShader = [ VersionDeclaration 450 Core @@ -20,6 +33,16 @@ fragShader = , DangerousExpression "fragColor = texture(tex, uv);" ] +-- | vert shader +-- inputs: +-- - Location 0 vec3 float vertexPosition +-- - Location 1 vec4 float vertexColor +-- - Location 2 vec2 float uvCoords +-- outputs: +-- - vec4 float fragColorout +-- - vec2 float uv +-- uniform: +-- - mat4 float projection vertShader :: Program vertShader = [ VersionDeclaration 450 Core diff --git a/src/Haskengl/Internal/IO/View.hs b/src/Haskengl/Internal/IO/View.hs new file mode 100644 index 0000000..e4bc8b7 --- /dev/null +++ b/src/Haskengl/Internal/IO/View.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.IO.View + - Description : view function for Haskengl + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.View where + +import Relude + +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Bindings.OpenGL (($=)) +import qualified Haskengl.Internal.Bindings.GLFW as GLFW + +import Haskengl.Internal.Types + +-- | default canvas color +backgroundColor :: GL.Color4 GL.GLfloat +backgroundColor = GL.Color4 1 0 1 1 + +-- | display the state to the screen +view :: GLFW.Window -> Model -> IO () +view window (Model objects) = do + GL.clearColor $= backgroundColor + GL.clear [GL.ColorBuffer] + displayObjects objects + GLFW.swapBuffers window + GLFW.pollEvents + +-- | draw an array of objects with OpenGL +displayObjects :: DisplayableObjects -> IO (DisplayableObjects) +displayObjects [] = return [] +displayObjects ((DisplayableObject vao numVertices _ primitiveMode):objects) = do + GL.bindVertexArrayObject $= Just vao + GL.drawArrays primitiveMode 0 numVertices + displayObjects objects diff --git a/src/Haskengl/Internal/IO/Window.hs b/src/Haskengl/Internal/IO/Window.hs new file mode 100644 index 0000000..6637362 --- /dev/null +++ b/src/Haskengl/Internal/IO/Window.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.IO.Window + - Description : Create, resize, and destroy window + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.IO.Window where + +import Relude + +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Bindings.OpenGL (($=)) +import qualified Haskengl.Internal.Bindings.GLFW as GLFW +import Haskengl.Internal.Types (DisplayableObjects) +import Haskengl.Internal.IO.Interrupts (keyPressed, shutdownWindow, resizeWindow) +import Haskengl.Internal.IO.Shaders.Init (initResources) + +-- | open a window with sensible presets +openWindow :: String -> IO (GLFW.Window, DisplayableObjects) +openWindow + title + = do + GLFW.init + GLFW.defaultWindowHints + GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) + GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) + GLFW.windowHint (GLFW.WindowHint'Samples (Just 16)) + GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core) + monitor <- GLFW.getPrimaryMonitor + Just window <- GLFW.createWindow 256 256 title monitor Nothing + GLFW.makeContextCurrent (Just window) + GLFW.setWindowCloseCallback window (Just shutdownWindow) + GLFW.setWindowSizeCallback window (Just resizeWindow) + GLFW.setKeyCallback window (Just keyPressed) + objects <- initResources window + return (window, objects) diff --git a/src/Haskengl/Math/Transforms.hs b/src/Haskengl/Internal/Math/Classes.hs similarity index 74% rename from src/Haskengl/Math/Transforms.hs rename to src/Haskengl/Internal/Math/Classes.hs index 03fdf11..b99f697 100644 --- a/src/Haskengl/Math/Transforms.hs +++ b/src/Haskengl/Internal/Math/Classes.hs @@ -1,20 +1,16 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} - --- | Transforms has a pile of utility functions for data type conversion -module Haskengl.Math.Transforms (addCamera, Vertex(..)) where - --- IMPORTS -- - -import qualified Graphics.Rendering.OpenGL as GL - -import Foreign.Storable +{- | + - will be removed soon + -} +module Haskengl.Internal.Math.Classes where import Relude -import Haskengl.Types +import Foreign.Storable --- classes -- +import qualified Haskengl.Internal.Bindings.OpenGL as GL +import Haskengl.Internal.Types class Vertex a where toPoint :: a -> Point @@ -47,11 +43,3 @@ instance Vertex (GL.Vertex2 GL.GLfloat) where fromPoint (Point x y 0 0) = Just $ GL.Vertex2 x y fromPoint (Point x y _ _) = Nothing fromPointLossy (Point x y _ _) = GL.Vertex2 x y - -addCamera :: Point -> Point -> Point -addCamera camera@(Point 0 0 cz 0) point@(Point x y z k) = - Point - (cz * x / (cz - z)) - (cz * y / (cz - z)) - z - (cz * k / (cz - z)) diff --git a/src/Haskengl/Internal/Types.hs b/src/Haskengl/Internal/Types.hs new file mode 100644 index 0000000..ff4a4dc --- /dev/null +++ b/src/Haskengl/Internal/Types.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.Types + - Description : All Haskengl types + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.Types where + +import Relude + +import qualified Haskengl.Internal.Bindings.OpenGL as GL + +type DisplayableObjects = [DisplayableObject] + +-- | Object to be displayed +data DisplayableObject = + DisplayableObject + GL.VertexArrayObject -- ^ VAO + GL.NumArrayIndices -- ^ The length of the array / number of vertides + GL.NumComponents -- ^ Dimensionality of the array element; 4 for vec4 + GL.PrimitiveMode -- ^ How to render the VAO + +-- | state +data Model + = Model + { objects :: DisplayableObjects + } + +-- | 4 dimensional point without w value +data Point + = Point + { x :: Float + , y :: Float + , z :: Float + , k :: Float + } diff --git a/src/Haskengl/Internal/Update.hs b/src/Haskengl/Internal/Update.hs new file mode 100644 index 0000000..452ecbb --- /dev/null +++ b/src/Haskengl/Internal/Update.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + - Module : Haskengl.Internal.Update + - Description : update function + - Copyright : Andromeda 2025 + - License : WTFPL + - Maintainer : Matrix @Andromeda:tchncs.de + - Stability : Experimental + -} +module Haskengl.Internal.Update where + +import Relude + +import Haskengl.Internal.Types + +-- | update function +update :: Model -> Model +update model@(Model objects) = + model diff --git a/src/Haskengl/Main.hs b/src/Haskengl/Main.hs index 2f43966..4aa626e 100644 --- a/src/Haskengl/Main.hs +++ b/src/Haskengl/Main.hs @@ -10,36 +10,41 @@ -} module Haskengl.Main (main) where --- IMPORTS -- - -import Graphics.UI.GLFW (Window) import Relude import Relude.Monad (forever) -import Haskengl.IO -import Haskengl.Math.Transforms -import Haskengl.Types -import Haskengl.Update +import Control.Concurrent (threadDelay) --- MAIN -- +import Haskengl.Internal.Bindings.GLFW (Window, getTime) +import Haskengl.Internal.IO.Window (openWindow) +import Haskengl.Internal.IO.View (view) +import Haskengl.Internal.Update (update) +import Haskengl.Internal.Types (Model(..), DisplayableObjects) +-- | Starts game main :: IO () main = do (window, objects) <- openWindow "window :)" - loop window objects update view model + putTextLn "initialized window" + _ <- loop window update view $ Model { objects = objects } return () -- | Elm-like 'gameloop' loop :: Window -- ^ The window to display on - -> DisplayableObjects -- ^ Objects to be displayed -> (Model -> Model) -- ^ Update function - -> (Window -> DisplayableObjects -> Model -> IO ()) -- ^ View function + -> (Window -> Model -> IO ()) -- ^ View function -> Model -- ^ Model -> IO () -loop window objects update view model = +loop window update view model = do - let model = update model - view window objects model - loop window objects update view model + Just frameStart <- getTime + let model' = update model + view window model' + Just frameEnd <- getTime + let + dt = frameEnd - frameStart :: Double + target = 1 / 60 :: Double + when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000 + loop window update view model' diff --git a/src/Haskengl/Types.hs b/src/Haskengl/Types.hs deleted file mode 100644 index 7f5bc42..0000000 --- a/src/Haskengl/Types.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -{- | Basic Types -} -module Haskengl.Types (DisplayableObject(..), DisplayableObjects(..), Model(..), model, AbsoluteObject(..), Point(..), point) where - --- IMPORTS -- - -import qualified Graphics.Rendering.OpenGL as GL - -import Relude - --- TYPES -- - --- io -- - -type DisplayableObjects = [DisplayableObject] - -data DisplayableObject = - DisplayableObject - GL.VertexArrayObject -- ^ VAO - AbsoluteObject - GL.NumArrayIndices -- ^ The length of the array / number of vertides - GL.NumComponents -- ^ Dimensionality of the array element; 4 for vec4 - GL.PrimitiveMode -- ^ How to render the VAO - --- model -- - --- | state -data Model = Model - { objects :: DisplayableObjects - } - --- absolute objects - --- | object with a defined position -data AbsoluteObject - = AbsoluteObject [AbsoluteObject] - | AbsolutePoint Point - | PinnedRelativeObject Point RelativeObject - -data Point - = Point - { x :: Float - , y :: Float - , z :: Float - , k :: Float - } - --- | straight line between 2 points -data Line - = Line Point Point - --- | triangle between 3 points -data Triangle - = Triangle Point Point Point - --- relative objects - --- | object without a defined position -data RelativeObject - = RelativeObject [RelativeObject] - | RelativeHVolume HVolume - | RelativeVolume Volume - | RelativeSurface Surface - --- | hyper volume -data HVolume - = HSphere Float - | HPrism Float Volume - -data Volume - = Sphere Float - | Prism Float Surface - -data Surface - = Circle Float - | Square Float - --- CONSTRUCTORS -- - -model :: Model -model = - Model - { objects = [] - } - --- absolutes - -point :: Point -point = - Point - { x = 0 - , y = 0 - , z = 0 - , k = 0 - } - -origin :: Point -origin = point - -line :: Line -line = Line point point - -triangle :: Triangle -triangle = Triangle point point point - --- relatives - -hSphere :: HVolume -hSphere = HSphere 1 - -hPrism :: HVolume -hPrism = HPrism 1 prism - --- Volumes - -sphere :: Volume -sphere = Sphere 1 - -prism :: Volume -prism = Prism 1 square - -circle :: Surface -circle = Circle 1 - -square :: Surface -square = Square 1 diff --git a/src/Haskengl/Update.hs b/src/Haskengl/Update.hs deleted file mode 100644 index af6e6fe..0000000 --- a/src/Haskengl/Update.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Contains update logic -module Haskengl.Update (update) where - --- IMPORTS -- - -import Relude - -import Haskengl.Types - --- UPDATE -- - -update :: Model -> Model -update model@(Model objects) = - model