module Data.Component.Button where

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

data Button = Button {
  Button -> Font
font :: SDL.Font.Font,
  Button -> Config
config :: Config
}

data ButtonEvent = Click
  deriving Typeable

instance EventType ButtonEvent where
  getEventType :: ButtonEvent -> Text
getEventType Click = "click"

instance ComponentUnit Button where
  update :: Button -> LightT env m Button
update = Button -> LightT env m Button
forall (m :: * -> *) a. Monad m => a -> m a
return

  figures :: Button -> LightT env m [Figure]
figures comp :: Button
comp = do
    Figure
textTexture <- MiniLight Figure -> LightT env m Figure
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight Figure -> LightT env m Figure)
-> MiniLight Figure -> LightT env m Figure
forall a b. (a -> b) -> a -> b
$ Font -> V4 Word8 -> Text -> MiniLight Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text (Button -> Font
font Button
comp) (Config -> V4 Word8
color (Button -> Config
config Button
comp)) (Text -> MiniLight Figure) -> Text -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Config -> Text
label (Button -> Config
config Button
comp)
    Figure
base <- MiniLight Figure -> LightT env m Figure
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight Figure -> LightT env m Figure)
-> MiniLight Figure -> LightT env m Figure
forall a b. (a -> b) -> a -> b
$ V4 Word8 -> V2 Int -> MiniLight Figure
forall r (m :: * -> *). Rendering r m => V4 Word8 -> V2 Int -> m r
rectangleFilled (Word8 -> Word8 -> Word8 -> Word8 -> V4 Word8
forall a. a -> a -> a -> a -> V4 a
Vect.V4 200 200 200 255) (Figure -> V2 Int
getFigureSize Figure
textTexture)

    [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return [
      Figure
base,
      Figure
textTexture
      ]

  useCache :: Button -> Button -> Bool
useCache _ _ = Bool
True

  onSignal :: Event -> Button -> LightT env m Button
onSignal (RawEvent (SDL.Event _ (SDL.MouseButtonEvent (SDL.MouseButtonEventData _ SDL.Released _ _ _ _)))) comp :: Button
comp = do
    ButtonEvent -> LightT env m ()
forall env (m :: * -> *) et.
(HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) =>
et -> LightT env m ()
emitGlobally ButtonEvent
Click
    Button -> LightT env m Button
forall (m :: * -> *) a. Monad m => a -> m a
return Button
comp
  onSignal _ comp :: Button
comp = Button -> LightT env m Button
forall (m :: * -> *) a. Monad m => a -> m a
return Button
comp

  beforeClearCache :: Button -> [Figure] -> LightT env m ()
beforeClearCache _ figs :: [Figure]
figs = (Figure -> LightT env m ()) -> [Figure] -> LightT env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Figure -> LightT env m ()
forall (m :: * -> *). MonadIO m => Figure -> m ()
freeFigure [Figure]
figs

data Config = Config {
  Config -> V2 Int
size :: Vect.V2 Int,
  Config -> Text
label :: T.Text,
  Config -> V4 Word8
color :: Vect.V4 Word8,
  Config -> FontDescriptor
fontConf :: FontDescriptor,
  Config -> Int
fontSize :: Int
}

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 "config" ((Object -> Parser Config) -> Value -> Parser Config)
-> (Object -> Parser Config) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    V2 Int
size <- String -> (Object -> Parser (V2 Int)) -> Value -> Parser (V2 Int)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "font" (\v :: Object
v -> Int -> Int -> V2 Int
forall a. a -> a -> V2 a
Vect.V2 (Int -> Int -> V2 Int) -> Parser Int -> Parser (Int -> V2 Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "width" Parser (Int -> V2 Int) -> Parser Int -> Parser (V2 Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "height") (Value -> Parser (V2 Int)) -> Parser Value -> Parser (V2 Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
    Text
label <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "label"
    [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
.!= [255, 255, 255, 255]
    (fontConf :: FontDescriptor
fontConf, fontSize :: Int
fontSize) <- (Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "font" Parser Value
-> (Value -> Parser (FontDescriptor, Int))
-> Parser (FontDescriptor, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((Value -> Parser (FontDescriptor, Int))
 -> Parser (FontDescriptor, Int))
-> (Value -> Parser (FontDescriptor, Int))
-> Parser (FontDescriptor, Int)
forall a b. (a -> b) -> a -> b
$ String
-> (Object -> Parser (FontDescriptor, Int))
-> Value
-> Parser (FontDescriptor, Int)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "font" ((Object -> Parser (FontDescriptor, Int))
 -> Value -> Parser (FontDescriptor, Int))
-> (Object -> Parser (FontDescriptor, Int))
-> Value
-> Parser (FontDescriptor, Int)
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
      Text
family <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "family"
      Int
size <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
      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

      (FontDescriptor, Int) -> Parser (FontDescriptor, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FontDescriptor, Int) -> Parser (FontDescriptor, Int))
-> (FontDescriptor, Int) -> Parser (FontDescriptor, Int)
forall a b. (a -> b) -> a -> b
$ (Text -> FontStyle -> FontDescriptor
FontDescriptor Text
family (Bool -> Bool -> FontStyle
FontStyle Bool
bold Bool
italic), Int
size)

    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
$ V2 Int -> Text -> V4 Word8 -> FontDescriptor -> Int -> Config
Config V2 Int
size Text
label (Word8 -> Word8 -> Word8 -> Word8 -> V4 Word8
forall a. a -> a -> a -> a -> V4 a
Vect.V4 Word8
r Word8
g Word8
b Word8
a) FontDescriptor
fontConf Int
fontSize

new :: Config -> MiniLight Button
new :: Config -> MiniLight Button
new conf :: Config
conf = do
  Font
font <- FontDescriptor -> Int -> LightT LightEnv IO Font
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m) =>
FontDescriptor -> Int -> LightT env m Font
loadFont (Config -> FontDescriptor
fontConf Config
conf) (Config -> Int
fontSize Config
conf)
  Button -> MiniLight Button
forall (m :: * -> *) a. Monad m => a -> m a
return (Button -> MiniLight Button) -> Button -> MiniLight Button
forall a b. (a -> b) -> a -> b
$ $WButton :: Font -> Config -> Button
Button {font :: Font
font = Font
font, config :: Config
config = Config
conf}