restructure: moved Graphics and Physics into own subfolders

This commit is contained in:
nek0 2021-04-29 20:28:52 +02:00
parent 61451a4a10
commit 1ab8befd8f
36 changed files with 100 additions and 175 deletions

View File

@ -21,15 +21,9 @@ executable pituicat
, Types.Application , Types.Application
, Types.Subsystems , Types.Subsystems
, Types.Map , Types.Map
, Types.Texture
, Types.Cast , Types.Cast
, Types.StageSet , Types.StageSet
, Types.Tangible , Types.Tangible
, Types.Graphics
, Types.Graphics.VertexArray
, Types.Graphics.VertexBuffer
, Types.Graphics.IndexBuffer
, Types.Graphics.Shader
, Types.Util , Types.Util
, Types.Player , Types.Player
, Types.PowerUp , Types.PowerUp
@ -38,14 +32,22 @@ executable pituicat
, Classes.Actor , Classes.Actor
, Classes.Prop , Classes.Prop
, Classes.Collectable , Classes.Collectable
, Classes.Graphics , Graphics
, Classes.Graphics.Bindable , Graphics.Types
, Classes.Graphics.Buffer , Graphics.Types.VertexArray
, Classes.Graphics.VertexLayout , Graphics.Types.VertexBuffer
, Classes.Graphics.Drawable , Graphics.Types.IndexBuffer
, Classes.Physics , Graphics.Types.Shader
, Classes.Physics.Mass , Graphics.Types.Texture
, Classes.Physics.Collidible , Graphics.Classes
, Graphics.Classes.Bindable
, Graphics.Classes.Buffer
, Graphics.Classes.VertexLayout
, Graphics.Classes.Drawable
, Physics
, Physics.Classes
, Physics.Classes.Mass
, Physics.Classes.Collidible
, Scenes.Test , Scenes.Test
, Scenes.Test.Types , Scenes.Test.Types
, Scenes.Test.Util , Scenes.Test.Util

View File

@ -2,9 +2,7 @@ module Classes
( module C ( module C
) where ) where
import Classes.Graphics as C
import Classes.Scene as C import Classes.Scene as C
import Classes.Prop as C import Classes.Prop as C
import Classes.Actor as C import Classes.Actor as C
import Classes.Physics as C
import Classes.Collectable as C import Classes.Collectable as C

View File

@ -3,7 +3,7 @@ module Classes.Actor where
-- internal imports -- internal imports
import Classes.Prop import Classes.Prop
import Classes.Physics.Collidible import Physics.Classes.Collidible
class (Prop a, Collidible a) => Actor a where class (Prop a, Collidible a) => Actor a where

View File

@ -1,6 +1,6 @@
module Classes.Collectable where module Classes.Collectable where
import Classes.Physics.Collidible (Collidible) import Physics.Classes.Collidible (Collidible)
-- | All kinds of Effects present in the game -- | All kinds of Effects present in the game
data Effect data Effect

View File

@ -1,8 +0,0 @@
module Classes.Graphics
( module G
) where
import Classes.Graphics.Bindable as G
import Classes.Graphics.Buffer as G
import Classes.Graphics.VertexLayout as G
import Classes.Graphics.Drawable as G

View File

@ -1,6 +0,0 @@
module Classes.Physics
( module P
) where
import Classes.Physics.Mass as P
import Classes.Physics.Collidible as P

View File

@ -2,7 +2,7 @@ module Classes.Prop where
-- internal imports -- internal imports
import Classes.Graphics.Drawable import Graphics.Classes.Drawable
class (Show a, Drawable a) => Prop a where class (Show a, Drawable a) => Prop a where

6
src/Graphics.hs Normal file
View File

@ -0,0 +1,6 @@
module Graphics
( module G
) where
import Graphics.Classes as G
import Graphics.Types as G

8
src/Graphics/Classes.hs Normal file
View File

@ -0,0 +1,8 @@
module Graphics.Classes
( module GC
) where
import Graphics.Classes.Bindable as GC
import Graphics.Classes.Buffer as GC
import Graphics.Classes.VertexLayout as GC
import Graphics.Classes.Drawable as GC

View File

@ -1,4 +1,4 @@
module Classes.Graphics.Bindable where module Graphics.Classes.Bindable where
-- | typeclass for bindable objects like buffers, vertex arrays or shaders -- | typeclass for bindable objects like buffers, vertex arrays or shaders
class Bindable a where class Bindable a where

View File

@ -1,6 +1,6 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Classes.Graphics.Buffer where module Graphics.Classes.Buffer where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -8,7 +8,7 @@ import Foreign.Storable
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
-- | this aims to be a typeclass for all used buffer objects throughout the -- | this aims to be a typeclass for all used buffer objects throughout the
-- game. all buffer objects have to instanciate the Bindable typeclass. -- game. all buffer objects have to instanciate the Bindable typeclass.

View File

@ -1,11 +1,11 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Classes.Graphics.Drawable where module Graphics.Classes.Drawable where
import qualified Data.Vector as V import qualified Data.Vector as V
-- iternal imports -- iternal imports
import Types.Graphics.VertexBuffer (Vertex) import Graphics.Types.VertexBuffer (Vertex)
-- | A typeclass for all drawable objects -- | A typeclass for all drawable objects
class Drawable a where class Drawable a where

View File

@ -1,13 +1,13 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
module Classes.Graphics.VertexLayout where module Graphics.Classes.VertexLayout where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
class (Bindable (VertBuffer v)) => VertexLayout v where class (Bindable (VertBuffer v)) => VertexLayout v where

9
src/Graphics/Types.hs Normal file
View File

@ -0,0 +1,9 @@
module Graphics.Types
( module GT
) where
import Graphics.Types.VertexArray as GT
import Graphics.Types.VertexBuffer as GT
import Graphics.Types.IndexBuffer as GT
import Graphics.Types.Shader as GT
import Graphics.Types.Texture as GT

View File

@ -1,7 +1,7 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Types.Graphics.IndexBuffer where module Graphics.Types.IndexBuffer where
import Affection import Affection
@ -23,8 +23,8 @@ import Foreign.C.Types
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
import Classes.Graphics.Buffer import Graphics.Classes.Buffer
-- layout of the IndexBuffer data object -- layout of the IndexBuffer data object
data IndexBuffer = IndexBuffer data IndexBuffer = IndexBuffer

View File

@ -1,7 +1,7 @@
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
module Types.Graphics.Shader where module Graphics.Types.Shader where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL as GLRaw import qualified Graphics.GL as GLRaw
@ -19,7 +19,7 @@ import Foreign.Storable
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
data Shader = Shader data Shader = Shader
{ shaderId :: GL.Program { shaderId :: GL.Program

View File

@ -1,4 +1,4 @@
module Types.Texture where module Graphics.Types.Texture where
import SDL (($=)) import SDL (($=))
@ -15,7 +15,7 @@ import Foreign
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
data Texture = Texture data Texture = Texture
{ textureId :: GL.TextureObject { textureId :: GL.TextureObject

View File

@ -1,5 +1,5 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Types.Graphics.VertexArray where module Graphics.Types.VertexArray where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -7,7 +7,7 @@ import SDL (($=))
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
newtype VertexArray = VertexArray newtype VertexArray = VertexArray
{ vArrId :: GL.VertexArrayObject { vArrId :: GL.VertexArrayObject

View File

@ -2,7 +2,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Types.Graphics.VertexBuffer where module Graphics.Types.VertexBuffer where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -24,9 +24,9 @@ import GHC.Generics
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Graphics.Classes.Bindable
import Classes.Graphics.Buffer import Graphics.Classes.Buffer
import Classes.Graphics.VertexLayout import Graphics.Classes.VertexLayout
-- | layout of the VertexBuffer data object -- | layout of the VertexBuffer data object
data VertexBuffer = VertexBuffer data VertexBuffer = VertexBuffer

View File

@ -15,6 +15,7 @@ import Control.Monad (foldM)
-- internal imports -- internal imports
import Types import Types
import Graphics
constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap
constructMap desc tilemapSlot = do constructMap desc tilemapSlot = do

5
src/Physics.hs Normal file
View File

@ -0,0 +1,5 @@
module Physics
( module P
) where
import Physics.Classes as P

6
src/Physics/Classes.hs Normal file
View File

@ -0,0 +1,6 @@
module Physics.Classes
( module PC
) where
import Physics.Classes.Mass as PC
import Physics.Classes.Collidible as PC

View File

@ -1,6 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Classes.Physics.Collidible where module Physics.Classes.Collidible where
import Affection as A import Affection as A
@ -10,7 +10,7 @@ import Data.String (fromString)
-- internal imports -- internal imports
import Classes.Physics.Mass import Physics.Classes.Mass
data CollisionResult time direction data CollisionResult time direction
= NoCollision = NoCollision

View File

@ -1,4 +1,4 @@
module Classes.Physics.Mass where module Physics.Classes.Mass where
import Linear import Linear

View File

@ -9,8 +9,7 @@ import Foreign.Ptr
-- internal imports -- internal imports
import Classes.Graphics import Graphics
import Types.Graphics
draw :: VertexArray -> IndexBuffer -> Shader -> IO () draw :: VertexArray -> IndexBuffer -> Shader -> IO ()
draw va ib sp = do draw va ib sp = do

View File

@ -20,6 +20,7 @@ import Control.Concurrent.STM
import Types import Types
import Classes import Classes
import Graphics
import Renderer as R import Renderer as R
import Scenes.Test.Types as Test import Scenes.Test.Types as Test
import Scenes.Test.Util as Test import Scenes.Test.Util as Test

View File

@ -16,6 +16,7 @@ import Linear
import Types import Types
import Classes import Classes
import Graphics
import Map import Map
import Scenes.Test.Types import Scenes.Test.Types
import Scenes.Test.Util import Scenes.Test.Util

View File

@ -11,6 +11,7 @@ import qualified Data.Vector as V
-- internal imports -- internal imports
import Types import Types
import Graphics
data Test = Test data Test = Test
{ testMap :: TMVar LevelMap { testMap :: TMVar LevelMap

View File

@ -19,6 +19,7 @@ import Linear
import Scenes.Test.Types import Scenes.Test.Types
import Classes import Classes
import Types import Types
import Physics
update update
:: Test :: Test

View File

@ -16,6 +16,7 @@ import Control.Arrow ((***))
import Classes import Classes
import Types import Types
import Graphics
testLevelDesc :: LevelDescriptor testLevelDesc :: LevelDescriptor
testLevelDesc = LevelDescriptor testLevelDesc = LevelDescriptor

View File

@ -5,10 +5,8 @@ module Types
import Types.Application as T import Types.Application as T
import Types.Subsystems as T import Types.Subsystems as T
import Types.Map as T import Types.Map as T
import Types.Texture as T
import Types.Cast as T import Types.Cast as T
import Types.StageSet as T import Types.StageSet as T
import Types.Graphics as T
import Types.Player as T import Types.Player as T
import Types.Util as T import Types.Util as T
import Types.PowerUp as T import Types.PowerUp as T

View File

@ -1,8 +0,0 @@
module Types.Graphics
( module G
) where
import Types.Graphics.VertexArray as G
import Types.Graphics.VertexBuffer as G
import Types.Graphics.IndexBuffer as G
import Types.Graphics.Shader as G

View File

@ -1,93 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Texture where
import SDL (($=), get)
import qualified Graphics.Rendering.OpenGL as GL
import Codec.Picture
import Codec.Picture.Extra
import Data.Either
import Data.Vector.Storable as VS
import Data.String (fromString)
import Foreign.Ptr
import Foreign.Marshal.Alloc (free)
import Linear
-- internal imports
import Classes.Graphics.Bindable
data Texture = Texture
{ texId :: GL.TextureObject
, texSlot :: GL.TextureUnit
}
instance Bindable Texture where
bind t = do
GL.activeTexture $= texSlot t
GL.textureBinding GL.Texture2D $= Just (texId t)
unbind _ = GL.textureBinding GL.Texture2D $= Nothing
newTexture :: FilePath -> GL.GLuint -> IO (Either String Texture)
newTexture fp slot = do
eimg <- readImage fp
case eimg of
Left err -> do
let mesg = ("reading file " <> fp <> " failed: " <> show err)
logIO Error (fromString mesg)
return $ Left mesg
Right rawImg -> do
-- convert image format
let img = flipVertically $ convertRGBA8 rawImg
-- extract the raw pointer from vector
unsafeWith (imageData img) $ \ptr -> do
-- create texture object
tex <- Texture
<$> GL.genObjectName
<*> (pure $ GL.TextureUnit slot)
-- <*> (pure fp)
let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img)
-- <*> (pure $ componentCount (VS.head $ imageData img))
data_ = castPtr ptr
-- bind texture
bind tex
-- set texture parameters
GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
-- put data into GPU memory
loadTexture tex dimensions data_
-- unbind texture
unbind tex
-- pass texture object out
return $ Right tex
loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
loadTexture tex dimensions data_ =
let (V2 w h) = dimensions
in GL.texImage2D
GL.Texture2D
GL.NoProxy
0
GL.RGBA'
(GL.TextureSize2D w h)
0
(GL.PixelData GL.RGBA GL.UnsignedByte data_)

View File

@ -8,10 +8,10 @@ import Linear
-- internal imports -- internal imports
import Types.Texture import Graphics.Types.Texture
import Types.Graphics.VertexBuffer import Graphics.Types.VertexBuffer
import Classes.Graphics.Drawable import Graphics.Classes.Drawable
import Classes.Physics import Physics.Classes
data LevelMap = LevelMap data LevelMap = LevelMap
{ mapLayers :: V.Vector Layer -- ^ Layer stack { mapLayers :: V.Vector Layer -- ^ Layer stack

View File

@ -13,15 +13,17 @@ import Data.String (fromString)
import Util import Util
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Prop import Classes.Prop
import Classes.Actor import Classes.Actor
import Classes.Physics
import Classes.Collectable import Classes.Collectable
import Types.Graphics.VertexBuffer import Graphics.Classes.Drawable
import Types.Texture import Graphics.Classes.Bindable
import Graphics.Types.VertexBuffer
import Graphics.Types.Texture
import Physics.Classes
import Types.Subsystems import Types.Subsystems
catMoveVelocity :: Double catMoveVelocity :: Double

View File

@ -6,15 +6,16 @@ import Linear
-- internal imports -- internal imports
import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Collectable import Classes.Collectable
import Classes.Prop import Classes.Prop
import Classes.Actor import Classes.Actor
import Classes.Physics
import Types.Graphics.VertexBuffer import Physics.Classes
import Types.Texture
import Graphics.Types.VertexBuffer
import Graphics.Types.Texture
import Graphics.Classes.Drawable
import Graphics.Classes.Bindable
import Util import Util