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

Move config local to Dodge

Browse Source
This commit is contained in:
jgk
2021-03-27 00:34:14 +01:00
parent d603ef549d
commit 32376022cc
10 changed files with 160 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+1 -1
View File
@@ -2,7 +2,6 @@ module Main where
import Loop
import Shader
import Shapes
import LoadConfig
import Dodge.Default
@@ -16,6 +15,7 @@ import Dodge.Event
import Dodge.Rendering
import Dodge.Menu
import Dodge.Floor
import Dodge.LoadConfig
import Picture
import Picture.Render
src/Dodge/AIs.hs
-9
View File
@@ -9,8 +9,6 @@ import Dodge.Event
import Dodge.RandomHelp
import Dodge.WorldEvent
import Dodge.Update.UsingInput
import Geometry
import Picture
@@ -21,15 +19,11 @@ import Data.Function
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Query.SP
import Codec.BMP
import qualified Data.ByteString as B
import Control.Lens
import Control.Applicative
import Control.Monad.State
import Control.Monad
--import Control.Monad.Either
--import Control.Functor.Zip
import qualified SDL as SDL
import System.Random
import qualified Data.Set as S
@@ -39,9 +33,6 @@ import qualified Data.Map as M
import Foreign.ForeignPtr
import Control.Concurrent
import LoadConfig
---}
factionIs :: Faction -> Creature -> Bool
factionIs f c = (_faction $ _crState $ c) == f
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -7,6 +7,7 @@ import Dodge.CreatureAction
import Dodge.Update.UsingInput
import Dodge.Event
import Dodge.CreatureState
import Dodge.LoadConfig
import Geometry
@@ -18,7 +19,6 @@ import System.Random
import Data.Maybe
import LoadConfig
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr = ( (updateUsingInput . f, g)
src/Dodge/Data.hs
+1 -1
View File
@@ -23,7 +23,7 @@ import SDL (Scancode, MouseButton)
import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject)
import Codec.Picture (Image,PixelRGBA8)
import qualified Data.DList as DL
import LoadConfig
import Dodge.LoadConfig
data World = World
{ _keys :: !(S.Set Scancode)
src/Dodge/Default.hs
+1 -1
View File
@@ -20,7 +20,7 @@ import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
import LoadConfig
import Dodge.LoadConfig
-- defalt datatypes / prototypes {{{
defaultWall = Wall { _wlLine = [(0,0),(50,0)]
src/Dodge/Event/Keyboard.hs
+3 -2
View File
@@ -5,11 +5,12 @@ module Dodge.Event.Keyboard
import Dodge.Data
import Dodge.Base
import Dodge.CreatureAction
import Dodge.LoadConfig
import SDL
import Data.Maybe
import qualified Data.Set as S
import Control.Lens
import LoadConfig
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
@@ -50,4 +51,4 @@ pauseGame :: World -> World
pauseGame w = w {_menuState = PauseMenu}
toggleMap w = w & carteDisplay %~ not
escapeMap w = w & carteDisplay .~ False
escapeMap w = w & carteDisplay .~ False
src/Dodge/LoadConfig.hs
+152
View File
@@ -0,0 +1,152 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Dodge.LoadConfig
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/Update/Camera.hs
+1 -1
View File
@@ -14,7 +14,7 @@ import qualified Data.IntMap.Strict as IM
import qualified SDL as SDL
import LoadConfig
import Dodge.LoadConfig
updateCamera :: World -> World
updateCamera = rotCam . moveCamera . updateScopeZoom
src/LoadConfig.hs
-140
View File
@@ -31,143 +31,3 @@ loadConfig = do
Nothing -> do
putStrLn "invalid config.json, loading default config"
return (800, 600)
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/Shapes.hs
-28
View File
@@ -1,28 +0,0 @@
module Shapes where
import Geometry
import Graphics.Rendering.OpenGL
type RGBA = (Float,Float,Float,Float)
data CPoint = CPoint
{cpPoint :: Point3
,cpColor :: RGBA
}
data Shape = Shape PrimitiveMode [CPoint]
| Fade [(Point3,RGBA,Float)]
| Shape' PrimitiveMode [GLfloat]
egTri = Shape TriangleStrip [CPoint (-1,0,0) (1,1,1,1)
,CPoint (0,1,0) (1,1,0,1)
,CPoint (1,0,0) (1,0,1,0)
,CPoint (0.5,-0.5,0) (1,0,1,0)
,CPoint (0.5,-0.5,0) (1,0,1,0)
,CPoint (0.5,-0.5,0) (1,0,1,0)
]
egFade = Fade [((-0.2,-0.2,0),(1,1,1,1),500)
,((0.2,0.2,0),(1,1,1,1),500)
-- ,((0.5,0.5,0),(1,1,1,1),0.5)
-- ,((0.5,0.5,0),(1,1,1,1),0.5)
]