{-# LANGUAGE ForeignFunctionInterface #-}

module Init where

import Affection as A

import NanoVG hiding (V2(..), V3(..))
import NanoVG.Internal.Image (ImageFlags(..))

import Codec.Picture as CP
import Codec.Picture.Extra

import Control.Concurrent.STM
import Control.Concurrent.MVar

import Data.String
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.ByteString.Lazy (toStrict)

import System.Exit (exitFailure)

import Foreign.C.Types (CInt(..))

import Types

foreign import ccall unsafe "glewInit"
  glewInit :: IO CInt

init :: IO UserData
init = do
  subs <- Subsystems
    <$> (SubWindow <$> newTVarIO [])
    <*> (SubMouse <$> newTVarIO [])
    <*> (SubKeyboard <$> newTVarIO [])
    <*> (SubJoypad <$> newTVarIO [])
    <*> (SubTranslator <$> newTVarIO [])
  _ <- glewInit
  nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes])
  UserData
    <$> newMVar Load            -- state
    <*> pure subs               -- subsystems
    <*> newMVar M.empty         -- assetIcons
    <*> newMVar M.empty         -- assetImages
    <*> newMVar M.empty         -- assetFonts
    <*> newMVar M.empty         -- assetAnimations
    <*> newMVar NoController    -- controls
    <*> newMVar NoTranslation   -- translation
    <*> pure nvg                -- nano
    <*> newMVar []              -- uuid
    <*> newEmptyMVar            -- worldState           <-
    <*> newMVar None            -- stateData
    <*> newEmptyMVar            -- stateMVar            <-
    <*> newEmptyMVar            -- stateProgress        <-
    <*> newMVar Nothing         -- threadContext
    <*> newMVar Nothing         -- window
    <*> newMVar []              -- joyCache
    <*> newEmptyMVar            -- joyUUID              <-
    <*> newMVar True            -- doNextStep

loadPlayerSprite
  :: FilePath         -- Path to spritemap
  -> Int              -- width of single sprite
  -> Int              -- height of single sprite
  -> Context          -- Nanovg context
  -> [(Int, [ImgId])] -- [(picture row, Image IDs)]
  -> IO [(ImgId, NanoVG.Image)]
loadPlayerSprite fp w h nvg rids = do
  eimg <- readImage fp
  case eimg of
    Left err -> do
      logIO Error (fromString err)
      exitFailure
    Right dimg -> do
      let img = convertRGBA8 dimg
      ret <- mapM (\(row, ids) ->
        mapM (\(num, i) -> do
          let cr = crop (num * w) (row * h) w h img
          mresimg <-
            createImageMem nvg (S.singleton ImagePremultiplied) (toStrict $ encodePng cr)
          case mresimg of
            Nothing     -> do
              logIO
                Error
                ("Failed to load: " <>
                  fromString fp <>
                  " " <>
                  fromString (show i)
                  )
              exitFailure
            Just resimg -> return (i, resimg)
          ) (zip [0..] ids)
        ) rids
      return $ concat ret
