reorganise

This commit is contained in:
mtgmonkey
2025-12-03 00:08:55 +01:00
parent e8b088312c
commit bc23ab1df2
17 changed files with 460 additions and 433 deletions

View File

@@ -54,12 +54,12 @@ in
''; '';
buildPhase = '' buildPhase = ''
ghc ${ghcExeOptions} ./src/Haskengl/Main.hs -o ./Main ghc ${ghcExeOptions} ./src/Haskengl/Main.hs -o ./Main
haddock ${haddockOptions}
''; '';
installPhase = '' installPhase = ''
mkdir -p $out/bin mkdir -p $out/bin
cp ./Main $out/bin/haskengl cp ./Main $out/bin/haskengl
#haddock ${haddockOptions} cp ./docs $out/docs -r
#cp ./docs $out/docs -r
''; '';
meta = { meta = {

View File

@@ -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

View 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

View 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

View 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

View 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

View 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

View File

@@ -13,7 +13,7 @@
-- --
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
module Haskengl.IO.Shaders.LoadShaders ( module Haskengl.Internal.IO.Shaders.LoadShaders (
ShaderSource(..), ShaderInfo(..), loadShaders ShaderSource(..), ShaderInfo(..), loadShaders
) where ) where

View File

@@ -1,14 +1,27 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{- |
module Haskengl.IO.Shaders.Shaders (fragShader, vertShader) where - Module
- Description : declarative shaders for Haskengl
-- IMPORTS -- - Copyright : Andromeda 2025
- License : WTFPL
- Maintainer : Matrix @Andromeda:tchncs.de
- Stability : Experimental
-}
module Haskengl.Internal.IO.Shaders.Shaders where
import Relude import Relude
import Language.GLSL import Language.GLSL
-- | fragment shader
-- inputs:
-- - vec4 float fragColorOut
-- - vec2 float uv
-- outputs:
-- - vec4 float fragColor
-- uniform:
-- - sampler2D tex
fragShader :: Program fragShader :: Program
fragShader = fragShader =
[ VersionDeclaration 450 Core [ VersionDeclaration 450 Core
@@ -20,6 +33,16 @@ fragShader =
, DangerousExpression "fragColor = texture(tex, uv);" , 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 :: Program
vertShader = vertShader =
[ VersionDeclaration 450 Core [ VersionDeclaration 450 Core

View 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

View 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)

View File

@@ -1,20 +1,16 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{- |
-- | Transforms has a pile of utility functions for data type conversion - will be removed soon
module Haskengl.Math.Transforms (addCamera, Vertex(..)) where -}
module Haskengl.Internal.Math.Classes where
-- IMPORTS --
import qualified Graphics.Rendering.OpenGL as GL
import Foreign.Storable
import Relude 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 class Vertex a where
toPoint :: a -> Point 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 0 0) = Just $ GL.Vertex2 x y
fromPoint (Point x y _ _) = Nothing fromPoint (Point x y _ _) = Nothing
fromPointLossy (Point x y _ _) = GL.Vertex2 x y 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))

View 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
}

View 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

View File

@@ -10,36 +10,41 @@
-} -}
module Haskengl.Main (main) where module Haskengl.Main (main) where
-- IMPORTS --
import Graphics.UI.GLFW (Window)
import Relude import Relude
import Relude.Monad (forever) import Relude.Monad (forever)
import Haskengl.IO import Control.Concurrent (threadDelay)
import Haskengl.Math.Transforms
import Haskengl.Types
import Haskengl.Update
-- 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 :: IO ()
main = main =
do do
(window, objects) <- openWindow "window :)" (window, objects) <- openWindow "window :)"
loop window objects update view model putTextLn "initialized window"
_ <- loop window update view $ Model { objects = objects }
return () return ()
-- | Elm-like 'gameloop' -- | Elm-like 'gameloop'
loop loop
:: Window -- ^ The window to display on :: Window -- ^ The window to display on
-> DisplayableObjects -- ^ Objects to be displayed
-> (Model -> Model) -- ^ Update function -> (Model -> Model) -- ^ Update function
-> (Window -> DisplayableObjects -> Model -> IO ()) -- ^ View function -> (Window -> Model -> IO ()) -- ^ View function
-> Model -- ^ Model -> Model -- ^ Model
-> IO () -> IO ()
loop window objects update view model = loop window update view model =
do do
let model = update model Just frameStart <- getTime
view window objects model let model' = update model
loop window objects update view 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'

View File

@@ -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

View File

@@ -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