From 4af0a1c4c2c383bc98f9f5c5d28c9d0d18973008 Mon Sep 17 00:00:00 2001 From: mtgmonkey Date: Thu, 27 Nov 2025 17:50:45 +0100 Subject: [PATCH] Two Triangles (garish) --- flake.nix | 8 --- frag.glsl | 8 +++ package.nix | 4 +- src/IO.hs | 171 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 82 ++++++------------------ src/Model.hs | 19 ++++++ src/Update.hs | 15 +++++ vert.glsl | 8 +++ 8 files changed, 243 insertions(+), 72 deletions(-) create mode 100644 frag.glsl create mode 100644 src/IO.hs create mode 100644 src/Model.hs create mode 100644 src/Update.hs create mode 100644 vert.glsl diff --git a/flake.nix b/flake.nix index 79e4a63..745dfb3 100644 --- a/flake.nix +++ b/flake.nix @@ -9,13 +9,5 @@ packages.${system} = { default = pkgs.callPackage ./package.nix {}; }; - devShells.${system} = { - default = pkgs.mkShell { - nativeBuildInputs = [ - ]; - shellHook = '' - ''; - }; - }; }; } diff --git a/frag.glsl b/frag.glsl new file mode 100644 index 0000000..cf3bcda --- /dev/null +++ b/frag.glsl @@ -0,0 +1,8 @@ +#version 450 core + +out vec4 FragColor; + +void main() +{ + FragColor = vec4(1.0f, 0.5f, 0.2f, 1.0f); +} diff --git a/package.nix b/package.nix index 2118da4..6c7882f 100644 --- a/package.nix +++ b/package.nix @@ -7,8 +7,10 @@ }: let ghcExeOptions = "-Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N"; ghcPackages = p: [ - p.OpenGL + p.bytestring + p.data-default p.GLFW-b + p.OpenGL p.relude ]; in diff --git a/src/IO.hs b/src/IO.hs new file mode 100644 index 0000000..3d70a00 --- /dev/null +++ b/src/IO.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module IO (Descriptor, openWindow, shutdownWindow, view) where + +-- IMPORTS -- + +import qualified Data.ByteString as BS +import qualified Graphics.Rendering.OpenGL as GL +import Graphics.Rendering.OpenGL (($=)) +import qualified Graphics.UI.GLFW as GLFW + +import Control.Exception +import Control.Monad +import Foreign.Ptr +import Foreign.Marshal.Array +import Foreign.Storable + +import Relude +import Model + +-- VIEW -- + +view :: GLFW.Window -> Descriptor -> Model -> IO () +view window descriptor@(Descriptor vertices firstIndex numVertices) model = do + GL.clearColor $= GL.Color4 1 0 1 1 + GL.clear [GL.ColorBuffer] + GL.bindVertexArrayObject $= Just vertices + GL.drawArrays GL.Triangles firstIndex numVertices + GLFW.swapBuffers window + GLFW.pollEvents + +-- SHADER DATA STRUCTURES -- + +data Descriptor + = Descriptor + { vertexArray :: GL.VertexArrayObject + , firstindex :: GL.ArrayIndex + , numArrayIndicies :: GL.NumArrayIndices + } + +data ShaderInfo + = ShaderInfo + GL.ShaderType + ShaderSource + deriving (Eq, Ord, Show) + +data ShaderSource + = ByteStringSource BS.ByteString + | StringSource String + | FileSource FilePath + deriving (Eq, Ord, Show) + +-- INIT RENDERER -- + +bufferOffset :: Integral a => a -> Ptr b +bufferOffset integral = plusPtr nullPtr $ fromIntegral integral + +initResources :: IO Descriptor +initResources = do + verticesGLArray <- GL.genObjectName + GL.bindVertexArrayObject $= Just verticesGLArray + let + verticesArray = + [ GL.Vertex2 0.9 0.9 + , GL.Vertex2 0.9 (-0.85) + , GL.Vertex2 (-0.85) 0.9 + , GL.Vertex2 (-0.9) (-0.9) + , GL.Vertex2 (-0.9) 0.85 + , GL.Vertex2 0.85 (-0.9) + ] :: [GL.Vertex2 GL.GLfloat] + numVertices = length verticesArray + arrayBuffer <- GL.genObjectName + GL.bindBuffer GL.ArrayBuffer $= Just arrayBuffer + withArray verticesArray $ \ptr -> do + let + size + = fromIntegral + $ (*) + numVertices + $ sizeOf + $ case viaNonEmpty head verticesArray of + Nothing -> (GL.Vertex2 0 0) :: (GL.Vertex2 GL.GLfloat) + Just a -> a + GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw) + program <- loadShaders + [ ShaderInfo GL.VertexShader (FileSource "vert.glsl") + , ShaderInfo GL.FragmentShader (FileSource "frag.glsl") + ] + GL.currentProgram $= Just program + let + firstIndex = 0 + vPosition = GL.AttribLocation 0 + GL.vertexAttribPointer vPosition $= + (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 (bufferOffset firstIndex)) + GL.vertexAttribArray vPosition $= GL.Enabled + return $ Descriptor verticesGLArray firstIndex $ fromIntegral numVertices + +-- LOAD SHADERS -- + +getSource :: ShaderSource -> IO BS.ByteString +getSource (ByteStringSource bs) = return bs +getSource (StringSource str) = return $ GL.packUtf8 str +getSource (FileSource path) = BS.readFile path + +loadShaders :: [ShaderInfo] -> IO GL.Program +loadShaders infos = + GL.createProgram `bracketOnError` GL.deleteObjectName $ \program -> do + loadCompileAttach program infos + GL.linkProgram program + return program + +loadCompileAttach :: GL.Program -> [ShaderInfo] -> IO () +loadCompileAttach _ [] = return () +loadCompileAttach program (ShaderInfo shType source : infos) = + GL.createShader shType `bracketOnError` GL.deleteObjectName $ \shader -> do + src <- getSource source + GL.shaderSourceBS shader $= src + GL.compileShader shader + GL.attachShader program shader + loadCompileAttach program infos + +-- INPUT -- + +keyPressed :: GLFW.KeyCallback +keyPressed window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window +keyPressed _ _ _ _ _ = return () + +-- WINDOW -- + +openWindow :: String -> IO (GLFW.Window, Descriptor) +openWindow + title + = do + GLFW.init + GLFW.defaultWindowHints + GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) + GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) + 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) + descriptor <- initResources + return (window, descriptor) + +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)) + GL.matrixMode $= GL.Projection + GL.loadIdentity + GL.ortho2D 0 (realToFrac w) (realToFrac h) 0 + +closeWindow :: GLFW.Window -> IO () +closeWindow window = + do + GLFW.destroyWindow window + GLFW.terminate diff --git a/src/Main.hs b/src/Main.hs index bce41d4..0bf3e05 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,79 +1,35 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where -- IMPORTS -- -import Graphics.Rendering.OpenGL as GL -import Graphics.UI.GLFW as GLFW +import Graphics.UI.GLFW (Window) +import IO (Descriptor, openWindow, view) +import Model (Model, model) import Relude import Relude.Monad (forever) +import Update (update) -- MAIN -- main :: IO () -main = do - putStrLn "haskengl 2025 Andromeda; WTFPL" - window <- openWindow "window :)" - onPaint window - closeWindow window - return () - --- EVENTS -- - -keyPressed :: GLFW.KeyCallback -keyPressed window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window -keyPressed _ _ _ _ _ = return () - --- PAINT -- - -onPaint :: GLFW.Window -> IO () -onPaint window = +main = do - GL.clearColor $= Color4 1 0 1 1 - GL.clear [ColorBuffer] - GLFW.swapBuffers window - forever $ do - GLFW.pollEvents - onPaint window - --- WINDOW -- - -openWindow :: String -> IO GLFW.Window -openWindow - title - = do - GLFW.init - GLFW.defaultWindowHints - GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) - GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) - GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core) - monitor <- GLFW.getPrimaryMonitor - Just window <- GLFW.createWindow 256 256 title monitor Nothing -- get an error n ur cooked. TODO graceful failure here - GLFW.makeContextCurrent (Just window) - GLFW.maximizeWindow window - GLFW.setWindowCloseCallback window (Just shutdownWindow) - GLFW.setWindowSizeCallback window (Just resizeWindow) - GLFW.setKeyCallback window (Just keyPressed) - return window - -shutdownWindow :: GLFW.WindowCloseCallback -shutdownWindow window = - do - closeWindow window - _ <- exitSuccess + (window, descriptor) <- openWindow "window :)" + putTextLn "has window" + _ <- loop window descriptor update view model return () -resizeWindow :: GLFW.WindowSizeCallback -resizeWindow _ w h = +loop + :: Window + -> Descriptor + -> (Model -> Model) + -> (Window -> Descriptor -> Model -> IO ()) + -> Model -> IO Model +loop window descriptor update view model = 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 = - do - GLFW.destroyWindow window - GLFW.terminate + let model = update model + view window descriptor model + loop window descriptor update view model diff --git a/src/Model.hs b/src/Model.hs new file mode 100644 index 0000000..05946a1 --- /dev/null +++ b/src/Model.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Model (Model, model) where + +-- IMPORTS -- + +import Relude + +-- TYPES -- + +data Model = Model + { counter :: Integer + } + +-- DEFAULTS -- +model = Model + { counter = 0 + } diff --git a/src/Update.hs b/src/Update.hs new file mode 100644 index 0000000..df4f7e6 --- /dev/null +++ b/src/Update.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Update (update) where + +-- IMPORTS -- + +import Model +import Relude + +-- UPDATE -- + +update :: Model -> Model +update model = + model diff --git a/vert.glsl b/vert.glsl new file mode 100644 index 0000000..65a9f2b --- /dev/null +++ b/vert.glsl @@ -0,0 +1,8 @@ +#version 450 core + +layout (location = 0) in vec3 aPos; + +void main() +{ + gl_Position = vec4(aPos.x, aPos.y, aPos.z, 1.0); +}