diff --git a/flake.lock b/flake.lock index 5c6f215..9386f3f 100644 --- a/flake.lock +++ b/flake.lock @@ -2,16 +2,16 @@ "nodes": { "nixpkgs": { "locked": { - "lastModified": 1763966396, - "narHash": "sha256-6eeL1YPcY1MV3DDStIDIdy/zZCDKgHdkCmsrLJFiZf0=", + "lastModified": 1764611609, + "narHash": "sha256-yU9BNcP0oadUKupw0UKmO9BKDOVIg9NStdJosEbXf8U=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "5ae3b07d8d6527c42f17c876e404993199144b6a", + "rev": "8c29968b3a942f2903f90797f9623737c215737c", "type": "github" }, "original": { "id": "nixpkgs", - "ref": "nixos-unstable", + "ref": "nixpkgs-unstable", "type": "indirect" } }, diff --git a/flake.nix b/flake.nix index a62047a..6c1f53a 100644 --- a/flake.nix +++ b/flake.nix @@ -1,6 +1,6 @@ { inputs = { - nixpkgs.url = "nixpkgs/nixos-unstable"; + nixpkgs.url = "nixpkgs/nixpkgs-unstable"; self.submodules = true; }; outputs = {nixpkgs, ...}: let diff --git a/lib/hs-glsl b/lib/hs-glsl index fa90055..038946c 160000 --- a/lib/hs-glsl +++ b/lib/hs-glsl @@ -1 +1 @@ -Subproject commit fa90055518540314430139748e7febee3f03f24e +Subproject commit 038946ca49f1369ca894f345cc55004d15aa1d19 diff --git a/package.nix b/package.nix index 28f24f8..85ab078 100644 --- a/package.nix +++ b/package.nix @@ -13,7 +13,7 @@ "-Wincomplete-record-updates" "-Wincomplete-uni-patterns" "-Wmissing-export-lists" - "-Wmossing-home-modules" + "-Wmissing-home-modules" "-Wpartial-fields" "-Wredundant-constraints" "-threaded" @@ -23,9 +23,20 @@ "-i./lib/hs-glsl/src" # src "-i./src" + "-main-is Haskengl.Main" + ]; + haddockOptions = lib.concatStringsSep " " haddockFlags; + haddockFlags = [ + "--html" + "--odir docs" + "--optghc=-i./src" + "--optghc=-i./lib/hs-glsl/src" + "src/Haskengl/Main.hs" ]; ghcPackages = p: [ p.GLFW-b + p.linear + p.linear-opengl p.OpenGL p.relude ]; @@ -42,11 +53,13 @@ in configurePhase = '' ''; buildPhase = '' - ghc ${ghcExeOptions} ./src/Main.hs -o ./Main + ghc ${ghcExeOptions} ./src/Haskengl/Main.hs -o ./Main ''; installPhase = '' mkdir -p $out/bin cp ./Main $out/bin/haskengl + #haddock ${haddockOptions} + #cp ./docs $out/docs -r ''; meta = { diff --git a/src/IO.hs b/src/Haskengl/IO.hs similarity index 56% rename from src/IO.hs rename to src/Haskengl/IO.hs index d656256..a550d7b 100644 --- a/src/IO.hs +++ b/src/Haskengl/IO.hs @@ -1,69 +1,86 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module IO (openWindow, shutdownWindow, view) where +module Haskengl.IO (openWindow, shutdownWindow, view) where -- IMPORTS -- import qualified Graphics.Rendering.OpenGL as GL -import Graphics.Rendering.OpenGL (($=)) -import qualified Graphics.UI.GLFW as GLFW -import qualified Language.GLSL as GLSL +import Graphics.Rendering.OpenGL (($=)) +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 Data.Text (unpack) import Foreign.Ptr import Foreign.Marshal.Array import Foreign.Storable -import LoadShaders import Relude -import Shaders -import Types + +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 0 0 0 1 +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 window objects + displayObjects objects GLFW.swapBuffers window GLFW.pollEvents -- SHADER STUFF -- -displayObjects :: GLFW.Window -> DisplayableObjects -> IO (DisplayableObjects) -displayObjects _ [] = return [] -displayObjects window ((DisplayableObject vao numVertices _ primitiveMode):objects) = do +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 window objects + displayObjects objects -- INIT RENDERER -- bufferOffset :: Integral a => a -> Ptr b bufferOffset integral = plusPtr nullPtr $ fromIntegral integral -verticesArray :: [GL.Vertex2 GL.GLfloat] +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.Vertex2 0.9 0.9 - , GL.Vertex2 0.5 0.9 - , GL.Vertex2 0.9 0.5 - , GL.Vertex2 0.5 0.5 - , GL.Vertex2 0.9 0.0 - , GL.Vertex2 0.5 0.0 + [ 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 0.5 1 0.5 - , GL.Vertex3 (-0.5) (-0.5) (-0.5) - , GL.Vertex3 0 0 0 + [ 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 ] generateRGBA :: Int -> [GL.Color4 GL.GLfloat] @@ -81,7 +98,7 @@ sizeOfArray :: (Storable a, Num b) => [a] -> b sizeOfArray [] = 0 sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x -createVBO :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.AttribLocation -> IO GL.BufferObject +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 @@ -100,7 +117,7 @@ createVBO array numComponents attribLocation = do GL.vertexAttribArray attribLocation $= GL.Enabled return buffer -createDisplayableObject :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.PrimitiveMode -> IO DisplayableObject +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 @@ -109,16 +126,22 @@ createDisplayableObject array numComponents primitiveMode = do return (DisplayableObject vao + (AbsoluteObject $ map (AbsolutePoint . toPoint) array) (fromIntegral $ length array) numComponents primitiveMode ) -initResources :: IO DisplayableObjects -initResources = do - verticesObject <- createDisplayableObject verticesArray 2 GL.TriangleStrip +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) + -- load shaders program <- loadShaders [ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader) @@ -127,6 +150,29 @@ initResources = do 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 (-3)) (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 + + putStrLn $ show projection + putStrLn $ show location0 + return [verticesObject, testObject] -- INPUT -- @@ -145,17 +191,15 @@ openWindow 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 - - -- get an error n ur cooked. TODO graceful failure here 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 + objects <- initResources window return (window, objects) shutdownWindow :: GLFW.WindowCloseCallback @@ -169,9 +213,6 @@ resizeWindow :: GLFW.WindowSizeCallback resizeWindow _ w h = do GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) - GL.matrixMode $= GL.Projection - GL.loadIdentity - GL.ortho2D 0 (realToFrac w) (realToFrac h) 0 closeWindow :: GLFW.Window -> IO () closeWindow window = diff --git a/src/LoadShaders.hs b/src/Haskengl/IO/Shaders/LoadShaders.hs similarity index 98% rename from src/LoadShaders.hs rename to src/Haskengl/IO/Shaders/LoadShaders.hs index ae9339d..bb99c85 100644 --- a/src/LoadShaders.hs +++ b/src/Haskengl/IO/Shaders/LoadShaders.hs @@ -13,7 +13,7 @@ -- -------------------------------------------------------------------------------- -module LoadShaders ( +module Haskengl.IO.Shaders.LoadShaders ( ShaderSource(..), ShaderInfo(..), loadShaders ) where diff --git a/src/Shaders.hs b/src/Haskengl/IO/Shaders/Shaders.hs similarity index 72% rename from src/Shaders.hs rename to src/Haskengl/IO/Shaders/Shaders.hs index 5f49b42..e32aa63 100644 --- a/src/Shaders.hs +++ b/src/Haskengl/IO/Shaders/Shaders.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Shaders (fragShader, vertShader) where +module Haskengl.IO.Shaders.Shaders (fragShader, vertShader) where -- IMPORTS -- @@ -24,12 +24,14 @@ vertShader = , VariableDeclaration (Just $ Location 0) In vertexPosition , VariableDeclaration (Just $ Location 1) In vertexColor , VariableDeclaration Nothing Out fragColorOut + , VariableDeclaration Nothing Uniform projection , MainStart - , VariableAssignment GL_POSITION vertexPosition + , DangerousExpression "gl_Position = projection * vec4(vertexPosition, 1.0);" , VariableAssignment fragColorOut vertexColor ] fragColor = Variable "fragColor" $ GLSLVec4 GLSLFloat fragColorOut = Variable "fragColorOut" $ GLSLVec4 GLSLFloat -vertexPosition = Variable "vertexPosition" $ GLSLVec4 GLSLFloat +vertexPosition = Variable "vertexPosition" $ GLSLVec3 GLSLFloat vertexColor = Variable "vertexColor" $ GLSLVec4 GLSLFloat +projection = Variable "projection" $ GLSLMat4 GLSLFloat diff --git a/src/Haskengl/Main.hs b/src/Haskengl/Main.hs new file mode 100644 index 0000000..2f43966 --- /dev/null +++ b/src/Haskengl/Main.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Haskengl + Description : 4D side project + Copyright : Andromeda 2025 + License : WTFPL + Maintainer : Matrix @Andromeda:tchncs.de + Stability : Experimental + -} +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 + +-- MAIN -- + +main :: IO () +main = + do + (window, objects) <- openWindow "window :)" + loop window objects update view model + 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 + -> Model -- ^ Model + -> IO () +loop window objects update view model = + do + let model = update model + view window objects model + loop window objects update view model diff --git a/src/Haskengl/Math/Transforms.hs b/src/Haskengl/Math/Transforms.hs new file mode 100644 index 0000000..03fdf11 --- /dev/null +++ b/src/Haskengl/Math/Transforms.hs @@ -0,0 +1,57 @@ +{-# 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 + +import Relude + +import Haskengl.Types + +-- classes -- + +class Vertex a where + toPoint :: a -> Point + fromPoint :: Point -> Maybe a + fromPointLossy :: Point -> a + +instance Vertex Point where + toPoint point = point + fromPoint point = Just point + fromPointLossy point = point + +instance Vertex (GL.Color4 GL.GLfloat) where + toPoint (GL.Color4 x y z k) = Point x y z k + fromPoint (Point x y z k) = Just $ GL.Color4 x y z k + fromPointLossy (Point x y z k) = GL.Color4 x y z k + +instance Vertex (GL.Vertex4 GL.GLfloat) where + toPoint (GL.Vertex4 x y z k) = Point x y z k + fromPoint (Point x y z k) = Just $ GL.Vertex4 x y z k + fromPointLossy (Point x y z k) = GL.Vertex4 x y z k + +instance Vertex (GL.Vertex3 GL.GLfloat) where + toPoint (GL.Vertex3 x y z) = Point x y z 0 + fromPoint (Point x y z 0) = Just $ GL.Vertex3 x y z + fromPoint (Point x y z _) = Nothing + fromPointLossy (Point x y z _) = GL.Vertex3 x y z + +instance Vertex (GL.Vertex2 GL.GLfloat) where + toPoint (GL.Vertex2 x y) = Point x y 0 0 + 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/Types.hs b/src/Haskengl/Types.hs similarity index 70% rename from src/Types.hs rename to src/Haskengl/Types.hs index f8a90e2..7f5bc42 100644 --- a/src/Types.hs +++ b/src/Haskengl/Types.hs @@ -1,7 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Types (DisplayableObject(..), DisplayableObjects(..), Model, model, Triangle(..), triangle, Point(..), point) where +{- | Basic Types -} +module Haskengl.Types (DisplayableObject(..), DisplayableObjects(..), Model(..), model, AbsoluteObject(..), Point(..), point) where -- IMPORTS -- @@ -17,19 +18,22 @@ type DisplayableObjects = [DisplayableObject] data DisplayableObject = DisplayableObject - GL.VertexArrayObject - GL.NumArrayIndices - GL.NumComponents - GL.PrimitiveMode + 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 - { counter :: Integer + { objects :: DisplayableObjects } -- absolute objects +-- | object with a defined position data AbsoluteObject = AbsoluteObject [AbsoluteObject] | AbsolutePoint Point @@ -43,20 +47,24 @@ data Point , 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 @@ -74,7 +82,7 @@ data Surface model :: Model model = Model - { counter = 0 + { objects = [] } -- absolutes diff --git a/src/Update.hs b/src/Haskengl/Update.hs similarity index 55% rename from src/Update.hs rename to src/Haskengl/Update.hs index 59b447a..af6e6fe 100644 --- a/src/Update.hs +++ b/src/Haskengl/Update.hs @@ -1,16 +1,17 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Update (update) where +-- | Contains update logic +module Haskengl.Update (update) where -- IMPORTS -- import Relude -import Types +import Haskengl.Types -- UPDATE -- update :: Model -> Model -update model = +update model@(Model objects) = model diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 index 174cf77..0000000 --- a/src/Main.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module Main (main) where - --- IMPORTS -- - -import Graphics.UI.GLFW (Window) -import Relude -import Relude.Monad (forever) - -import IO -import Transforms -import Types -import Update - --- MAIN -- - -main :: IO () -main = - do - (window, objects) <- openWindow "window :)" - _ <- loop window objects update view model - return () - -loop - :: Window - -> DisplayableObjects - -> (Model -> Model) - -> (Window -> DisplayableObjects -> Model -> IO ()) - -> Model -> IO Model -loop window objects update view model = - do - let model = update model - view window objects model - loop window objects update view model diff --git a/src/Transforms.hs b/src/Transforms.hs deleted file mode 100644 index d80c7fa..0000000 --- a/src/Transforms.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module Transforms (pointToVertex) where - --- IMPORTS -- - -import qualified Graphics.Rendering.OpenGL as GL -import Graphics.Rendering.OpenGL (($=)) - -import Relude - -import IO -import Types - -pointToVertex :: Point -> GL.Vertex4 GL.GLfloat -pointToVertex (Point x y z k) = GL.Vertex4 x y z k