module Game.BitmapFont (BitmapFont, load, renderText, renderTextSolid) where

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Foreign.C.Types (CInt)
import qualified Game.Utils as U
import SDL (($=))
import qualified SDL
import Text.JSON

data FontDesc = FontDesc Int Int (Map Char (SDL.Rectangle CInt))

data BitmapFont = BitmapFont FontDesc SDL.Texture

instance JSON FontDesc where
  showJSON = undefined
  readJSON (JSObject obj) = do
    w <- valFromObj "width" obj
    h <- valFromObj "height" obj
    m <- valFromObj "map" obj
    pure $ FontDesc w h $ Map.fromList (zipWith (curry (toRect w h)) m [0 ..])
    where
      -- we store a Map from char to the SDL rect containing the glyph
      toRect :: Int -> Int -> (Char, Int) -> (Char, SDL.Rectangle CInt)
      toRect w h (c, i) = (c, U.rect (i * w) 0 w h)
  readJSON _ = mzero

-- | Load a bitmap font description from a JSON file.
--
-- The texture is expected to have the glyphs in a single line plus a special one at the end to be used when a character is not found in the font map.
load :: String -> SDL.Texture -> IO BitmapFont
load filename tex = do
  d <- readFile filename
  case decode d :: Result FontDesc of
    Ok desc -> pure $ BitmapFont desc tex
    Error e -> error e

-- | Render a string at position x, y using the provided bitmap font.
renderText :: SDL.Renderer -> BitmapFont -> Int -> Int -> String -> IO ()
renderText renderer (BitmapFont (FontDesc w h m) tex) x y text = mapM_ renderOne (zip [0 ..] text)
  where
    renderOne :: (Int, Char) -> IO ()
    renderOne (i, c) =
      SDL.copy renderer tex (Just src) (Just dst)
      where
        -- find the glyph or render the special one as error
        src = fromMaybe (U.rect (length m * w) 0 w h) (Map.lookup c m)
        dst = U.rect (x + i * w) y w h

-- | Render a string like renderText but with a translucid background.
renderTextSolid :: SDL.Renderer -> BitmapFont -> Int -> Int -> String -> IO ()
renderTextSolid renderer font@(BitmapFont (FontDesc w h _) _) x y text = do
  oldBlend <- SDL.get $ SDL.rendererDrawBlendMode renderer
  SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend
  oldColor <- SDL.get $ SDL.rendererDrawColor renderer
  SDL.rendererDrawColor renderer $= SDL.V4 32 32 32 192
  _ <- SDL.fillRect renderer (Just (U.rect (x - 5) (y - 5) (length text * w + 10) (h + 10)))
  SDL.rendererDrawColor renderer $= oldColor
  SDL.rendererDrawBlendMode renderer $= oldBlend
  renderText renderer font x y text