Add toggle for visual sounds
This commit is contained in:
@@ -13,8 +13,8 @@ module Dodge.Config.Data (
|
|||||||
, windowX
|
, windowX
|
||||||
, windowY
|
, windowY
|
||||||
, rotate_to_wall
|
, rotate_to_wall
|
||||||
|
, show_sound
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
--import System.Directory
|
--import System.Directory
|
||||||
@@ -29,6 +29,7 @@ data Configuration = Configuration
|
|||||||
, _windowX :: Float
|
, _windowX :: Float
|
||||||
, _windowY :: Float
|
, _windowY :: Float
|
||||||
, _rotate_to_wall :: Bool
|
, _rotate_to_wall :: Bool
|
||||||
|
, _show_sound :: Bool
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
makeLenses ''Configuration
|
makeLenses ''Configuration
|
||||||
@@ -49,4 +50,5 @@ defaultConfig = Configuration
|
|||||||
, _windowX = 800
|
, _windowX = 800
|
||||||
, _windowY = 600
|
, _windowY = 600
|
||||||
, _rotate_to_wall = True
|
, _rotate_to_wall = True
|
||||||
|
, _show_sound = False
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,16 +0,0 @@
|
|||||||
module Dodge.Creature.ShadowBox
|
|
||||||
where
|
|
||||||
import Dodge.Data
|
|
||||||
import Polyhedra
|
|
||||||
import Geometry
|
|
||||||
|
|
||||||
import qualified Data.IntMap as IM
|
|
||||||
youBox' :: World -> [[Point3]]
|
|
||||||
youBox' w = crToBox' $ _creatures w IM.! 0
|
|
||||||
crToBox' :: Creature -> [[Point3]]
|
|
||||||
crToBox' cr = map (map f . polyToTris) $ boxXYZ 12 12 15
|
|
||||||
where
|
|
||||||
f = (+ V3 (x-6) (y-6) 0)
|
|
||||||
V2 x y = _crPos cr
|
|
||||||
youSil :: World -> [Point3]
|
|
||||||
youSil = constructEdgesList . youBox'
|
|
||||||
@@ -53,6 +53,10 @@ gameplayMenuOptions =
|
|||||||
ScancodeR
|
ScancodeR
|
||||||
(Just . (config . rotate_to_wall %~ not))
|
(Just . (config . rotate_to_wall %~ not))
|
||||||
(\w -> "ROTATE TO WALL:" ++ show (_rotate_to_wall $ _config w))
|
(\w -> "ROTATE TO WALL:" ++ show (_rotate_to_wall $ _config w))
|
||||||
|
, Toggle
|
||||||
|
ScancodeS
|
||||||
|
(Just . (config . show_sound %~ not))
|
||||||
|
(\w -> "SHOW VISUAL SOUNDS:" ++ show (_show_sound $ _config w))
|
||||||
]
|
]
|
||||||
|
|
||||||
soundMenu :: ScreenLayer
|
soundMenu :: ScreenLayer
|
||||||
|
|||||||
@@ -8,7 +8,6 @@ import Dodge.Data
|
|||||||
import Dodge.Config.Data
|
import Dodge.Config.Data
|
||||||
import Dodge.Base.Window
|
import Dodge.Base.Window
|
||||||
import Dodge.Render.Picture
|
import Dodge.Render.Picture
|
||||||
--import Dodge.Creature.ShadowBox
|
|
||||||
import Dodge.Render.Shape
|
import Dodge.Render.Shape
|
||||||
import Geometry
|
import Geometry
|
||||||
import Render
|
import Render
|
||||||
@@ -18,23 +17,12 @@ import Shader.Poke
|
|||||||
import Shader.Bind
|
import Shader.Bind
|
||||||
import Shader.Data
|
import Shader.Data
|
||||||
import MatrixHelper
|
import MatrixHelper
|
||||||
--import Polyhedra.Data
|
|
||||||
import Shader.ExtraPrimitive
|
import Shader.ExtraPrimitive
|
||||||
import Shader.Parameters
|
import Shader.Parameters
|
||||||
|
|
||||||
import Foreign
|
import Foreign
|
||||||
--import Control.Applicative
|
|
||||||
--import Control.Monad.State
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
--import qualified Control.Foldl as F
|
|
||||||
--import Data.Tuple.Extra
|
|
||||||
--import Data.List
|
|
||||||
--import Data.Bifunctor
|
|
||||||
--import Data.Function
|
|
||||||
--import qualified Data.IntMap.Strict as IM
|
|
||||||
--import qualified Data.Map as M
|
|
||||||
--import qualified Data.Set as S
|
|
||||||
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
||||||
import qualified SDL
|
import qualified SDL
|
||||||
import qualified Data.Vector.Unboxed.Mutable as UMV
|
import qualified Data.Vector.Unboxed.Mutable as UMV
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ import Dodge.Picture.Layer
|
|||||||
import Dodge.Render.HUD
|
import Dodge.Render.HUD
|
||||||
import Dodge.Render.MenuScreen
|
import Dodge.Render.MenuScreen
|
||||||
import Dodge.SoundLogic.LoadSound
|
import Dodge.SoundLogic.LoadSound
|
||||||
|
import Dodge.Config.Data
|
||||||
import Sound.Data
|
import Sound.Data
|
||||||
import Geometry
|
import Geometry
|
||||||
import Picture
|
import Picture
|
||||||
@@ -35,6 +36,7 @@ worldPictures w = pictures
|
|||||||
,concatMapPic ppDraw $ _pressPlates w
|
,concatMapPic ppDraw $ _pressPlates w
|
||||||
,concatMapPic btDraw $ _buttons w
|
,concatMapPic btDraw $ _buttons w
|
||||||
,concatMapPic drawWallFloor $ wallFloorsToDraw w
|
,concatMapPic drawWallFloor $ wallFloorsToDraw w
|
||||||
|
,soundPics w
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
crIsClose cr = dist (_crPos cr) camCen < winSize
|
crIsClose cr = dist (_crPos cr) camCen < winSize
|
||||||
@@ -59,8 +61,8 @@ customMouseCursor w =
|
|||||||
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
|
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
|
||||||
|
|
||||||
testPic :: World -> Picture
|
testPic :: World -> Picture
|
||||||
testPic w = pictures
|
testPic _ = pictures
|
||||||
[ soundPics w
|
[
|
||||||
-- , fixedSizePicClampArrow 10 50 thepic (mouseWorldPos w) w
|
-- , fixedSizePicClampArrow 10 50 thepic (mouseWorldPos w) w
|
||||||
]
|
]
|
||||||
-- where
|
-- where
|
||||||
@@ -69,7 +71,9 @@ testPic w = pictures
|
|||||||
--testPic w = color green . pictures . map (flip thickLine 5 . tflat2) . graphToEdges $ _pathGraph w
|
--testPic w = color green . pictures . map (flip thickLine 5 . tflat2) . graphToEdges $ _pathGraph w
|
||||||
|
|
||||||
soundPics :: World -> Picture
|
soundPics :: World -> Picture
|
||||||
soundPics w = pictures $ M.map (soundPic w) $ _playingSounds w
|
soundPics w
|
||||||
|
| _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w
|
||||||
|
| otherwise = []
|
||||||
|
|
||||||
soundPic :: World -> Sound -> Picture
|
soundPic :: World -> Sound -> Picture
|
||||||
soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
|
soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
|
||||||
|
|||||||
@@ -13,7 +13,6 @@ import qualified Data.Map as M
|
|||||||
newtype Polyhedra = Polyhedron
|
newtype Polyhedra = Polyhedron
|
||||||
{ _pyFaces :: [[(Point3,Point4)]]
|
{ _pyFaces :: [[(Point3,Point4)]]
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Describe a polygon as a map from vertex indices to a positioning and list of faces.
|
-- | Describe a polygon as a map from vertex indices to a positioning and list of faces.
|
||||||
-- The list of faces is assumed to be ordered in clockwise direction around the vertex.
|
-- The list of faces is assumed to be ordered in clockwise direction around the vertex.
|
||||||
-- The vertices of the faces are assumed to start with a point adjacent to the
|
-- The vertices of the faces are assumed to start with a point adjacent to the
|
||||||
|
|||||||
@@ -67,7 +67,6 @@ preloadRender = do
|
|||||||
setupVertexAttribPointer 1 4 8 4
|
setupVertexAttribPointer 1 4 8 4
|
||||||
let winColVAO = VAO {_vao = winColVAOname, _vaoVBO = winVBO}
|
let winColVAO = VAO {_vao = winColVAOname, _vaoVBO = winVBO}
|
||||||
-- setup shape geometry/cap VBO and two VAOs
|
-- setup shape geometry/cap VBO and two VAOs
|
||||||
-- TODO when making shaders that use these VAOs, don't mallocate ptr space
|
|
||||||
shEBOname <- genObjectName
|
shEBOname <- genObjectName
|
||||||
shEBOptr <- mallocArray numDrawableElements
|
shEBOptr <- mallocArray numDrawableElements
|
||||||
bindBuffer ElementArrayBuffer $= Just shEBOname
|
bindBuffer ElementArrayBuffer $= Just shEBOname
|
||||||
|
|||||||
Reference in New Issue
Block a user