{-# 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