{-# LANGUAGE OverloadedStrings #-}
module MiniLight.FigureDSL where

import Control.Monad
import qualified Data.Config.Font as Font
import qualified Data.Text as T
import Data.Word (Word8)
import MiniLight
import qualified SDL
import qualified SDL.Vect as Vect
import Foreign.Lua

data FigureDSL
  = Empty
  | Translate (Vect.V2 Int) FigureDSL
  | Clip (Vect.V2 Int) (Vect.V2 Int) FigureDSL
  | Picture FilePath
  | Text (Vect.V4 Word8) T.Text
  deriving (Int -> FigureDSL -> ShowS
[FigureDSL] -> ShowS
FigureDSL -> String
(Int -> FigureDSL -> ShowS)
-> (FigureDSL -> String)
-> ([FigureDSL] -> ShowS)
-> Show FigureDSL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FigureDSL] -> ShowS
$cshowList :: [FigureDSL] -> ShowS
show :: FigureDSL -> String
$cshow :: FigureDSL -> String
showsPrec :: Int -> FigureDSL -> ShowS
$cshowsPrec :: Int -> FigureDSL -> ShowS
Show, ReadPrec [FigureDSL]
ReadPrec FigureDSL
Int -> ReadS FigureDSL
ReadS [FigureDSL]
(Int -> ReadS FigureDSL)
-> ReadS [FigureDSL]
-> ReadPrec FigureDSL
-> ReadPrec [FigureDSL]
-> Read FigureDSL
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FigureDSL]
$creadListPrec :: ReadPrec [FigureDSL]
readPrec :: ReadPrec FigureDSL
$creadPrec :: ReadPrec FigureDSL
readList :: ReadS [FigureDSL]
$creadList :: ReadS [FigureDSL]
readsPrec :: Int -> ReadS FigureDSL
$creadsPrec :: Int -> ReadS FigureDSL
Read)

instance Peekable FigureDSL where
  peek :: StackIndex -> Lua FigureDSL
peek = (String -> FigureDSL) -> Lua String -> Lua FigureDSL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FigureDSL
forall a. Read a => String -> a
read (Lua String -> Lua FigureDSL)
-> (StackIndex -> Lua String) -> StackIndex -> Lua FigureDSL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
peek

instance Pushable FigureDSL where
  push :: FigureDSL -> Lua ()
push = String -> Lua ()
forall a. Pushable a => a -> Lua ()
push (String -> Lua ()) -> (FigureDSL -> String) -> FigureDSL -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureDSL -> String
forall a. Show a => a -> String
show

construct :: FigureDSL -> MiniLight (Maybe Figure)
construct :: FigureDSL -> MiniLight (Maybe Figure)
construct dsl :: FigureDSL
dsl = case FigureDSL
dsl of
  Empty           -> Maybe Figure -> MiniLight (Maybe Figure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Figure -> MiniLight (Maybe Figure))
-> Maybe Figure -> MiniLight (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ Figure -> Maybe Figure
forall a. a -> Maybe a
Just Figure
emptyFigure
  Translate p :: V2 Int
p fig :: FigureDSL
fig -> (Maybe Figure -> Maybe Figure)
-> MiniLight (Maybe Figure) -> MiniLight (Maybe Figure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Figure -> Figure) -> Maybe Figure -> Maybe Figure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (V2 Int -> Figure -> Figure
forall r (m :: * -> *). Rendering r m => V2 Int -> r -> r
translate V2 Int
p)) (MiniLight (Maybe Figure) -> MiniLight (Maybe Figure))
-> MiniLight (Maybe Figure) -> MiniLight (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ FigureDSL -> MiniLight (Maybe Figure)
construct FigureDSL
fig
  Clip p :: V2 Int
p q :: V2 Int
q fig :: FigureDSL
fig ->
    (Maybe Figure -> Maybe Figure)
-> MiniLight (Maybe Figure) -> MiniLight (Maybe Figure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Figure -> Figure) -> Maybe Figure -> Maybe Figure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rectangle Int -> Figure -> Figure
forall r (m :: * -> *). Rendering r m => Rectangle Int -> r -> r
clip (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
Vect.P V2 Int
p) V2 Int
q))) (MiniLight (Maybe Figure) -> MiniLight (Maybe Figure))
-> MiniLight (Maybe Figure) -> MiniLight (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ FigureDSL -> MiniLight (Maybe Figure)
construct FigureDSL
fig
  Picture path :: String
path -> (Figure -> Maybe Figure)
-> LightT LightEnv IO Figure -> MiniLight (Maybe Figure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Figure -> Maybe Figure
forall a. a -> Maybe a
Just (LightT LightEnv IO Figure -> MiniLight (Maybe Figure))
-> LightT LightEnv IO Figure -> MiniLight (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ String -> LightT LightEnv IO Figure
forall r (m :: * -> *). Rendering r m => String -> m r
picture String
path
  Text color :: V4 Word8
color t :: Text
t -> do
    Font
font <- Config -> MiniLight Font
Font.loadFontFrom
      (Config -> MiniLight Font) -> Config -> MiniLight Font
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Int -> V4 Word8 -> Config
Font.Config (Text -> FontStyle -> FontDescriptor
FontDescriptor "IPAGothic" (Bool -> Bool -> FontStyle
FontStyle Bool
False Bool
False)) 24 0
    (Figure -> Maybe Figure)
-> LightT LightEnv IO Figure -> MiniLight (Maybe Figure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Figure -> Maybe Figure
forall a. a -> Maybe a
Just (LightT LightEnv IO Figure -> MiniLight (Maybe Figure))
-> LightT LightEnv IO Figure -> MiniLight (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ Font -> V4 Word8 -> Text -> LightT LightEnv IO Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text Font
font V4 Word8
color Text
t