{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
module Script.Core
  ( ScriptState (..)
  , ScriptEnv (..)
  , Script
  , makeScript
  , runScript
  ) where

import           Control.Monad.Reader
import           Control.Monad.State
import qualified Data.Binary                as Binary
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.IntMap                as IM
import           Data.IORef
import qualified Data.Set                   as Set

import           Script.Event
import           Script.Input
import           Script.State
import           Script.Types
import           Input.Keycode              (Keycode)

data ScriptState = ScriptState
  { sstCommands :: [Command]
  }

data ScriptEnv = ScriptEnv
  { envTime           :: Time
  , envFrame          :: StaticFrame
  , envEnemies        :: IM.IntMap StaticFrame
  , envKeyboardEvents :: [KeyboardEvent]
  , envKeycodeSet         :: Set.Set Keycode
  , envJoystickEvents :: [JoystickEvent]
  , envJoyAxes        :: IM.IntMap AxisPosition
  } deriving (Eq, Show, Read)

newtype Script a = Script {
    runS :: ReaderT ScriptEnv (StateT ScriptState IO) a
  } deriving (Functor, Applicative, Monad, MonadIO, MonadReader ScriptEnv, MonadState ScriptState)

makeScript :: Time -> [KeyboardEvent] -> Set.Set Keycode -> [JoystickEvent] -> [(AxisID, AxisPositionRaw)] -> String
makeScript t kes keyset jes axes =
  "runScript script "
    ++ show t ++ " "
    ++ show (Binary.encode kes) ++ " "
    ++ show (Binary.encode keyset) ++ " "
    ++ show (Binary.encode jes) ++ " "
    ++ show (Binary.encode axes)

runScript :: Show a => Script a -> Time -> BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString -> IO [Command]
runScript k t kesBS keysetBS jesBS axesBS = do
  frame <- readIORef globalStaticFrame
  enemies <- readIORef globalStaticFrameE
  let env = ScriptEnv t frame enemies kes keyset jes axes
  st <- execStateT (runReaderT (runS k) env) iniStt
  return $ sstCommands st
  where
    iniStt = ScriptState []
    kes = Binary.decode $ BLC.fromStrict kesBS
    keyset = Binary.decode $ BLC.fromStrict keysetBS
    jes = Binary.decode $ BLC.fromStrict jesBS

    axes = IM.map toRate axesRaw
      where
        toRate = (/ 32768) . fromIntegral
        axesRaw :: IM.IntMap AxisPositionRaw
        axesRaw = IM.fromList . Binary.decode $ BLC.fromStrict axesBS