loop/src/Dodge/LoadConfig/KeyConfig.hs

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