SDL.hs

module Interpreter.Lib.SDL where

import Control.Monad.IO.Class
import Control.Monad.Loops
import Control.Monad.State.Strict
import qualified Data.ByteString as BS
import System.Process (createPipe)
import Data.Coerce
import Data.IORef
import Data.Int (Int32)
import qualified Data.List as DL
import qualified Data.Map as M
import Data.Maybe
import Data.WAVE
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Data.Word
import Foreign.C.Types
import SDL hiding (Keycode, Scancode, get)
import qualified SDL
import SDL.Mixer as SDLM

import Interpreter.Common
import Interpreter.Interpreter

makeSinWaveChunk :: Double -> BS.ByteString
makeSinWaveChunk freq = BS.pack $
  fmap (\n ->
         let t = fromIntegral n / 22050 :: Double
         in round $ 127 + (127 * sin (2 * pi * freq * t)))
      [0 :: Int32 .. 22050]

createGraphicsWindow :: BuiltInFnWithDoc ['("width", Int), '("height", Int), '("accelerated", Maybe Bool)]
createGraphicsWindow ((coerce -> w) :> (coerce -> h) :>  (coerce -> maccelerated) :>_) =
  initGraphics (Just (w, h)) False (fromMaybe False maccelerated)

createGraphicsFullscrenRes :: BuiltInFnWithDoc ['("width", Int), '("height", Int), '("accelerated", Maybe Bool)]
createGraphicsFullscrenRes ((coerce -> w) :> (coerce -> h) :> (coerce -> maccelerated) :>_) =
  initGraphics (Just (w, h)) True (fromMaybe False maccelerated)

createGraphicsFullscreen :: BuiltInFnWithDoc '[ '("accelerated", Maybe Bool)]
createGraphicsFullscreen ((coerce -> maccelerated) :>_) =
  initGraphics Nothing True (fromMaybe False maccelerated)

initGraphics :: Maybe (Int, Int) -> Bool -> Bool -> InterpretM (Maybe Value)
initGraphics md isfulscren acc = do
  let windowName = "S.P.A.D.E Program"
  (renderer, window) <- liftIO $ do
    SDL.initialize [SDL.InitVideo, SDL.InitAudio, SDL.InitEvents, SDL.InitTimer]
    SDLM.openAudio SDLM.defaultAudio 256
    window <- if isfulscren
      then case md of
        Just (w, h) -> SDL.createWindow windowName (fullscreenConfigRes (fromIntegral w) (fromIntegral h))
        Nothing     -> SDL.createWindow windowName fullscreenConfig
      else case md of
        Just (w, h) -> SDL.createWindow windowName (windowConfig w h)
        Nothing     -> SDL.createWindow windowName (windowConfig 800 600)
    renderer <- case acc of
      True -> SDL.createRenderer window (-1) SDL.defaultRenderer
      _ -> SDL.createRenderer window (-1) $ SDL.defaultRenderer { rendererType = SoftwareRenderer }
    pure (renderer, window)
  sdlWindowRefs <- isSDLWindows <$> get
  liftIO $ modifyIORef sdlWindowRefs (\l -> (window : l))
  modify (\x -> x
    { isDefaultWindow = Just window
    , isDefaultRenderer = Just renderer
    , isAccelerated = Just acc
    })
  pure $ Just $ SDLValue $ Renderer renderer

fullscreenConfig :: SDL.WindowConfig
fullscreenConfig = SDL.defaultWindow
  { windowHighDPI = False
  , windowMode = FullscreenDesktop
  }

fullscreenConfigRes :: CInt -> CInt -> SDL.WindowConfig
fullscreenConfigRes x y = SDL.defaultWindow
  { windowHighDPI = False
  , windowMode = FullscreenDesktop
  , windowInitialSize = V2 x y
  }

windowConfig :: Int -> Int -> SDL.WindowConfig
windowConfig w h = SDL.defaultWindow
  { windowHighDPI = False
  , windowInitialSize = (SDL.V2 (fromIntegral w) (fromIntegral h))
  , windowMode = Windowed
  }

setLogicalSize :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt)]
setLogicalSize ((coerce -> (lx :: CInt)) :> (coerce -> (ly :: CInt)) :> _) =
  isDefaultRenderer <$> get >>= \case
    Just renderer  -> do
      SDL.V2 x y <- getWindowSize'
      SDL.rendererScale renderer SDL.$= (SDL.V2 (realToFrac x/realToFrac lx) (realToFrac y/realToFrac ly))
      pure Nothing
    Nothing -> throwErr $ SDLError "Graphics not Initialized"

loadTexture' :: FilePath -> InterpretM Value
loadTexture' fp = do
  renderer <- getDefaultRenderer
  surface <- SDL.loadBMP fp
  texture <- SDL.createTextureFromSurface renderer surface
  pure $ SDLValue $ Texture texture

textureInfo' :: SDL.Texture -> InterpretM (CInt, CInt)
textureInfo' texture = do
  ti <- SDL.queryTexture texture
  pure (SDL.textureWidth ti, SDL.textureHeight ti)

copyTexture' :: SDL.Texture -> CInt -> CInt -> CInt -> CInt -> InterpretM ()
copyTexture' texture x y w h = do
  renderer <- getDefaultRenderer
  SDL.copy renderer texture Nothing (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))

copyTexturePart' :: SDL.Texture -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> InterpretM ()
copyTexturePart' texture sx sy sw sh x y w h = do
  renderer <- getDefaultRenderer
  SDL.copy renderer texture
    (Just $ SDL.Rectangle (SDL.P (SDL.V2 sx sy)) (SDL.V2 sw sh))
    (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))

copyTextureRotated'
  :: SDL.Texture
  -> CInt
  -> CInt
  -> CInt
  -> CInt
  -> CInt
  -> CInt
  -> CInt
  -> CInt
  -> CDouble
  -> CInt
  -> CInt
  -> Bool
  -> Bool
  -> InterpretM ()
copyTextureRotated' texture sx sy sw sh x y w h rotationDeg rx ry fx fy = do
  renderer <- getDefaultRenderer
  SDL.copyEx renderer texture
    (Just $ SDL.Rectangle (SDL.P (SDL.V2 sx sy)) (SDL.V2 sw sh))
    (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))
    rotationDeg
    (Just $ mkPoint rx ry)
    (SDL.V2 fx fy)

loadTexture :: BuiltInFnWithDoc '[ '("bmp_file", FilePath)]
loadTexture ((coerce -> fp) :> EmptyArgs) =
  Just <$> loadTexture' fp

destroyTexture :: BuiltInFnWithDoc '[ '("texture", SDL.Texture)]
destroyTexture ((coerce -> texture) :> EmptyArgs) = do
  SDL.destroyTexture texture
  pure Nothing

textureInfo :: BuiltInFnWithDoc
  '[ '("texture", SDL.Texture)
   ]
textureInfo
  ( (coerce -> texture) :> EmptyArgs) = do
    (w, h) <- textureInfo' texture
    pure $ Just $ ObjectValue $ M.fromList
      [ ("width", NumberValue $ NumberInt $ fromIntegral w)
      , ("height", NumberValue $ NumberInt $ fromIntegral h)
      ]

copyTexture :: BuiltInFnWithDoc
  '[ '("texture", SDL.Texture)
   , '("dst_x", CInt)
   , '("dst_y", CInt)
   , '("dst_w", CInt)
   , '("dst_h", CInt)
   ]
copyTexture
  ( (coerce -> texture)
  :> (coerce -> dx)
  :> (coerce -> dy)
  :> (coerce -> dh)
  :> (coerce -> dw)
  :> EmptyArgs) = do
  copyTexture' texture dx dy dh dw
  pure Nothing

copyTexturePart :: BuiltInFnWithDoc
  '[ '("texture", SDL.Texture)
   , '("src_x", CInt)
   , '("src_y", CInt)
   , '("src_w", CInt)
   , '("src_h", CInt)

   , '("dst_x", CInt)
   , '("dst_y", CInt)
   , '("dst_w", CInt)
   , '("dst_h", CInt)
   ]
copyTexturePart
  ( (coerce -> texture)

  :> (coerce -> sx)
  :> (coerce -> sy)
  :> (coerce -> sh)
  :> (coerce -> sw)

  :> (coerce -> dx)
  :> (coerce -> dy)
  :> (coerce -> dh)
  :> (coerce -> dw)
  :> EmptyArgs) = do
  copyTexturePart' texture sx sy sh sw dx dy dh dw
  pure Nothing

copyTextureRotated :: BuiltInFnWithDoc
  '[ '("texture", SDL.Texture)
   , '("src_x", CInt)
   , '("src_y", CInt)
   , '("src_w", CInt)
   , '("src_h", CInt)

   , '("dst_x", CInt)
   , '("dst_y", CInt)
   , '("dst_w", CInt)
   , '("dst_h", CInt)

   , '("rotation_deg", CDouble)
   , '("rotation_x", CInt)
   , '("rotation_y", CInt)

   , '("flipx", Bool)
   , '("flipy", Bool)
   ]
copyTextureRotated
  ( (coerce -> texture)

  :> (coerce -> sx)
  :> (coerce -> sy)
  :> (coerce -> sh)
  :> (coerce -> sw)

  :> (coerce -> dx)
  :> (coerce -> dy)
  :> (coerce -> dh)
  :> (coerce -> dw)

  :> (coerce -> rDeg)
  :> (coerce -> rx)
  :> (coerce -> ry)

  :> (coerce -> flipx)
  :> (coerce -> flipy)

  :> EmptyArgs) = do
  copyTextureRotated' texture sx sy sh sw dx dy dh dw rDeg rx ry flipx flipy
  pure Nothing

getDefaultWindow :: InterpretM SDL.Window
getDefaultWindow = isDefaultWindow <$> get >>= \case
  Just x  -> pure x
  Nothing -> throwErr $ SDLError "Graphics not Initialized"

getDefaultRenderer :: InterpretM SDL.Renderer
getDefaultRenderer = isDefaultRenderer <$> get >>= \case
  Just x  -> pure x
  Nothing -> throwErr $ SDLError "Graphics not Initialized"

draw :: BuiltInFnWithDoc '[]
draw _ = do
  draw'
  pure Nothing

draw' :: InterpretM ()
draw' = getDefaultRenderer >>= SDL.present

drawIfNotAccelerated :: InterpretM ()
drawIfNotAccelerated = (isAccelerated <$> get) >>= \case
  (Just False) -> draw'
  _            -> pure ()

setDrawColor :: BuiltInFnWithDoc '[ '("red_component", Word8), '("green_component", Word8), '("blue_component", Word8)]
setDrawColor ((coerce -> r) :> (coerce -> g) :> (coerce -> b) :> _) = do
  setDrawColor' r g b 255
  pure Nothing

setDrawColorAlpha :: BuiltInFnWithDoc '[ '("red_component", Word8), '("green_component", Word8), '("blue_component", Word8), '("alpha", Word8)]
setDrawColorAlpha ((coerce -> r) :> (coerce -> g) :> (coerce -> b) :> (coerce -> a) :> _) = do
  setDrawColor' r g b a
  pure Nothing

setDrawColor' :: Word8 -> Word8 -> Word8 -> Word8 -> InterpretM ()
setDrawColor' r g b a = do
  getDefaultRenderer >>= \renderer -> do
    SDL.rendererDrawColor renderer $= V4 r g b a

clear :: BuiltInFnWithDoc '[]
clear _ = do
  getDefaultRenderer >>= SDL.clear
  pure Nothing

drawPoint :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt)]
drawPoint ((coerce -> x) :> (coerce -> y) :> _) = do
  renderer <- getDefaultRenderer
  SDL.drawPoint renderer (mkPoint x y)
  drawIfNotAccelerated
  pure Nothing

drawPoints :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 CInt))]
drawPoints ((coerce -> v) :> _) = do
  renderer <- getDefaultRenderer
  SDL.drawPoints renderer v
  drawIfNotAccelerated
  pure Nothing

drawLines :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 CInt))]
drawLines ((coerce -> v) :> _) = do
  drawLines' v
  pure Nothing

drawLines' :: VS.Vector (SDL.Point V2 CInt) -> InterpretM ()
drawLines' v = do
  renderer <- getDefaultRenderer
  SDL.drawLines renderer v
  if VS.length v > 0 then do
    let last' = VS.last v
    SDL.drawPoint renderer last'
    SDL.drawPoint renderer last'
  else pure ()
  drawIfNotAccelerated

v2ToTuple :: Point V2 a -> (a, a)
v2ToTuple (P (V2 a b)) = (a, b)

v2Fst :: Point V2 a -> a
v2Fst (P (V2 a _)) = a

v2Snd :: Point V2 a -> a
v2Snd (P (V2 _ a)) = a

drawPoly :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 CInt)), '("fill", Maybe Bool)]
drawPoly ((coerce -> v) :> (coerce -> f) :> EmptyArgs) = do
  drawPoly' v f
  pure Nothing

drawPoly' :: VS.Vector (SDL.Point V2 CInt) -> Maybe Bool -> InterpretM ()
drawPoly' v f = do
  let fill = fromMaybe False f
  renderer <- getDefaultRenderer
  SDL.drawLines renderer v
  if VS.length v > 0 then do
    let last' = VS.last v
    let first' = VS.head v
    SDL.drawLine renderer last' first'
    SDL.drawPoint renderer last'
    SDL.drawPoint renderer last'
    if fill then do
      let points = v2ToTuple <$> (VS.toList v)
      let pointsY = snd <$> points
      let between v1 (b1, b2) = (b1 <= v1 && b2 >= v1) || (b2 <= v1 && b1 >= v1)
      let minY = minimum pointsY
      let maxY = maximum pointsY
      let pointPairs = zip points ((drop 1 points) <> [head points])
      let
        getXes :: CInt -> [Maybe CInt]
        getXes y =
            flip fmap pointPairs $ \((x1, y1), (x2, y2)) ->
              if y `between` (y1, y2)
                then
                  if (not $ y1 == y2)
                    then do
                      let slope = ((realToFrac $ x2 - x1) :: Double)/(realToFrac $ y2 - y1)
                      Just $ x1 + (round $ (realToFrac $ y - y1 :: Double) * slope)
                    else Nothing
                else Nothing
      let
        dlPairs :: MonadIO m => [(CInt, CInt)] -> m ()
        dlPairs ((x1, y1) : (x2, y2) : xs) = do
          SDL.drawLine renderer (mkPoint x1 y1) (mkPoint x2 y2)
          dlPairs xs
        dlPairs _  = pure ()
      let
        drawY :: MonadIO m => CInt -> m ()
        drawY y = do
          let mxses = getXes y
          let xses = catMaybes mxses
          let cords = zip (DL.sort $ DL.nub xses) (repeat y)
          dlPairs cords
      forM_ [minY..maxY] drawY
    else pure ()
  else pure ()

  drawIfNotAccelerated

drawLine :: BuiltInFnWithDoc ['("start_x", CInt), '("start_y", CInt), '("end_x", CInt), '("end_y", CInt)]
drawLine ((coerce -> x) :> (coerce -> y) :> (coerce -> xEnd) :> (coerce -> yEnd) :>_) = do
  renderer <- getDefaultRenderer
  let endpoint = mkPoint xEnd yEnd
  SDL.drawLine renderer (mkPoint x y) endpoint
  SDL.drawPoint renderer endpoint
  SDL.drawPoint renderer endpoint
    -- Due to some bug in SDL, without these extra call
    -- the next draw item appear to have a stray pixel with the same color
    -- that was used to draw this one.
  drawIfNotAccelerated
  pure Nothing

drawBox :: BuiltInFnWithDoc ['("start_x", CInt), '("start_y", CInt), '("width", CInt), '("height", CInt), '("fill", Maybe Bool)]
drawBox ((coerce -> x) :> (coerce -> y) :> (coerce -> width) :> (coerce -> height) :> (coerce -> fill) :> _) = do
  renderer <- getDefaultRenderer
  let
    f = case fill of
      Just b -> b
      Nothing -> False
  if f
    then SDL.fillRect renderer $ Just $ SDL.Rectangle (mkPoint x y) (SDL.V2 width height)
    else SDL.drawRect renderer $ Just $ SDL.Rectangle (mkPoint x y) (SDL.V2 width height)
  drawIfNotAccelerated
  pure Nothing

drawArc :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", Double), '("angle_start", Double),  '("angle_end", Double), '("fill", Maybe Bool)]
drawArc ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> angles) :> (coerce -> anglee) :> (coerce -> f) :> _) = do
  drawArc' x y radius (fromMaybe False f) angles anglee
  pure Nothing

drawCircle :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", Double), '("fill", Maybe Bool)]
drawCircle ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> f) :> _) = do
  drawArc' x y radius (fromMaybe False f) 0 360
  pure Nothing

drawArc' :: CInt -> CInt -> Double -> Bool -> Double -> Double -> InterpretM ()
drawArc' x y radius f angles anglee = do
  let start_angle = angles * 2 * pi / 360
  let end_angle = anglee * 2 * pi / 360
  let one_degree = 2 * pi / 360
  let angle_list = takeWhile (\a -> a <= end_angle) $ (DL.iterate' (+ one_degree) start_angle)
  let dx = realToFrac x
  let dy = realToFrac y
  let points = (\a -> mkPoint (round $ dx + (cos a) * radius) (round $ dy + (sin a) * radius)) <$> (angle_list <> [end_angle])
  if f then drawPoly' (VS.fromList (points <> [mkPoint x y])) (Just True)
    else drawLines' (VS.fromList points)
  drawIfNotAccelerated

waitForSDLKey :: BuiltInFnWithDoc '[]
waitForSDLKey _ = do
  mv <- iterateWhile isNothing $ do
    events <- (filter filterEvent) <$> pollEvents
    case events of
      [] -> pure Nothing
      (h:_) -> pure $ convertEvent h
  pure mv
  where
    convertEvent :: Event -> Maybe Value
    convertEvent event =
      case eventPayload event of
        KeyboardEvent keyboardEvent ->
           Just $ SDLValue $ Keycode ((keysymKeycode (keyboardEventKeysym keyboardEvent)))
        _ -> Nothing

    filterEvent :: Event -> Bool
    filterEvent event =
      case eventPayload event of
        KeyboardEvent keyboardEvent ->
          (keyboardEventKeyMotion keyboardEvent == Pressed)
        _ -> False

getWindowSize' :: InterpretM (SDL.V2 CInt)
getWindowSize' = do
  window <- getDefaultWindow
  liftIO $ SDL.get (windowSize window)

getWindowSize :: BuiltInFnWithDoc '[]
getWindowSize _ = do
  (SDL.V2 x y) <- getWindowSize'
  pure $ Just $ ObjectValue $ M.fromList [("width", NumberValue $ NumberInt $ fromIntegral x), ("height", NumberValue $ NumberInt $ fromIntegral y)]

getKeyboardState :: BuiltInFnWithDoc '[]
getKeyboardState _ = do
  SDL.pumpEvents
  fn <- SDL.getKeyboardState
  pure $ Just $ SDLValue $ KeyboardState $ SDLKeyboardStateCallback fn

wasKeyDownIn :: BuiltInFnWithDoc '[ '("keyboard_state", SDLKeyboardStateCallback), '("key", SDL.Scancode) ]
wasKeyDownIn ((coerce -> (SDLKeyboardStateCallback cb)) :> (coerce -> scancode ) :> _) =
  pure $ Just $ BoolValue $ cb scancode

getKeys :: BuiltInFnWithDoc '[]
getKeys _ = do
  events <- pollEvents
  pure $ Just $ ArrayValue $ DL.foldl' convertEvent V.empty events
  where
    convertEvent :: V.Vector Value -> Event -> V.Vector Value
    convertEvent inp event =
      case eventPayload event of
        KeyboardEvent keyboardEvent ->
            V.cons (SDLValue $ Keycode ((keysymKeycode (keyboardEventKeysym keyboardEvent)))) inp
        _ -> inp

builtInSetSampleVolume :: BuiltInFnWithDoc '[ '("channel", Channel), '("volume", Int)]
builtInSetSampleVolume ((coerce -> (channel :: Channel)) :> (coerce -> volume) :> _) = do
  SDLM.setVolume volume channel
  pure Nothing

builtInSetSampleLRVolume :: BuiltInFnWithDoc '[ '("sample", Channel), '("volume_left", Int), '("volume_right", Int)]
builtInSetSampleLRVolume ((coerce -> (channel :: Channel)) :> (coerce -> volumel) :> (coerce -> volumer) :> _) = do
  void $ SDLM.effectPan channel volumel volumer
  pure Nothing

builtInPlaySoundSample :: BuiltInFnWithDoc '[ '("sample", Sample), '("channel", Int)]
builtInPlaySoundSample ((coerce -> sample) :> (coerce -> (channel :: Int)) :> _) = do
  void $ SDLM.playOn (fromIntegral channel) SDLM.Forever sample
  pure Nothing

makeSound :: (Int, [WAVESample]) -> InterpretM Value
makeSound (sampleCount, samplesRaw) = do
  (rEnd, wEnd) <- liftIO createPipe
  let waveData = WAVE (WAVEHeader 1 44100 16 $ Just sampleCount) [samplesRaw]
  waveEncodedData <- liftIO $ do
    hPutWAVE wEnd waveData
    BS.hGetContents rEnd
  chunk <- liftIO $ SDLM.decode waveEncodedData
  pure $ SDLValue $ SoundSample chunk

builtInMakeTone :: BuiltInFnWithDoc '[ '("freq", Double) ]
builtInMakeTone ((coerce -> freq) :> _) = do
  let samplesInOneCycle = 44100 / freq
  let multiplier = (2 * pi)/samplesInOneCycle
  let samplesRaw = [doubleToSample $ sin (realToFrac x * multiplier) | x <- [0 .. (round samplesInOneCycle - 1)]]
  Just <$> makeSound (round samplesInOneCycle, samplesRaw)

builtInMakeSoundSample :: BuiltInFnWithDoc '[ '("samplecount", Int), '("callback", Callback)]
builtInMakeSoundSample ((coerce -> sampleCount) :> (coerce -> (cb :: Callback)) :> _) = do
  samplesRaw <- getSamples sampleCount
  Just <$> makeSound (sampleCount , samplesRaw)
  where
    getSamples :: Int -> InterpretM [WAVESample]
    getSamples sc = mapM (\x -> mapFn x) [1..(fromIntegral sc)]

    mapFn :: Integer -> InterpretM WAVESample
    mapFn si = (doubleToSample . (fromValue @Double) . fromMaybe (throwErr MissingProcedureReturn)) <$>
      evaluateCallback cb [NumberValue $ NumberInt si]

builtInMakeSoundSampleFromFile :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInMakeSoundSampleFromFile ((coerce -> filePath) :> _) = do
  chunk <- liftIO $ SDLM.load filePath
  pure $ Just $ SDLValue $ SoundSample chunk

cleanupSDL :: InterpretM ()
cleanupSDL = do
  sdlWindowRefs <- isSDLWindows <$> get
  windows <- liftIO $ readIORef sdlWindowRefs
  mapM_ (liftIO . SDL.destroyWindow) windows
  modify (\x -> x { isDefaultRenderer = Nothing })
  modify (\x -> x { isDefaultWindow = Nothing })
  SDLM.closeAudio
  SDL.quit

keycodes :: Value
keycodes = ObjectValue $ M.fromList
  [ ("up", SDLValue $ Keycode KeycodeUp)
  , ("down", SDLValue $ Keycode KeycodeDown)
  , ("left", SDLValue $ Keycode KeycodeLeft)
  , ("right", SDLValue $ Keycode KeycodeRight)
  , ("a", SDLValue $ Keycode KeycodeA)
  , ("b", SDLValue $ Keycode KeycodeB)
  , ("c", SDLValue $ Keycode KeycodeC)
  , ("d", SDLValue $ Keycode KeycodeD)
  , ("e", SDLValue $ Keycode KeycodeE)
  , ("f", SDLValue $ Keycode KeycodeF)
  , ("g", SDLValue $ Keycode KeycodeG)
  , ("h", SDLValue $ Keycode KeycodeH)
  , ("i", SDLValue $ Keycode KeycodeI)
  , ("j", SDLValue $ Keycode KeycodeJ)
  , ("k", SDLValue $ Keycode KeycodeK)
  , ("l", SDLValue $ Keycode KeycodeL)
  , ("m", SDLValue $ Keycode KeycodeM)
  , ("n", SDLValue $ Keycode KeycodeN)
  , ("o", SDLValue $ Keycode KeycodeO)
  , ("p", SDLValue $ Keycode KeycodeP)
  , ("q", SDLValue $ Keycode KeycodeQ)
  , ("r", SDLValue $ Keycode KeycodeR)
  , ("s", SDLValue $ Keycode KeycodeS)
  , ("t", SDLValue $ Keycode KeycodeT)
  , ("u", SDLValue $ Keycode KeycodeU)
  , ("v", SDLValue $ Keycode KeycodeV)
  , ("w", SDLValue $ Keycode KeycodeW)
  , ("x", SDLValue $ Keycode KeycodeX)
  , ("y", SDLValue $ Keycode KeycodeY)
  , ("z", SDLValue $ Keycode KeycodeZ)
  , ("return", SDLValue $ Keycode KeycodeReturn)
  , ("escape", SDLValue $ Keycode KeycodeEscape)
  ]

scancodes :: Value
scancodes = ObjectValue $ M.fromList
  [ ("up", SDLValue $ Scancode ScancodeUp)
  , ("down", SDLValue $ Scancode ScancodeDown)
  , ("left", SDLValue $ Scancode ScancodeLeft)
  , ("right", SDLValue $ Scancode ScancodeRight)
  , ("a", SDLValue $ Scancode ScancodeA)
  , ("b", SDLValue $ Scancode ScancodeB)
  , ("c", SDLValue $ Scancode ScancodeC)
  , ("d", SDLValue $ Scancode ScancodeD)
  , ("e", SDLValue $ Scancode ScancodeE)
  , ("f", SDLValue $ Scancode ScancodeF)
  , ("g", SDLValue $ Scancode ScancodeG)
  , ("h", SDLValue $ Scancode ScancodeH)
  , ("i", SDLValue $ Scancode ScancodeI)
  , ("j", SDLValue $ Scancode ScancodeJ)
  , ("k", SDLValue $ Scancode ScancodeK)
  , ("l", SDLValue $ Scancode ScancodeL)
  , ("m", SDLValue $ Scancode ScancodeM)
  , ("n", SDLValue $ Scancode ScancodeN)
  , ("o", SDLValue $ Scancode ScancodeO)
  , ("p", SDLValue $ Scancode ScancodeP)
  , ("q", SDLValue $ Scancode ScancodeQ)
  , ("r", SDLValue $ Scancode ScancodeR)
  , ("s", SDLValue $ Scancode ScancodeS)
  , ("t", SDLValue $ Scancode ScancodeT)
  , ("u", SDLValue $ Scancode ScancodeU)
  , ("v", SDLValue $ Scancode ScancodeV)
  , ("w", SDLValue $ Scancode ScancodeW)
  , ("x", SDLValue $ Scancode ScancodeX)
  , ("y", SDLValue $ Scancode ScancodeY)
  , ("z", SDLValue $ Scancode ScancodeZ)
  ]