merge development into master

2 files changed, 98 insertions, 144 deletions

diff --git a/src/Game/Internal/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
index ded2da9..86b549f 100644
--- a/src/Game/Internal/LoadShaders.hs
+++ b/src/Game/Internal/LoadShaders.hs
@@ -12,10 +12,11 @@
 -- Red Book Authors.
 --
 --------------------------------------------------------------------------------
-
-module Game.Internal.LoadShaders (
-   ShaderSource(..), ShaderInfo(..), loadShaders
-) where
+module Game.Internal.LoadShaders
+  ( ShaderSource(..)
+  , ShaderInfo(..)
+  , loadShaders
+  ) where
 
 import Control.Exception
 import Control.Monad
@@ -23,17 +24,15 @@ import qualified Data.ByteString as B
 import Graphics.Rendering.OpenGL
 
 --------------------------------------------------------------------------------
-
 -- | The source of the shader source code.
-
-data ShaderSource =
-     ByteStringSource B.ByteString
+data ShaderSource
+  = ByteStringSource B.ByteString
      -- ^ The shader source code is directly given as a 'B.ByteString'.
-   | StringSource String
+  | StringSource String
      -- ^ The shader source code is directly given as a 'String'.
-   | FileSource FilePath
+  | FileSource FilePath
      -- ^ The shader source code is located in the file at the given 'FilePath'.
-   deriving ( Eq, Ord, Show )
+  deriving (Eq, Ord, Show)
 
 getSource :: ShaderSource -> IO B.ByteString
 getSource (ByteStringSource bs) = return bs
@@ -41,49 +40,47 @@ 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 )
+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
+  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
+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 ::
+     (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)
+  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
index ad220e4..8095cfb 100644
--- a/src/Game/Internal/Types.hs
+++ b/src/Game/Internal/Types.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-}
+
 {- |
  - Module      : Game.Internal.Types
  - Description : 
@@ -9,116 +10,83 @@
  -}
 module Game.Internal.Types
   ( Object(..)
-
   , toGLMatrix
-
-  , Model ( camera
-          , objects
-          , cursorDeltaPos
-          , cursorPos
-          , program
-          , keys
-          , wprop
-          )
+  , Model(camera, objects, cursorDeltaPos, cursorPos, program, keys, wprop)
   , mkModel
-
-  , Camera ( camPos
-           , camPitch
-           , camYaw
-           , camReference
-           , mouseSensitivity
-           , camVel
-           , strafeStrength
-           , jumpStrength
-           , hasJumped
-           , airTime
-           )
+  , Camera(camPos, camPitch, camYaw, camReference, mouseSensitivity, camVel, strafeStrength, jumpStrength, hasJumped, airTime)
   , mkCamera
-
-  , WorldProperties (g, friction, up)
+  , WorldProperties(g, friction, up)
   , mkWorldProperties
-
   ) where
 
-import qualified Graphics.UI.GLFW          as GLFW
 import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.UI.GLFW as GLFW
 
 import qualified Linear as L
-import           Linear      (V3, V3(..), V4(..))
+import Linear (V3, V3(..), V4(..))
 
 -- | represents a single draw call
-data Object =
-  Object
-    { vao :: GL.VertexArrayObject       -- ^ vao of vertex buffer
-    , numIndicies :: GL.NumArrayIndices -- ^ number of vertices
-    , numComponents :: GL.NumComponents -- ^ dimensionallity; vec3, vec4, etc.
-    , primitiveMode :: GL.PrimitiveMode -- ^ primitive mode to be drawn with
-    }
-    deriving Show
+data Object = Object
+  { vao :: GL.VertexArrayObject -- ^ vao of vertex buffer
+  , numIndicies :: GL.NumArrayIndices -- ^ number of vertices
+  , numComponents :: GL.NumComponents -- ^ dimensionallity; vec3, vec4, etc.
+  , primitiveMode :: GL.PrimitiveMode -- ^ primitive mode to be drawn with
+  } deriving (Show)
 
 -- | converts M44 to a 16array for OpenGL
 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
+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) -- ^ frame-on-frame delta mouse position
-    , cursorPos :: (Double, Double)      -- ^ current mouse position
-    , keys :: [GLFW.Key]                 -- ^ currently pressed keys
-    , objects :: [Object]                -- ^ draw calls
-    , program :: GL.Program              -- ^ shader program
-    , wprop :: WorldProperties
-    }
-    deriving Show
+data Model = Model
+  { camera :: Camera
+  , cursorDeltaPos :: (Double, Double) -- ^ frame-on-frame delta mouse position
+  , cursorPos :: (Double, Double) -- ^ current mouse position
+  , keys :: [GLFW.Key] -- ^ currently pressed keys
+  , objects :: [Object] -- ^ draw calls
+  , program :: GL.Program -- ^ shader program
+  , wprop :: WorldProperties
+  } deriving (Show)
 
 -- | smart constructor for Model
-mkModel
-  :: Camera
-  -> [Object]
-  -> GL.Program
-  -> WorldProperties
-  -> Model
+mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model
 mkModel camera objects program wprop =
-  Model
-    camera
-    (0,0)
-    (0,0)
-    []
-    objects
-    program
-    wprop
+  Model camera (0, 0) (0, 0) [] objects program wprop
 
 -- | camera
-data Camera =
-  Camera
-    { camPos :: V3 Float        -- ^ position in world space
-    , camPitch :: Float         -- ^ pitch in radians, up positive
-    , camYaw :: Float           -- ^ yaw in radians, right positive
-    , camReference :: V3 Float  -- ^ reference direction; orientation applied to
-    , camVel :: V3 Float        -- ^ velocity in world space
-    , mouseSensitivity :: Float -- ^ scale factor for mouse movement
-    , strafeStrength :: Float   -- ^ scale factor for strafe
-    , jumpStrength :: Float     -- ^ scale factor for jump initial velocity
-    , hasJumped :: Bool         -- ^ whether the camera still has jumping state
-    , airTime :: Float          -- ^ time since jumping state entered in seconds
-    }
-    deriving Show
+data Camera = Camera
+  { camPos :: V3 Float -- ^ position in world space
+  , camPitch :: Float -- ^ pitch in radians, up positive
+  , camYaw :: Float -- ^ yaw in radians, right positive
+  , camReference :: V3 Float -- ^ reference direction; orientation applied to
+  , camVel :: V3 Float -- ^ velocity in world space
+  , mouseSensitivity :: Float -- ^ scale factor for mouse movement
+  , strafeStrength :: Float -- ^ scale factor for strafe
+  , jumpStrength :: Float -- ^ scale factor for jump initial velocity
+  , hasJumped :: Bool -- ^ whether the camera still has jumping state
+  , airTime :: Float -- ^ time since jumping state entered in seconds
+  } deriving (Show)
 
 -- | smart constructor for Camera
-mkCamera
-  :: V3 Float
+mkCamera ::
+     V3 Float
   -> Float
   -> Float
   -> V3 Float
@@ -127,15 +95,7 @@ mkCamera
   -> Float
   -> Float
   -> Camera
-mkCamera
-  camPos
-  camPitch
-  camYaw
-  camReference
-  camVel
-  mouseSensitivity
-  strafeStrength
-  jumpStrength =
+mkCamera camPos camPitch camYaw camReference camVel mouseSensitivity strafeStrength jumpStrength =
   Camera
     camPos
     camPitch
@@ -149,15 +109,12 @@ mkCamera
     0
 
 -- | physical properties of the world
-data WorldProperties =
-  WorldProperties
-    { g :: Float        -- ^ gravity `g`
-    , friction :: Float -- ^ scale factor for floor friction
-    , up :: V3 Float    -- ^ global up vector
-    }
-    deriving Show
+data WorldProperties = WorldProperties
+  { g :: Float -- ^ gravity `g`
+  , friction :: Float -- ^ scale factor for floor friction
+  , up :: V3 Float -- ^ global up vector
+  } deriving (Show)
 
 -- | smart constructor for WorldProperties
-mkWorldProperties :: Float -> Float -> V3 Float-> WorldProperties
-mkWorldProperties g friction up =
-  WorldProperties g friction (L.normalize up)
+mkWorldProperties :: Float -> Float -> V3 Float -> WorldProperties
+mkWorldProperties g friction up = WorldProperties g friction (L.normalize up)