add changelog; see changelog <3

2 files changed, 234 insertions, 0 deletions

diff --git a/src/Game/Internal/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
new file mode 100644
index 0000000..ded2da9
--- /dev/null
+++ b/src/Game/Internal/LoadShaders.hs
@@ -0,0 +1,89 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  LoadShaders
+-- Copyright   :  (c) Sven Panne 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The
+-- Red Book Authors.
+--
+--------------------------------------------------------------------------------
+
+module Game.Internal.LoadShaders (
+   ShaderSource(..), ShaderInfo(..), loadShaders
+) where
+
+import Control.Exception
+import Control.Monad
+import qualified Data.ByteString as B
+import Graphics.Rendering.OpenGL
+
+--------------------------------------------------------------------------------
+
+-- | The source of the shader source code.
+
+data ShaderSource =
+     ByteStringSource B.ByteString
+     -- ^ The shader source code is directly given as a 'B.ByteString'.
+   | StringSource String
+     -- ^ The shader source code is directly given as a 'String'.
+   | FileSource FilePath
+     -- ^ The shader source code is located in the file at the given 'FilePath'.
+   deriving ( Eq, Ord, Show )
+
+getSource :: ShaderSource -> IO B.ByteString
+getSource (ByteStringSource bs) = return bs
+getSource (StringSource str) = return $ packUtf8 str
+getSource (FileSource path) = B.readFile path
+
+--------------------------------------------------------------------------------
+
+-- | A description of a shader: The type of the shader plus its source code.
+
+data ShaderInfo = ShaderInfo ShaderType ShaderSource
+   deriving ( Eq, Ord, Show )
+
+--------------------------------------------------------------------------------
+
+-- | Create a new program object from the given shaders, throwing an
+-- 'IOException' if something goes wrong.
+
+loadShaders :: [ShaderInfo] -> IO Program
+loadShaders infos =
+   createProgram `bracketOnError` deleteObjectName $ \program -> do
+      loadCompileAttach program infos
+      linkAndCheck program
+      return program
+
+linkAndCheck :: Program -> IO ()
+linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
+
+loadCompileAttach :: Program -> [ShaderInfo] -> IO ()
+loadCompileAttach _ [] = return ()
+loadCompileAttach program (ShaderInfo shType source : infos) =
+   createShader shType `bracketOnError` deleteObjectName $ \shader -> do
+      src <- getSource source
+      shaderSourceBS shader $= src
+      compileAndCheck shader
+      attachShader program shader
+      loadCompileAttach program infos
+
+compileAndCheck :: Shader -> IO ()
+compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
+
+checked :: (t -> IO ())
+        -> (t -> GettableStateVar Bool)
+        -> (t -> GettableStateVar String)
+        -> String
+        -> t
+        -> IO ()
+checked action getStatus getInfoLog message object = do
+   action object
+   ok <- get (getStatus object)
+   unless ok $ do
+      infoLog <- get (getInfoLog object)
+      fail (message ++ " log: " ++ infoLog)
diff --git a/src/Game/Internal/Types.hs b/src/Game/Internal/Types.hs
new file mode 100644
index 0000000..719905e
--- /dev/null
+++ b/src/Game/Internal/Types.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-}
+{- |
+ - Module      : Game.Types
+ - Description : 
+ - Copyright   : Andromeda 2025
+ - License     : WTFPL
+ - Maintainer  : Matrix @Andromeda:tchncs.de
+ - Stability   : Experimental
+ -}
+module Game.Internal.Types
+  ( Object(..)
+
+  , toGLMatrix
+
+  , Model ( camera
+          , objects
+          , cursorDeltaPos
+          , cursorPos
+          , program
+          , keys
+          , wprop
+          )
+  , mkModel
+
+  , Camera ( camPos
+           , camPitch
+           , camYaw
+           , camReference
+           , mouseSensitivity
+           , camVel
+           , strafeStrength
+           , jumpStrength
+           , hasJumped
+           , airTime
+           )
+  , mkCamera
+
+  , WorldProperties (g, friction, up)
+  , mkWorldProperties
+
+  ) where
+
+import qualified Graphics.UI.GLFW          as GLFW
+import qualified Graphics.Rendering.OpenGL as GL
+
+import qualified Linear as L
+import           Linear      (Quaternion, V3, V3(..), V4(..))
+
+-- | represents a single draw call
+data Object =
+  Object
+    { vao :: GL.VertexArrayObject
+    , numIndicies :: GL.NumArrayIndices
+    , numComponents :: GL.NumComponents
+    , primitiveMode :: GL.PrimitiveMode
+    }
+    deriving Show
+
+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
+  ]
+
+-- | gamestate
+data Model =
+  Model
+    { camera :: Camera
+    , cursorDeltaPos :: (Double, Double)
+    , cursorPos :: (Double, Double)
+    , keys :: [GLFW.Key]
+    , objects :: [Object]
+    , program :: GL.Program
+    , wprop :: WorldProperties
+    }
+    deriving Show
+
+mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model
+mkModel camera objects program wprop = Model camera (0,0) (0,0) [] objects program wprop
+
+-- | camera
+data Camera =
+  Camera
+    { camPos :: V3 Float
+    , camPitch :: Float
+    , camYaw :: Float
+    , camReference :: V3 Float
+    , camVel :: V3 Float
+    , mouseSensitivity :: Float
+    , strafeStrength :: Float
+    , jumpStrength :: Float
+    , hasJumped :: Bool
+    , airTime :: Float
+    }
+    deriving Show
+
+mkCamera
+  :: V3 Float
+  -> Float
+  -> Float
+  -> V3 Float
+  -> V3 Float
+  -> Float
+  -> Float
+  -> Float
+  -> Camera
+mkCamera
+  camPos
+  camPitch
+  camYaw
+  camReference
+  camVel
+  mouseSensitivity
+  strafeStrength
+  jumpStrength =
+  Camera
+    camPos
+    camPitch
+    camYaw
+    (L.normalize camReference)
+    (L.normalize camVel)
+    mouseSensitivity
+    strafeStrength
+    jumpStrength
+    False
+    0
+
+data WorldProperties =
+  WorldProperties
+    { g :: Float -- ^ gravity `g`
+    , friction :: Float -- ^ floor friction
+    , up :: V3 Float
+    }
+    deriving Show
+
+mkWorldProperties :: Float -> Float -> V3 Float-> WorldProperties
+mkWorldProperties g friction up =
+  WorldProperties g friction (L.normalize up)