module Data.Config.Font where

import Control.Lens
import Data.Aeson
import qualified Data.Text as T
import Data.Word (Word8)
import MiniLight
import qualified SDL.Font
import qualified SDL.Vect as Vect

data Config = Config {
  Config -> FontDescriptor
descriptor :: FontDescriptor,
  Config -> Int
size :: Int,
  Config -> V4 Word8
color :: Vect.V4 Word8
}

makeLensesWith classyRules_ ''Config

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = String -> (Object -> Parser Config) -> Value -> Parser Config
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "font" ((Object -> Parser Config) -> Value -> Parser Config)
-> (Object -> Parser Config) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    Text
family <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "family" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= ""
    Int
size <- Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "size" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0
    Bool
bold <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "bold" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Bool
italic <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "italic" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    [r :: Word8
r,g :: Word8
g,b :: Word8
b,a :: Word8
a] <- Object
v Object -> Text -> Parser (Maybe [Word8])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "color" Parser (Maybe [Word8]) -> [Word8] -> Parser [Word8]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [0, 0, 0, 255]

    Config -> Parser Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Parser Config) -> Config -> Parser Config
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Int -> V4 Word8 -> Config
Config (Text -> FontStyle -> FontDescriptor
FontDescriptor Text
family (Bool -> Bool -> FontStyle
FontStyle Bool
bold Bool
italic)) Int
size (Word8 -> Word8 -> Word8 -> Word8 -> V4 Word8
forall a. a -> a -> a -> a -> V4 a
Vect.V4 Word8
r Word8
g Word8
b Word8
a)

-- | Load a system font from 'Config' type.
loadFontFrom :: Config -> MiniLight SDL.Font.Font
loadFontFrom :: Config -> MiniLight Font
loadFontFrom conf :: Config
conf = FontDescriptor -> Int -> MiniLight Font
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m) =>
FontDescriptor -> Int -> LightT env m Font
loadFont (Config -> FontDescriptor
descriptor Config
conf) (Config -> Int
size Config
conf)

-- | Create a text texture from the config.
-- **NB** This function is a slow operation since it loads the font data every time.
textFrom :: Config -> T.Text -> MiniLight Figure
textFrom :: Config -> Text -> MiniLight Figure
textFrom conf :: Config
conf t :: Text
t = do
  Font
font <- Config -> MiniLight Font
loadFontFrom Config
conf
  Font -> V4 Word8 -> Text -> MiniLight Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text Font
font (Config
conf Config -> Getting (V4 Word8) Config (V4 Word8) -> V4 Word8
forall s a. s -> Getting a s a -> a
^. Getting (V4 Word8) Config (V4 Word8)
forall c. HasConfig c => Lens' c (V4 Word8)
_color) Text
t