Move config local to Dodge

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

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
 

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)

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)

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)]

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
+escapeMap w = w & carteDisplay .~ False

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

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

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

src/Shapes.hs

@@ -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)
-              ]