reorganise
This commit is contained in:
@@ -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 = {
|
||||
|
||||
@@ -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
|
||||
9
src/Haskengl/Internal/Bindings/GLFW.hs
Normal file
9
src/Haskengl/Internal/Bindings/GLFW.hs
Normal file
@@ -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
|
||||
9
src/Haskengl/Internal/Bindings/GLUtil.hs
Normal file
9
src/Haskengl/Internal/Bindings/GLUtil.hs
Normal file
@@ -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
|
||||
9
src/Haskengl/Internal/Bindings/OpenGL.hs
Normal file
9
src/Haskengl/Internal/Bindings/OpenGL.hs
Normal file
@@ -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
|
||||
43
src/Haskengl/Internal/IO/Interrupts.hs
Normal file
43
src/Haskengl/Internal/IO/Interrupts.hs
Normal file
@@ -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
|
||||
193
src/Haskengl/Internal/IO/Shaders/Init.hs
Normal file
193
src/Haskengl/Internal/IO/Shaders/Init.hs
Normal file
@@ -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
|
||||
@@ -13,7 +13,7 @@
|
||||
--
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
module Haskengl.IO.Shaders.LoadShaders (
|
||||
module Haskengl.Internal.IO.Shaders.LoadShaders (
|
||||
ShaderSource(..), ShaderInfo(..), loadShaders
|
||||
) where
|
||||
|
||||
@@ -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
|
||||
40
src/Haskengl/Internal/IO/View.hs
Normal file
40
src/Haskengl/Internal/IO/View.hs
Normal file
@@ -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
|
||||
40
src/Haskengl/Internal/IO/Window.hs
Normal file
40
src/Haskengl/Internal/IO/Window.hs
Normal file
@@ -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)
|
||||
@@ -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))
|
||||
40
src/Haskengl/Internal/Types.hs
Normal file
40
src/Haskengl/Internal/Types.hs
Normal file
@@ -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
|
||||
}
|
||||
20
src/Haskengl/Internal/Update.hs
Normal file
20
src/Haskengl/Internal/Update.hs
Normal file
@@ -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
|
||||
@@ -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'
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user