justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add first compo

Browse Source
This commit is contained in:
jgk
2021-04-14 12:00:12 +02:00
parent c42c5069ea
commit ec7e304b75
15 changed files with 33 additions and 226 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+8 -6
View File
@@ -8,7 +8,8 @@ import Dodge.Initialisation
import Dodge.Update
import Dodge.Event
import Dodge.Render
import Dodge.LoadConfig
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Dodge.Config.Load
import Dodge.Config.Update
import Dodge.LoadSound
@@ -26,7 +27,7 @@ import Foreign (Word32)
import Control.Monad (when,void)
import System.Random
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntMap as IM
import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
import qualified SDL
import qualified SDL.Mixer as Mix
@@ -63,7 +64,7 @@ doSideEffects preData w = do
foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds
& frameTimer .~ endTicks)) (_doneSideEffects w)
doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a)
doPreload' :: Dodge.Config.Data.Configuration -> IO (PreloadData a)
doPreload' config = do
lChunks <- loadSounds
lMusic <- loadMusic
@@ -85,6 +86,7 @@ checkForGlErrors = do
when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World
setWindowSize x y z w = w & windowX .~ fromIntegral x
& windowY .~ fromIntegral y
& keyConfig .~ z
setWindowSize x y z w = w
& windowX .~ fromIntegral x
& windowY .~ fromIntegral y
& keyConfig .~ z
data/music/firstCompo.mid
BIN
View File
Binary file not shown.
src/Dodge/Config/Update.hs
+1 -1
View File
@@ -3,7 +3,7 @@ IO actions that apply config side effects and save configuration settings to dis
-}
module Dodge.Config.Update
where
import Dodge.Data
import Dodge.Data.SoundOrigin
import Dodge.Config.Data
import Sound
import Preload.Data
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Dodge.Base
import Dodge.CreatureAction
import Dodge.Update.UsingInput
import Dodge.CreatureState
import Dodge.LoadConfig
import Dodge.Config.KeyConfig
import Geometry
src/Dodge/Data.hs
+3 -19
View File
@@ -4,14 +4,16 @@
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Menu
, module Dodge.Data.SoundOrigin
, Point2 (..)
, Sound (..)
, soundTime
)
where
import Dodge.Data.Menu
import Dodge.Data.SoundOrigin
import Dodge.Config.Data
import Dodge.LoadConfig.KeyConfig
import Dodge.Config.KeyConfig
import Preload.Data
import Picture.Data
import Geometry.Data
@@ -574,24 +576,6 @@ data ForceField = FF
}
data FFState = FFDestroyable { _ffsHP :: Int }
data SoundOrigin = InventorySound
| BackgroundSound
| OnceSound
| CrSound Int
| CrWeaponSound Int
| WallSound Int
| CrReloadSound Int
| Flamer
| ShellSound Int
| Flame
| LasSound
| FootstepSound Int
| BlockDegradeSound Int
| CrHitSound Int
| BarrelHiss Int
| GlassBreakSound Int
deriving (Eq,Ord,Show)
makeLenses ''World
makeLenses ''Cloud
src/Dodge/Default.hs
+2 -1
View File
@@ -11,7 +11,8 @@ import Dodge.Item.Weapon.Recock
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Base
import Dodge.LoadConfig
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Geometry
import Picture
src/Dodge/Event/Keyboard.hs
+1 -1
View File
@@ -8,7 +8,7 @@ module Dodge.Event.Keyboard
import Dodge.Data
import Dodge.Base
import Dodge.CreatureAction
import Dodge.LoadConfig
import Dodge.Config.KeyConfig
import Dodge.Room.Placement
import Dodge.LightSources
import Dodge.LevelGen
src/Dodge/Event/Menu.hs
+1 -1
View File
@@ -7,7 +7,7 @@ import Dodge.Rooms
import Dodge.Floor
import Dodge.Initialisation
import Dodge.SoundLogic
import Dodge.LoadConfig
import Dodge.Config.Data
import Dodge.Config.Update
import Data.Maybe
src/Dodge/Layout/Tree.hs
+4 -1
View File
@@ -1,9 +1,12 @@
{-|
Combining and composing trees.
-}
module Dodge.Layout.Tree
where
import Data.Tree
import Control.Monad.State
import System.Random
-- Left elements get new children, Right elements inherit the children from the
-- | 'Left' elements get new children, 'Right' elements inherit the children from the
-- mapped over node
expandTreeBy :: (a -> Tree (Either b b)) -> Tree a -> Tree b
expandTreeBy f (Node x []) = fmap removeEither (f x)
src/Dodge/LoadConfig.hs
-30
View File
@@ -1,30 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
module Dodge.LoadConfig
(
module Dodge.LoadConfig.KeyConfig
, module Dodge.Config.Data
) where
import Dodge.LoadConfig.KeyConfig
import Dodge.Config.Data
import Dodge.Config.Update
import Data.Aeson
import System.Directory
loadDodgeConfig :: IO Configuration
loadDodgeConfig = do
fExists <- doesFileExist "data/dodge.config.json"
if fExists
then do
mayConfig <- decodeFileStrict "data/dodge.config.json"
case mayConfig of
Just config -> setVolume config >> return config
Nothing -> do
putStrLn "invalid data/dodge.config.json, loading default config"
return defaultConfig
else do
putStrLn "No data/data/dodge.config.json found, loading defaults"
return defaultConfig
src/Dodge/LoadConfig/KeyConfig.hs
-152
View File
@@ -1,152 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Dodge.LoadConfig.KeyConfig
where
import Data.Aeson
import Foreign.C.Types
import GHC.Generics
import qualified GHC.Int
import qualified SDL
import SDL.Internal.Numbered as SDL.Internal.Numbered
import System.Directory
data KeyConfig = KeyConfig
{ moveUpBinding :: Int,
moveDownBinding :: Int,
moveLeftBinding :: Int,
moveRightBinding :: Int,
pauseBinding :: Int,
escapeBinding :: Int,
dropItemBinding :: Int,
toggleMapBinding :: Int,
reloadBinding :: Int,
testEventBinding :: Int,
spaceActionBinding :: Int,
rotateCameraPlusBinding :: Int,
rotateCameraMinusBinding :: Int,
zoomInBinding :: Int,
zoomOutBinding :: Int,
newBinding :: Int
}
deriving (Generic, Show)
data KeyConfigSDL = KeyConfigSDL
{ moveUpKey :: SDL.Scancode,
moveDownKey :: SDL.Scancode,
moveLeftKey :: SDL.Scancode,
moveRightKey :: SDL.Scancode,
pauseKey :: SDL.Scancode,
escapeKey :: SDL.Scancode,
dropItemKey :: SDL.Scancode,
toggleMapKey :: SDL.Scancode,
reloadKey :: SDL.Scancode,
testEventKey :: SDL.Scancode,
spaceActionKey :: SDL.Scancode,
rotateCameraPlusKey :: SDL.Scancode,
rotateCameraMinusKey :: SDL.Scancode,
zoomInKey :: SDL.Scancode,
zoomOutKey :: SDL.Scancode,
newKey :: SDL.Scancode
}
deriving (Generic, Show)
defaultKeyConfigSDL =
KeyConfigSDL
{ moveUpKey = SDL.ScancodeW,
moveDownKey = SDL.ScancodeS,
moveLeftKey = SDL.ScancodeA,
moveRightKey = SDL.ScancodeD,
pauseKey = SDL.ScancodeP,
escapeKey = SDL.ScancodeEscape,
dropItemKey = SDL.ScancodeF,
toggleMapKey = SDL.ScancodeM,
reloadKey = SDL.ScancodeR,
testEventKey = SDL.ScancodeT,
spaceActionKey = SDL.ScancodeSpace,
rotateCameraPlusKey = SDL.ScancodeQ,
rotateCameraMinusKey = SDL.ScancodeE,
zoomInKey = SDL.ScancodeJ,
zoomOutKey = SDL.ScancodeK,
newKey = SDL.ScancodeN
}
instance ToJSON KeyConfig where
toEncoding = genericToEncoding defaultOptions
instance FromJSON KeyConfig where
parseJSON = withObject "KeyConfig" $ \o -> do
moveUpBinding <- o .:? "moveUp" .!= 119
moveDownBinding <- o .:? "moveDown" .!= 115
moveLeftBinding <- o .:? "moveLeft" .!= 97
moveRightBinding <- o .:? "moveRight" .!= 100
pauseBinding <- o .:? "pause" .!= 112
escapeBinding <- o .:? "escape" .!= 27
dropItemBinding <- o .:? "dropItem" .!= 102
toggleMapBinding <- o .:? "toggleMap" .!= 109
reloadBinding <- o .:? "reload" .!= 114
testEventBinding <- o .:? "testEvent" .!= 116
spaceActionBinding <- o .:? "spaceAction" .!= 32
rotateCameraPlusBinding <- o .:? "rotateCameraPlus" .!= 113
rotateCameraMinusBinding <- o .:? "rotateCameraMinus" .!= 101
zoomInBinding <- o .:? "zoomIn" .!= 106
zoomOutBinding <- o .:? "zoomOut" .!= 107
newBinding <- o .:? "new" .!= 110
return
KeyConfig
{ moveUpBinding = moveUpBinding,
moveDownBinding = moveDownBinding,
moveLeftBinding = moveLeftBinding,
moveRightBinding = moveRightBinding,
pauseBinding = pauseBinding,
escapeBinding = escapeBinding,
dropItemBinding = dropItemBinding,
toggleMapBinding = toggleMapBinding,
reloadBinding = reloadBinding,
testEventBinding = testEventBinding,
spaceActionBinding = spaceActionBinding,
rotateCameraPlusBinding = rotateCameraPlusBinding,
rotateCameraMinusBinding = rotateCameraMinusBinding,
zoomInBinding = zoomInBinding,
zoomOutBinding = zoomOutBinding,
newBinding = newBinding
}
loadKeyConfig :: IO KeyConfigSDL
loadKeyConfig = do
fExists <- doesFileExist "keys.json"
if fExists
then do
mayConfig <- decodeFileStrict "keys.json"
print mayConfig
case mayConfig of
Just config ->
return
KeyConfigSDL
{ moveUpKey = getSdlScancode $ moveUpBinding config,
moveDownKey = getSdlScancode $ moveDownBinding config,
moveLeftKey = getSdlScancode $ moveLeftBinding config,
moveRightKey = getSdlScancode $ moveRightBinding config,
pauseKey = getSdlScancode $ pauseBinding config,
escapeKey = getSdlScancode $ escapeBinding config,
dropItemKey = getSdlScancode $ dropItemBinding config,
toggleMapKey = getSdlScancode $ toggleMapBinding config,
reloadKey = getSdlScancode $ reloadBinding config,
testEventKey = getSdlScancode $ testEventBinding config,
spaceActionKey = getSdlScancode $ spaceActionBinding config,
rotateCameraPlusKey = getSdlScancode $ rotateCameraPlusBinding config,
rotateCameraMinusKey = getSdlScancode $ rotateCameraMinusBinding config,
zoomInKey = getSdlScancode $ zoomInBinding config,
zoomOutKey = getSdlScancode $ zoomOutBinding config,
newKey = getSdlScancode $ newBinding config
}
Nothing -> do
putStrLn "invalid keys.json, loading default config"
-- This is duplicated but not sure how to reduce
return defaultKeyConfigSDL
else do
putStrLn "No keys.json found, loading default config"
return defaultKeyConfigSDL
getSdlScancode :: Int -> SDL.Scancode
getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode
src/Dodge/LoadSound.hs
+1 -1
View File
@@ -104,7 +104,7 @@ loadSounds = do
loadMusic :: IO (IM.IntMap Mix.Music)
loadMusic = do
undercity <- Mix.load "./data/music/undercity.mid"
undercity <- Mix.load "./data/music/firstCompo.mid"
return $ IM.fromList $ zip [0..] $
[ undercity
]
src/Dodge/Render/MenuScreen.hs
+2 -2
View File
@@ -3,9 +3,9 @@ module Dodge.Render.MenuScreen
)
where
import Dodge.Data
import Dodge.LoadConfig
import Dodge.Config.Update
import Dodge.Config.Data
import Dodge.Base (halfWidth,halfHeight)
import Picture
menuScreen :: World -> Picture
src/Dodge/Update/Camera.hs
+1 -5
View File
@@ -2,20 +2,16 @@ module Dodge.Update.Camera where
import Dodge.Data
import Dodge.Base
import Dodge.Config.KeyConfig
import Geometry
import Control.Lens
import Control.Monad
import Data.Maybe
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified SDL as SDL
import Dodge.LoadConfig
updateCamera :: World -> World
updateCamera = rotCam . moveCamera . updateScopeZoom
src/Sound.hs
+8 -5
View File
@@ -106,11 +106,13 @@ decrementTimer s = case _soundTime s of
& soundStatus .~ FadingOut)
Nothing -> return s
applyPosition :: Sound -> IO Sound
applyPosition s = case _soundPos s of
Nothing -> return s
Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d
>> return (s & soundPos .~ Nothing)
applyPosition = return
--applyPosition :: Sound -> IO Sound
--applyPosition s = case _soundPos s of
-- Nothing -> return s
-- Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d
-- >> return (s & soundPos .~ Nothing)
fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
@@ -159,6 +161,7 @@ setChannelPos a i = do
Behind the scenes, scales a float [0,1] to an Int [0..128].
-}
setSoundVolume :: Float -> IO ()
--setSoundVolume x = Mix.setVolume (round (x * 128)) Mix.AllChannels
setSoundVolume x = Mix.setVolume (round (x * 128)) Mix.AllChannels
{- | Set the music volume.