From 1ab8befd8f4fd5a4f8f3a6d40c753619d56bd662 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 29 Apr 2021 20:28:52 +0200 Subject: [PATCH] restructure: moved Graphics and Physics into own subfolders --- pituicat.cabal | 30 +++--- src/Classes.hs | 2 - src/Classes/Actor.hs | 2 +- src/Classes/Collectable.hs | 2 +- src/Classes/Graphics.hs | 8 -- src/Classes/Physics.hs | 6 -- src/Classes/Prop.hs | 2 +- src/Graphics.hs | 6 ++ src/Graphics/Classes.hs | 8 ++ .../Graphics => Graphics/Classes}/Bindable.hs | 2 +- .../Graphics => Graphics/Classes}/Buffer.hs | 4 +- .../Graphics => Graphics/Classes}/Drawable.hs | 4 +- .../Classes}/VertexLayout.hs | 4 +- src/Graphics/Types.hs | 9 ++ .../Types}/IndexBuffer.hs | 6 +- .../Graphics => Graphics/Types}/Shader.hs | 4 +- src/{ => Graphics}/Types/Texture.hs | 4 +- .../Types}/VertexArray.hs | 4 +- .../Types}/VertexBuffer.hs | 8 +- src/Map.hs | 1 + src/Physics.hs | 5 + src/Physics/Classes.hs | 6 ++ .../Physics => Physics/Classes}/Collidible.hs | 4 +- .../Physics => Physics/Classes}/Mass.hs | 2 +- src/Renderer.hs | 3 +- src/Scenes/Test.hs | 1 + src/Scenes/Test/Load.hs | 1 + src/Scenes/Test/Types.hs | 1 + src/Scenes/Test/Update.hs | 1 + src/Scenes/Test/Util.hs | 1 + src/Types.hs | 2 - src/Types/Graphics.hs | 8 -- src/Types/Graphics/Texture.hs | 93 ------------------- src/Types/Map.hs | 8 +- src/Types/Player.hs | 12 ++- src/Types/PowerUp.hs | 11 ++- 36 files changed, 100 insertions(+), 175 deletions(-) delete mode 100644 src/Classes/Graphics.hs delete mode 100644 src/Classes/Physics.hs create mode 100644 src/Graphics.hs create mode 100644 src/Graphics/Classes.hs rename src/{Classes/Graphics => Graphics/Classes}/Bindable.hs (84%) rename src/{Classes/Graphics => Graphics/Classes}/Buffer.hs (94%) rename src/{Classes/Graphics => Graphics/Classes}/Drawable.hs (82%) rename src/{Classes/Graphics => Graphics/Classes}/VertexLayout.hs (83%) create mode 100644 src/Graphics/Types.hs rename src/{Types/Graphics => Graphics/Types}/IndexBuffer.hs (97%) rename src/{Types/Graphics => Graphics/Types}/Shader.hs (98%) rename src/{ => Graphics}/Types/Texture.hs (96%) rename src/{Types/Graphics => Graphics/Types}/VertexArray.hs (85%) rename src/{Types/Graphics => Graphics/Types}/VertexBuffer.hs (97%) create mode 100644 src/Physics.hs create mode 100644 src/Physics/Classes.hs rename src/{Classes/Physics => Physics/Classes}/Collidible.hs (99%) rename src/{Classes/Physics => Physics/Classes}/Mass.hs (98%) delete mode 100644 src/Types/Graphics.hs delete mode 100644 src/Types/Graphics/Texture.hs diff --git a/pituicat.cabal b/pituicat.cabal index 6676dce..544a2b4 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -21,15 +21,9 @@ executable pituicat , Types.Application , Types.Subsystems , Types.Map - , Types.Texture , Types.Cast , Types.StageSet , Types.Tangible - , Types.Graphics - , Types.Graphics.VertexArray - , Types.Graphics.VertexBuffer - , Types.Graphics.IndexBuffer - , Types.Graphics.Shader , Types.Util , Types.Player , Types.PowerUp @@ -38,14 +32,22 @@ executable pituicat , Classes.Actor , Classes.Prop , Classes.Collectable - , Classes.Graphics - , Classes.Graphics.Bindable - , Classes.Graphics.Buffer - , Classes.Graphics.VertexLayout - , Classes.Graphics.Drawable - , Classes.Physics - , Classes.Physics.Mass - , Classes.Physics.Collidible + , Graphics + , Graphics.Types + , Graphics.Types.VertexArray + , Graphics.Types.VertexBuffer + , Graphics.Types.IndexBuffer + , Graphics.Types.Shader + , Graphics.Types.Texture + , 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.Types , Scenes.Test.Util diff --git a/src/Classes.hs b/src/Classes.hs index 9f9c453..a539f78 100644 --- a/src/Classes.hs +++ b/src/Classes.hs @@ -2,9 +2,7 @@ module Classes ( module C ) where -import Classes.Graphics as C import Classes.Scene as C import Classes.Prop as C import Classes.Actor as C -import Classes.Physics as C import Classes.Collectable as C diff --git a/src/Classes/Actor.hs b/src/Classes/Actor.hs index f725845..b11fba8 100644 --- a/src/Classes/Actor.hs +++ b/src/Classes/Actor.hs @@ -3,7 +3,7 @@ module Classes.Actor where -- internal imports import Classes.Prop -import Classes.Physics.Collidible +import Physics.Classes.Collidible class (Prop a, Collidible a) => Actor a where diff --git a/src/Classes/Collectable.hs b/src/Classes/Collectable.hs index 01665ef..dc8d5e8 100644 --- a/src/Classes/Collectable.hs +++ b/src/Classes/Collectable.hs @@ -1,6 +1,6 @@ module Classes.Collectable where -import Classes.Physics.Collidible (Collidible) +import Physics.Classes.Collidible (Collidible) -- | All kinds of Effects present in the game data Effect diff --git a/src/Classes/Graphics.hs b/src/Classes/Graphics.hs deleted file mode 100644 index cbf0779..0000000 --- a/src/Classes/Graphics.hs +++ /dev/null @@ -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 diff --git a/src/Classes/Physics.hs b/src/Classes/Physics.hs deleted file mode 100644 index b67bd6b..0000000 --- a/src/Classes/Physics.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Classes.Physics - ( module P - ) where - -import Classes.Physics.Mass as P -import Classes.Physics.Collidible as P diff --git a/src/Classes/Prop.hs b/src/Classes/Prop.hs index b907c73..a3f078b 100644 --- a/src/Classes/Prop.hs +++ b/src/Classes/Prop.hs @@ -2,7 +2,7 @@ module Classes.Prop where -- internal imports -import Classes.Graphics.Drawable +import Graphics.Classes.Drawable class (Show a, Drawable a) => Prop a where diff --git a/src/Graphics.hs b/src/Graphics.hs new file mode 100644 index 0000000..859d746 --- /dev/null +++ b/src/Graphics.hs @@ -0,0 +1,6 @@ +module Graphics + ( module G + ) where + +import Graphics.Classes as G +import Graphics.Types as G diff --git a/src/Graphics/Classes.hs b/src/Graphics/Classes.hs new file mode 100644 index 0000000..6a5c4d6 --- /dev/null +++ b/src/Graphics/Classes.hs @@ -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 diff --git a/src/Classes/Graphics/Bindable.hs b/src/Graphics/Classes/Bindable.hs similarity index 84% rename from src/Classes/Graphics/Bindable.hs rename to src/Graphics/Classes/Bindable.hs index e590b21..2dbc444 100644 --- a/src/Classes/Graphics/Bindable.hs +++ b/src/Graphics/Classes/Bindable.hs @@ -1,4 +1,4 @@ -module Classes.Graphics.Bindable where +module Graphics.Classes.Bindable where -- | typeclass for bindable objects like buffers, vertex arrays or shaders class Bindable a where diff --git a/src/Classes/Graphics/Buffer.hs b/src/Graphics/Classes/Buffer.hs similarity index 94% rename from src/Classes/Graphics/Buffer.hs rename to src/Graphics/Classes/Buffer.hs index 4f7f34f..181d3c1 100644 --- a/src/Classes/Graphics/Buffer.hs +++ b/src/Graphics/Classes/Buffer.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} -module Classes.Graphics.Buffer where +module Graphics.Classes.Buffer where import qualified Graphics.Rendering.OpenGL as GL @@ -8,7 +8,7 @@ import Foreign.Storable -- internal imports -import Classes.Graphics.Bindable +import Graphics.Classes.Bindable -- | this aims to be a typeclass for all used buffer objects throughout the -- game. all buffer objects have to instanciate the Bindable typeclass. diff --git a/src/Classes/Graphics/Drawable.hs b/src/Graphics/Classes/Drawable.hs similarity index 82% rename from src/Classes/Graphics/Drawable.hs rename to src/Graphics/Classes/Drawable.hs index 1a3862a..f634754 100644 --- a/src/Classes/Graphics/Drawable.hs +++ b/src/Graphics/Classes/Drawable.hs @@ -1,11 +1,11 @@ {-# LANGUAGE TypeFamilies #-} -module Classes.Graphics.Drawable where +module Graphics.Classes.Drawable where import qualified Data.Vector as V -- iternal imports -import Types.Graphics.VertexBuffer (Vertex) +import Graphics.Types.VertexBuffer (Vertex) -- | A typeclass for all drawable objects class Drawable a where diff --git a/src/Classes/Graphics/VertexLayout.hs b/src/Graphics/Classes/VertexLayout.hs similarity index 83% rename from src/Classes/Graphics/VertexLayout.hs rename to src/Graphics/Classes/VertexLayout.hs index 5001ab7..d4a64d1 100644 --- a/src/Classes/Graphics/VertexLayout.hs +++ b/src/Graphics/Classes/VertexLayout.hs @@ -1,13 +1,13 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-} -module Classes.Graphics.VertexLayout where +module Graphics.Classes.VertexLayout where import qualified Graphics.Rendering.OpenGL as GL -- internal imports -import Classes.Graphics.Bindable +import Graphics.Classes.Bindable class (Bindable (VertBuffer v)) => VertexLayout v where diff --git a/src/Graphics/Types.hs b/src/Graphics/Types.hs new file mode 100644 index 0000000..5a12090 --- /dev/null +++ b/src/Graphics/Types.hs @@ -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 diff --git a/src/Types/Graphics/IndexBuffer.hs b/src/Graphics/Types/IndexBuffer.hs similarity index 97% rename from src/Types/Graphics/IndexBuffer.hs rename to src/Graphics/Types/IndexBuffer.hs index ba01478..15e7e1f 100644 --- a/src/Types/Graphics/IndexBuffer.hs +++ b/src/Graphics/Types/IndexBuffer.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -module Types.Graphics.IndexBuffer where +module Graphics.Types.IndexBuffer where import Affection @@ -23,8 +23,8 @@ import Foreign.C.Types -- internal imports -import Classes.Graphics.Bindable -import Classes.Graphics.Buffer +import Graphics.Classes.Bindable +import Graphics.Classes.Buffer -- layout of the IndexBuffer data object data IndexBuffer = IndexBuffer diff --git a/src/Types/Graphics/Shader.hs b/src/Graphics/Types/Shader.hs similarity index 98% rename from src/Types/Graphics/Shader.hs rename to src/Graphics/Types/Shader.hs index 0747ded..00b4dfa 100644 --- a/src/Types/Graphics/Shader.hs +++ b/src/Graphics/Types/Shader.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} -module Types.Graphics.Shader where +module Graphics.Types.Shader where import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.GL as GLRaw @@ -19,7 +19,7 @@ import Foreign.Storable -- internal imports -import Classes.Graphics.Bindable +import Graphics.Classes.Bindable data Shader = Shader { shaderId :: GL.Program diff --git a/src/Types/Texture.hs b/src/Graphics/Types/Texture.hs similarity index 96% rename from src/Types/Texture.hs rename to src/Graphics/Types/Texture.hs index 99d1aef..1b38d3a 100644 --- a/src/Types/Texture.hs +++ b/src/Graphics/Types/Texture.hs @@ -1,4 +1,4 @@ -module Types.Texture where +module Graphics.Types.Texture where import SDL (($=)) @@ -15,7 +15,7 @@ import Foreign -- internal imports -import Classes.Graphics.Bindable +import Graphics.Classes.Bindable data Texture = Texture { textureId :: GL.TextureObject diff --git a/src/Types/Graphics/VertexArray.hs b/src/Graphics/Types/VertexArray.hs similarity index 85% rename from src/Types/Graphics/VertexArray.hs rename to src/Graphics/Types/VertexArray.hs index 1a552c6..5215c0b 100644 --- a/src/Types/Graphics/VertexArray.hs +++ b/src/Graphics/Types/VertexArray.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-} -module Types.Graphics.VertexArray where +module Graphics.Types.VertexArray where import qualified Graphics.Rendering.OpenGL as GL @@ -7,7 +7,7 @@ import SDL (($=)) -- internal imports -import Classes.Graphics.Bindable +import Graphics.Classes.Bindable newtype VertexArray = VertexArray { vArrId :: GL.VertexArrayObject diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Graphics/Types/VertexBuffer.hs similarity index 97% rename from src/Types/Graphics/VertexBuffer.hs rename to src/Graphics/Types/VertexBuffer.hs index 7b9796c..075d7a8 100644 --- a/src/Types/Graphics/VertexBuffer.hs +++ b/src/Graphics/Types/VertexBuffer.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -module Types.Graphics.VertexBuffer where +module Graphics.Types.VertexBuffer where import qualified Graphics.Rendering.OpenGL as GL @@ -24,9 +24,9 @@ import GHC.Generics -- internal imports -import Classes.Graphics.Bindable -import Classes.Graphics.Buffer -import Classes.Graphics.VertexLayout +import Graphics.Classes.Bindable +import Graphics.Classes.Buffer +import Graphics.Classes.VertexLayout -- | layout of the VertexBuffer data object data VertexBuffer = VertexBuffer diff --git a/src/Map.hs b/src/Map.hs index 3c0ba90..5a5da0e 100644 --- a/src/Map.hs +++ b/src/Map.hs @@ -15,6 +15,7 @@ import Control.Monad (foldM) -- internal imports import Types +import Graphics constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap constructMap desc tilemapSlot = do diff --git a/src/Physics.hs b/src/Physics.hs new file mode 100644 index 0000000..31b0b3f --- /dev/null +++ b/src/Physics.hs @@ -0,0 +1,5 @@ +module Physics + ( module P + ) where + +import Physics.Classes as P diff --git a/src/Physics/Classes.hs b/src/Physics/Classes.hs new file mode 100644 index 0000000..ef3a39e --- /dev/null +++ b/src/Physics/Classes.hs @@ -0,0 +1,6 @@ +module Physics.Classes + ( module PC + ) where + +import Physics.Classes.Mass as PC +import Physics.Classes.Collidible as PC diff --git a/src/Classes/Physics/Collidible.hs b/src/Physics/Classes/Collidible.hs similarity index 99% rename from src/Classes/Physics/Collidible.hs rename to src/Physics/Classes/Collidible.hs index 3597272..9e9a7f8 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Physics/Classes/Collidible.hs @@ -1,6 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE OverloadedStrings #-} -module Classes.Physics.Collidible where +module Physics.Classes.Collidible where import Affection as A @@ -10,7 +10,7 @@ import Data.String (fromString) -- internal imports -import Classes.Physics.Mass +import Physics.Classes.Mass data CollisionResult time direction = NoCollision diff --git a/src/Classes/Physics/Mass.hs b/src/Physics/Classes/Mass.hs similarity index 98% rename from src/Classes/Physics/Mass.hs rename to src/Physics/Classes/Mass.hs index c1d6a08..7fa016c 100644 --- a/src/Classes/Physics/Mass.hs +++ b/src/Physics/Classes/Mass.hs @@ -1,4 +1,4 @@ -module Classes.Physics.Mass where +module Physics.Classes.Mass where import Linear diff --git a/src/Renderer.hs b/src/Renderer.hs index 8b8245f..8b84ec0 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -9,8 +9,7 @@ import Foreign.Ptr -- internal imports -import Classes.Graphics -import Types.Graphics +import Graphics draw :: VertexArray -> IndexBuffer -> Shader -> IO () draw va ib sp = do diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index 32035c2..d250984 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -20,6 +20,7 @@ import Control.Concurrent.STM import Types import Classes +import Graphics import Renderer as R import Scenes.Test.Types as Test import Scenes.Test.Util as Test diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index ee9ae54..19d53a9 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -16,6 +16,7 @@ import Linear import Types import Classes +import Graphics import Map import Scenes.Test.Types import Scenes.Test.Util diff --git a/src/Scenes/Test/Types.hs b/src/Scenes/Test/Types.hs index 5bbe436..f7e91b0 100644 --- a/src/Scenes/Test/Types.hs +++ b/src/Scenes/Test/Types.hs @@ -11,6 +11,7 @@ import qualified Data.Vector as V -- internal imports import Types +import Graphics data Test = Test { testMap :: TMVar LevelMap diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index a760564..24a3509 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -19,6 +19,7 @@ import Linear import Scenes.Test.Types import Classes import Types +import Physics update :: Test diff --git a/src/Scenes/Test/Util.hs b/src/Scenes/Test/Util.hs index dd003c9..e148137 100644 --- a/src/Scenes/Test/Util.hs +++ b/src/Scenes/Test/Util.hs @@ -16,6 +16,7 @@ import Control.Arrow ((***)) import Classes import Types +import Graphics testLevelDesc :: LevelDescriptor testLevelDesc = LevelDescriptor diff --git a/src/Types.hs b/src/Types.hs index c60de68..d9451bf 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -5,10 +5,8 @@ module Types import Types.Application as T import Types.Subsystems as T import Types.Map as T -import Types.Texture as T import Types.Cast as T import Types.StageSet as T -import Types.Graphics as T import Types.Player as T import Types.Util as T import Types.PowerUp as T diff --git a/src/Types/Graphics.hs b/src/Types/Graphics.hs deleted file mode 100644 index 1dde1a0..0000000 --- a/src/Types/Graphics.hs +++ /dev/null @@ -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 diff --git a/src/Types/Graphics/Texture.hs b/src/Types/Graphics/Texture.hs deleted file mode 100644 index dbd4b91..0000000 --- a/src/Types/Graphics/Texture.hs +++ /dev/null @@ -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_) diff --git a/src/Types/Map.hs b/src/Types/Map.hs index db79173..27fbe15 100644 --- a/src/Types/Map.hs +++ b/src/Types/Map.hs @@ -8,10 +8,10 @@ import Linear -- internal imports -import Types.Texture -import Types.Graphics.VertexBuffer -import Classes.Graphics.Drawable -import Classes.Physics +import Graphics.Types.Texture +import Graphics.Types.VertexBuffer +import Graphics.Classes.Drawable +import Physics.Classes data LevelMap = LevelMap { mapLayers :: V.Vector Layer -- ^ Layer stack diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 7f24f96..9bfaa0a 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -13,15 +13,17 @@ import Data.String (fromString) import Util -import Classes.Graphics.Drawable -import Classes.Graphics.Bindable import Classes.Prop import Classes.Actor -import Classes.Physics import Classes.Collectable -import Types.Graphics.VertexBuffer -import Types.Texture +import Graphics.Classes.Drawable +import Graphics.Classes.Bindable +import Graphics.Types.VertexBuffer +import Graphics.Types.Texture + +import Physics.Classes + import Types.Subsystems catMoveVelocity :: Double diff --git a/src/Types/PowerUp.hs b/src/Types/PowerUp.hs index c47069a..2358f6c 100644 --- a/src/Types/PowerUp.hs +++ b/src/Types/PowerUp.hs @@ -6,15 +6,16 @@ import Linear -- internal imports -import Classes.Graphics.Drawable -import Classes.Graphics.Bindable import Classes.Collectable import Classes.Prop import Classes.Actor -import Classes.Physics -import Types.Graphics.VertexBuffer -import Types.Texture +import Physics.Classes + +import Graphics.Types.VertexBuffer +import Graphics.Types.Texture +import Graphics.Classes.Drawable +import Graphics.Classes.Bindable import Util