158 lines
5.8 KiB
Haskell
158 lines
5.8 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
--{-# LANGUAGE OverloadedStrings #-}
|
|
module Dodge.Config.KeyConfig
|
|
where
|
|
--import Data.Aeson
|
|
--import Foreign.C.Types
|
|
import GHC.Generics
|
|
--import qualified GHC.Int
|
|
import qualified SDL
|
|
--import qualified 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
|
|
, newMapKey :: SDL.Scancode
|
|
, modifierKey :: SDL.Scancode
|
|
}
|
|
deriving (Generic, Show)
|
|
|
|
defaultKeyConfigSDL :: KeyConfigSDL
|
|
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
|
|
, newMapKey = SDL.ScancodeN
|
|
, modifierKey = SDL.ScancodeCapsLock
|
|
}
|
|
|
|
--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 = return defaultKeyConfigSDL
|
|
|
|
--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
|