diff --git a/app/Main.hs b/app/Main.hs index 3b73e7975..9ebbef507 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 23ae88708..05813ba79 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -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 diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 2e7c9c268..c4fff2f58 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -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) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bab1d2c66..e383132bd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index f31aaac35..8bac01a8f 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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)] diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 4d19b0ec9..62772eee2 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -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 \ No newline at end of file +escapeMap w = w & carteDisplay .~ False diff --git a/src/Dodge/LoadConfig.hs b/src/Dodge/LoadConfig.hs new file mode 100644 index 000000000..e4b61a7a8 --- /dev/null +++ b/src/Dodge/LoadConfig.hs @@ -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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8ad77d62b..209379dff 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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 diff --git a/src/LoadConfig.hs b/src/LoadConfig.hs index 0ffc9126a..72983344b 100644 --- a/src/LoadConfig.hs +++ b/src/LoadConfig.hs @@ -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 diff --git a/src/Shapes.hs b/src/Shapes.hs deleted file mode 100644 index 64317f928..000000000 --- a/src/Shapes.hs +++ /dev/null @@ -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) - ]