From 5620e45e0aaa284180f1f07795a4b418bda5048c Mon Sep 17 00:00:00 2001 From: Ross Date: Wed, 24 Mar 2021 18:49:10 +0000 Subject: [PATCH 1/3] rebase keyconfig changes --- .gitignore | 1 + app/Main.hs | 10 ++- src/Dodge/AIs.hs | 30 ++++--- src/Dodge/Data.hs | 3 + src/Dodge/Default.hs | 3 + src/Dodge/Event/Keyboard.hs | 44 ++++------ src/Dodge/Menu.hs | 18 ++-- src/Dodge/Update/Camera.hs | 10 ++- src/LoadConfig.hs | 169 +++++++++++++++++++++++++++++++++--- 9 files changed, 218 insertions(+), 70 deletions(-) diff --git a/.gitignore b/.gitignore index 865d83a65..4a9ea7dfa 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ *.swp loop.cabal *.lock +keys.json diff --git a/app/Main.hs b/app/Main.hs index 63ba27918..3788cc0fc 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -36,17 +36,20 @@ import qualified SDL import qualified SDL.Mixer as Mix import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) +import LoadConfig + cursorVis :: Bool -> IO () cursorVis b = SDL.cursorVisible $= b main :: IO () main = do (sizex,sizey) <- loadConfig + keyConfig <- loadKeyConfig setupLoop (sizex,sizey) (cursorVis False >> doPreload >>= resizeSpareFBO sizex sizey) (\x -> cursorVis True >> cleanUpPreload x) - (fmap (setWindowSize sizex sizey) firstWorld) + (fmap (setWindowSize sizex sizey keyConfig) firstWorld) ( \preData w -> do startTicks <- SDL.ticks clear [ColorBuffer,DepthBuffer] @@ -82,6 +85,7 @@ checkForGlErrors = do errs <- errors when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs) -setWindowSize :: Int -> Int -> World -> World -setWindowSize x y w = w & windowX .~ fromIntegral x +setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World +setWindowSize x y z w = w & windowX .~ fromIntegral x & windowY .~ fromIntegral y + & keyConfig .~ z diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 284e277f9..086c7cc26 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -39,6 +39,8 @@ import qualified Data.Map as M import Foreign.ForeignPtr import Control.Concurrent + +import LoadConfig ---} factionIs :: Faction -> Creature -> Bool @@ -225,9 +227,9 @@ spawnerAI spawn w (f,g) cr = placeCrFaction :: Creature -> Faction -> Point2 -> Point2 -> Float -> World -> World placeCrFaction cr fact p op rot w = over creatures addCr w - where addCr crs = IM.insert (newKey crs) + where addCr crs = IM.insert (Dodge.Base.newKey crs) ( set (crState . faction) fact - $ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = newKey crs} + $ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = Dodge.Base.newKey crs} ) crs @@ -1923,7 +1925,7 @@ wasdWithAiming w speed aimSpeed i cr = -- stopSoundFrom (CrSound i) $ over ( crDir) (flip fromMaybe dir) cr - where (mov',dir') = wasdComp $ view keys w + where (mov',dir') = wasdComp (view keys w) w (mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir') isMoving = mov' /= (0,0) isAiming = (_posture $ _stance $ _crState cr) == Aiming @@ -1935,15 +1937,21 @@ wasdWithAiming w speed aimSpeed i cr _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w -wasdM :: SDL.Scancode -> Point2 -wasdM SDL.ScancodeW = (0,1) -wasdM SDL.ScancodeS = (0,-1) -wasdM SDL.ScancodeD = (1,0) -wasdM SDL.ScancodeA = (-1,0) -wasdM _ = (0,0) +wasdM :: World -> SDL.Scancode -> Point2 +wasdM w scancode + | scancode == moveUpKey (_keyConfig w) = (0,1) + | scancode == moveDownKey (_keyConfig w) = (0,-1) + | scancode == moveRightKey (_keyConfig w) = (1,0) + | scancode == moveLeftKey (_keyConfig w) = (-1,0) +wasdM _ _ = (0,0) +--wasdM SDL.ScancodeW = (0,1) +--wasdM SDL.ScancodeS = (0,-1) +--wasdM SDL.ScancodeD = (1,0) +--wasdM SDL.ScancodeA = (-1,0) +--wasdM _ = (0,0) -wasdComp :: S.Set SDL.Scancode -> (Point2,Maybe Float) -wasdComp ks = f $ foldr ( (+.+) . wasdM ) (0,0) ks +wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float) +wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks where f (0,0) = ((0,0), Nothing) f p = (errorNormalizeV 46 p, Just $ argV p) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 5fc2dcc0e..d75953019 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -33,6 +33,8 @@ import Codec.Picture (Image,PixelRGBA8) import qualified Data.DList as DL +import LoadConfig + --}}} -- datatypes {{{ data World = World @@ -85,6 +87,7 @@ data World = World , _closeActiveObjects :: [Either FloorItem Button] , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int + , _keyConfig :: KeyConfigSDL } data Corpse = Corpse diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index cdf2696d8..5f99c6e0e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -20,6 +20,8 @@ import qualified Data.Set as S import Data.Graph.Inductive.Graph hiding ((&)) import Data.List +import LoadConfig + -- defalt datatypes / prototypes {{{ defaultWall = Wall { _wlLine = [(0,0),(50,0)] , _wlID = 0 @@ -229,6 +231,7 @@ defaultWorld = World ,(1, (const (0,0) , "START POSITION")) ] , _selLocation = 0 + , _keyConfig = defaultKeyConfigSDL } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 1fc9e8c34..4d19b0ec9 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -9,6 +9,7 @@ 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 @@ -22,18 +23,19 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of handlePressedKey :: Bool -> Scancode -> World -> Maybe World handlePressedKey True _ w = Just w -handlePressedKey _ keycode w = case keycode of - ScancodeEscape -> Nothing - ScancodeC -> Just $ pauseGame $ escapeMap w - ScancodeF -> Just $ dropItem w - ScancodeM -> Just $ toggleMap w - ScancodeP -> Just $ pauseGame $ escapeMap w - ScancodeR -> Just $ fromMaybe w $ reloadWeapon (_yourID w) w - ScancodeT -> Just $ testEvent w - ScancodeSpace -> Just $ spaceAction w - ScancodeQ -> Just $ w & cameraRot +~ 0.01 - ScancodeE -> Just $ w & cameraRot -~ 0.01 - _ -> Just w +handlePressedKey _ scancode w + | scancode == escapeKey (_keyConfig w) = Nothing + | scancode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w + | scancode == dropItemKey (_keyConfig w) = Just $ dropItem w + | scancode == toggleMapKey (_keyConfig w) = Just $ toggleMap w + | scancode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w + | scancode == testEventKey (_keyConfig w) = Just $ testEvent w + | scancode == spaceActionKey (_keyConfig w) = Just $ spaceAction w + -- Rotation seems to be duplicated here and in Camera.hs ? why + | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} + | scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} +handlePressedKey _ _ w = Just w + spaceAction :: World -> World spaceAction w = case listToMaybe $ _closeActiveObjects w of @@ -48,20 +50,4 @@ pauseGame :: World -> World pauseGame w = w {_menuState = PauseMenu} toggleMap w = w & carteDisplay %~ not -escapeMap w = w & carteDisplay .~ False - --- Basic key remapping for a dvorak key layout -keyremap :: Keycode -> Keycode -keyremap KeycodeComma = KeycodeW -keyremap KeycodeA = KeycodeA -keyremap KeycodeE = KeycodeD -keyremap KeycodeO = KeycodeS -keyremap KeycodeSlash = KeycodeQ -keyremap KeycodePeriod = KeycodeE -keyremap KeycodeP = KeycodeR -keyremap KeycodeU = KeycodeF -keyremap k = k - -keyremapDefault :: Keycode -> Keycode -keyremapDefault k = k - +escapeMap w = w & carteDisplay .~ False \ No newline at end of file diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 068ff7e90..7bc784a3b 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -22,28 +22,28 @@ import System.Random import SDL -- }}} -keyPressedDown :: Event -> Maybe Keycode +keyPressedDown :: Event -> Maybe Scancode keyPressedDown e = case eventPayload e of - KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymKeycode keysym + KeyboardEvent (KeyboardEventData _ Pressed False keysym) -> Just $ keysymScancode keysym _ -> Nothing menuEvents :: (Event -> World -> Maybe World) -> Event -> World -> Maybe World menuEvents f e w = case _menuState w of LevelMenu _ -> case keyPressedDown e of - Just KeycodeEscape -> Nothing + Just ScancodeEscape -> Nothing Just _ -> startLevel w >>= f e _ -> Just w PauseMenu -> case keyPressedDown e of - Just KeycodeEscape -> Nothing - Just KeycodeR -> return $ fromMaybe w $ _storedLevel w - Just KeycodeN -> Just $ putSound $ generateLevel 1 + Just ScancodeEscape -> Nothing + Just ScancodeR -> return $ fromMaybe w $ _storedLevel w + Just ScancodeN -> Just $ putSound $ generateLevel 1 $ initialWorld {_randGen = _randGen w} Just _ -> unpause w >>= f e _ -> Just w GameOverMenu -> case keyPressedDown e of - Just KeycodeEscape -> Nothing - Just KeycodeR -> Just $ fromMaybe w $ _storedLevel w - Just KeycodeN -> Just $ putSound $ generateLevel 1 + Just ScancodeEscape -> Nothing + Just ScancodeR -> Just $ fromMaybe w $ _storedLevel w + Just ScancodeN -> Just $ putSound $ generateLevel 1 $ initialWorld {_randGen = _randGen w} _ -> return w diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index c58cbc709..d99feeac9 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -14,6 +14,8 @@ import qualified Data.IntMap.Strict as IM import qualified SDL as SDL +import LoadConfig + updateCamera :: World -> World updateCamera = rotCam . moveCamera . updateAimTime . updateScopeZoom @@ -98,23 +100,23 @@ zoomOutLongGun w | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just . rotCam = rotateCameraL . rotateCameraR . zoomCamIn . zoomCamOut . autoZoomCam rotateCameraL :: World -> World -rotateCameraL w | SDL.ScancodeQ `S.member` _keys w +rotateCameraL w | rotateCameraPlusKey (_keyConfig w) `S.member` _keys w = w & cameraRot +~ 0.015 & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV 0.015 | otherwise = w rotateCameraR :: World -> World -rotateCameraR w | SDL.ScancodeE `S.member` _keys w +rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `S.member` _keys w = w & cameraRot -~ 0.015 & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV (-0.015) | otherwise = w zoomCamIn :: World -> World -zoomCamIn w | SDL.ScancodeJ `S.member` _keys w +zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w = w {_cameraZoom = _cameraZoom w + 0.01} | otherwise = w zoomCamOut :: World -> World -zoomCamOut w | SDL.ScancodeK `S.member` _keys w +zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w = w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01} | otherwise = w diff --git a/src/LoadConfig.hs b/src/LoadConfig.hs index d8582d888..32aef16f4 100644 --- a/src/LoadConfig.hs +++ b/src/LoadConfig.hs @@ -1,24 +1,165 @@ {-# LANGUAGE DeriveGeneric #-} -module LoadConfig - where +{-# LANGUAGE OverloadedStrings #-} + +module LoadConfig where + import Data.Aeson -import GHC.Generics import Foreign.C.Types +import GHC.Generics +import qualified GHC.Int +import qualified SDL +import SDL.Internal.Numbered as SDL.Internal.Numbered data Configuration = Configuration - { windowxsize :: Int - , windowysize :: Int - } deriving (Generic, Show) + { windowxsize :: Int, + windowysize :: Int + } + deriving (Generic, Show) instance ToJSON Configuration where - toEncoding = genericToEncoding defaultOptions + toEncoding = genericToEncoding defaultOptions + instance FromJSON Configuration -loadConfig :: IO (Int,Int) +loadConfig :: IO (Int, Int) loadConfig = do - mayConfig <- decodeFileStrict "config.json" - case mayConfig of - Just config -> return (windowxsize config,windowysize config) - Nothing -> do - putStrLn "invalid config.json, loading default config" - return (800,600) + mayConfig <- decodeFileStrict "config.json" + case mayConfig of + Just config -> return (windowxsize config, windowysize config) + 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 + 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 + +getSdlScancode :: Int -> SDL.Scancode +getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode \ No newline at end of file From 485952fe53a61c22612322d053dd2b20c7b80416 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 26 Mar 2021 20:02:27 +0100 Subject: [PATCH 2/3] Add System.Directory library, allow for testing file existence --- package.yaml | 1 + src/LoadConfig.hs | 62 ++++++++++++++++++++++++++--------------------- 2 files changed, 35 insertions(+), 28 deletions(-) diff --git a/package.yaml b/package.yaml index 079f494fd..4e1a8d080 100644 --- a/package.yaml +++ b/package.yaml @@ -45,6 +45,7 @@ dependencies: - foldl - linear - aeson +- directory library: source-dirs: src diff --git a/src/LoadConfig.hs b/src/LoadConfig.hs index 32aef16f4..cb69f5469 100644 --- a/src/LoadConfig.hs +++ b/src/LoadConfig.hs @@ -10,6 +10,8 @@ import qualified GHC.Int import qualified SDL import SDL.Internal.Numbered as SDL.Internal.Numbered +import System.Directory + data Configuration = Configuration { windowxsize :: Int, windowysize :: Int @@ -133,33 +135,37 @@ instance FromJSON KeyConfig where loadKeyConfig :: IO KeyConfigSDL loadKeyConfig = 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 + 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 return defaultKeyConfigSDL getSdlScancode :: Int -> SDL.Scancode -getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode \ No newline at end of file +getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode From ca949a9d2b74e881cca1b62d30848738e5f95489 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 26 Mar 2021 20:06:48 +0100 Subject: [PATCH 3/3] Add print statement --- src/LoadConfig.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/LoadConfig.hs b/src/LoadConfig.hs index cb69f5469..0ffc9126a 100644 --- a/src/LoadConfig.hs +++ b/src/LoadConfig.hs @@ -165,7 +165,9 @@ loadKeyConfig = do putStrLn "invalid keys.json, loading default config" -- This is duplicated but not sure how to reduce return defaultKeyConfigSDL - else 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