{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Types.UserData where

import Affection

import Control.Concurrent.STM

import qualified SDL

import NanoVG hiding (V2(..), V3(..))

import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Ecstasy

import Control.Concurrent.MVar

import Types.StateData
import Types.ImgId
import Types.FontId
import Types.Animation
import Types.Entity

data UserData = UserData
  { state           :: State
  , subsystems      :: Subsystems
  , assetImages     :: M.Map ImgId Image
  , assetFonts      :: M.Map FontId T.Text
  , assetAnimations :: M.Map AnimId Animation
  , nano            :: Context
  , uuid            :: [UUID]
  , worldState      :: SystemState Entity (AffectionState (AffectionData UserData) IO)
  , stateData       :: StateData
  , stateMVar       :: MVar
    ( SystemState Entity (AffectionState (AffectionData UserData) IO)
    , StateData
    )
  , stateProgress   :: MVar (Float, T.Text)
  , threadContext   :: Maybe SDL.GLContext
  , window          :: Maybe SDL.Window
  }

data State
  = Load
  | Main SubMain
  deriving (Eq)

data SubMain
  = WorldMap
  | MindMap
  deriving (Eq)

data Subsystems = Subsystems
  { subWindow   :: Types.UserData.Window
  , subMouse    :: Mouse
  , subkeyboard :: Keyboard
  }

newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData())])
newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])

instance Participant Types.UserData.Window UserData where
  type Mesg Types.UserData.Window UserData = WindowMessage

  partSubscribers (Window t) = generalSubscribers t

  partSubscribe (Window t) = generalSubscribe t

  partUnSubscribe (Window t) = generalUnSubscribe t

instance SDLSubsystem Types.UserData.Window UserData where
  consumeSDLEvents = consumeSDLWindowEvents

instance Participant Mouse UserData where
  type Mesg Mouse UserData = MouseMessage

  partSubscribers (Mouse t) = generalSubscribers t

  partSubscribe (Mouse t) = generalSubscribe t

  partUnSubscribe (Mouse t) = generalUnSubscribe t

instance SDLSubsystem Mouse UserData where
  consumeSDLEvents = consumeSDLMouseEvents

instance Participant Keyboard UserData where
  type Mesg Keyboard UserData = KeyboardMessage

  partSubscribers (Keyboard t) = generalSubscribers t

  partSubscribe (Keyboard t) = generalSubscribe t

  partUnSubscribe (Keyboard t) = generalUnSubscribe t

instance SDLSubsystem Keyboard UserData where
  consumeSDLEvents = consumeSDLKeyboardEvents

generalSubscribers
  :: TVar [(UUID, msg -> Affection UserData ())]
  -> Affection UserData [(msg -> Affection UserData ())]
generalSubscribers t = do
  subTups <- liftIO $ readTVarIO t
  return $ map snd subTups

generalSubscribe
  :: TVar [(UUID, msg -> Affection UserData ())]
  -> (msg -> Affection UserData ())
  -> Affection UserData UUID
generalSubscribe t funct = do
  uu <- genUUID
  liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
  return uu

generalUnSubscribe
  :: TVar [(UUID, msg -> Affection UserData ())]
  -> UUID
  -> Affection UserData ()
generalUnSubscribe t uu =
  liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
  where
    filterMsg (u, _) p = u /= p