technically works: Perspective, matrices, other fun stuff

flake.lock

@@ -2,16 +2,16 @@
   "nodes": {
     "nixpkgs": {
       "locked": {
-        "lastModified": 1763966396,
+        "lastModified": 1764611609,
-        "narHash": "sha256-6eeL1YPcY1MV3DDStIDIdy/zZCDKgHdkCmsrLJFiZf0=",
+        "narHash": "sha256-yU9BNcP0oadUKupw0UKmO9BKDOVIg9NStdJosEbXf8U=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "5ae3b07d8d6527c42f17c876e404993199144b6a",
+        "rev": "8c29968b3a942f2903f90797f9623737c215737c",
         "type": "github"
       },
       "original": {
         "id": "nixpkgs",
-        "ref": "nixos-unstable",
+        "ref": "nixpkgs-unstable",
         "type": "indirect"
       }
     },

flake.nix

@@ -1,6 +1,6 @@
 {
   inputs = {
-    nixpkgs.url = "nixpkgs/nixos-unstable";
+    nixpkgs.url = "nixpkgs/nixpkgs-unstable";
     self.submodules = true;
   };
   outputs = {nixpkgs, ...}: let

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 = {

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           Graphics.Rendering.OpenGL (($=))
-import qualified Graphics.UI.GLFW as GLFW
+import qualified Graphics.UI.GLFW          as GLFW
-import qualified Language.GLSL as GLSL
+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)
+projection :: L.M44 GL.GLfloat
-displayObjects _ [] = return []
+projection = L.perspective (45 * 3.141592653 / 180) 1 0.1 100
-displayObjects window ((DisplayableObject vao numVertices _ primitiveMode):objects) = do
+
+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.Vertex3 0.3    0.3    0.5
-  , GL.Vertex2 0.5 0.9
+  , GL.Vertex3 (-0.3) 0.3    0
-  , GL.Vertex2 0.9 0.5
+  , GL.Vertex3 0.3    (-0.3) 0
-  , GL.Vertex2 0.5 0.5
+  , GL.Vertex3 (-0.3) (-0.3) (-0.5)
-  , GL.Vertex2 0.9 0.0
-  , GL.Vertex2 0.5 0.0
   ]
 
 testArray :: [GL.Vertex3 GL.GLfloat]
 testArray =
-  [ GL.Vertex3 0.5 1 0.5
+  [ GL.Vertex3 1.5 1.5 0
-  , GL.Vertex3 (-0.5) (-0.5) (-0.5)
+  , GL.Vertex3 0.5 1.5 0
-  , GL.Vertex3 0 0 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 :: GLFW.Window -> IO DisplayableObjects
-initResources = do
+initResources window = do
-  verticesObject <- createDisplayableObject verticesArray 2 GL.TriangleStrip
+  -- 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 =

src/Haskengl/IO/Shaders/LoadShaders.hs

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

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

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

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

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.VertexArrayObject -- ^ VAO
-    GL.NumArrayIndices
+    AbsoluteObject
-    GL.NumComponents
+    GL.NumArrayIndices -- ^ The length of the array / number of vertides
-    GL.PrimitiveMode
+    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

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

src/Main.hs

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

src/Transforms.hs

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