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

import qualified Control.Monad.Caster as Caster
import Control.Monad.Catch
import Control.Monad.State hiding (state)
import qualified Data.ByteString as BS
import qualified Data.Component.Basic as Basic
import Data.IORef
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as TLE
import Data.UnixTime
import qualified Foreign.Lua as Lua
import Foreign.C.String
import Foreign.Ptr
import GHC.Generics (Generic)
import Linear
import MiniLight
import MiniLight.FigureDSL
import qualified SDL
import qualified SDL.Vect as Vect

data LuaComponentState = LuaComponentState {
  LuaComponentState -> V2 Int
mousePosition :: V2 Int
} deriving (LuaComponentState -> LuaComponentState -> Bool
(LuaComponentState -> LuaComponentState -> Bool)
-> (LuaComponentState -> LuaComponentState -> Bool)
-> Eq LuaComponentState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LuaComponentState -> LuaComponentState -> Bool
$c/= :: LuaComponentState -> LuaComponentState -> Bool
== :: LuaComponentState -> LuaComponentState -> Bool
$c== :: LuaComponentState -> LuaComponentState -> Bool
Eq, Int -> LuaComponentState -> ShowS
[LuaComponentState] -> ShowS
LuaComponentState -> String
(Int -> LuaComponentState -> ShowS)
-> (LuaComponentState -> String)
-> ([LuaComponentState] -> ShowS)
-> Show LuaComponentState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaComponentState] -> ShowS
$cshowList :: [LuaComponentState] -> ShowS
show :: LuaComponentState -> String
$cshow :: LuaComponentState -> String
showsPrec :: Int -> LuaComponentState -> ShowS
$cshowsPrec :: Int -> LuaComponentState -> ShowS
Show)

data LuaComponent = LuaComponent {
  LuaComponent -> String
expr :: String,
  LuaComponent -> LuaComponentState
state :: LuaComponentState,
  LuaComponent -> Int
counter :: Int,
  LuaComponent -> UnixTime
updatedAt :: UnixTime
}

data LuaComponentEvent
  = SetExpr String

instance EventType LuaComponentEvent where
  getEventType :: LuaComponentEvent -> Text
getEventType (SetExpr _) = "set_expr"

instance ComponentUnit LuaComponent where
  figures :: LuaComponent -> LightT env m [Figure]
figures comp :: LuaComponent
comp = String -> LuaComponentState -> LightT env m [Figure]
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m, MonadMask m) =>
String -> LuaComponentState -> LightT env m [Figure]
evalLuaComponent (LuaComponent -> String
expr LuaComponent
comp) (LuaComponent -> LuaComponentState
state LuaComponent
comp)

  onSignal :: Event -> LuaComponent -> LightT env m LuaComponent
onSignal ev :: Event
ev = StateT LuaComponent (LightT env m) ()
-> LuaComponent -> LightT env m LuaComponent
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT LuaComponent (LightT env m) ()
 -> LuaComponent -> LightT env m LuaComponent)
-> StateT LuaComponent (LightT env m) ()
-> LuaComponent
-> LightT env m LuaComponent
forall a b. (a -> b) -> a -> b
$ do
    LightT env m () -> StateT LuaComponent (LightT env m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LightT env m () -> StateT LuaComponent (LightT env m) ())
-> LightT env m () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ Event -> Config -> LightT env m ()
forall env (m :: * -> *).
(HasLightEnv env, HasLoopEnv env, HasComponentEnv env,
 MonadIO m) =>
Event -> Config -> LightT env m ()
Basic.emitBasicSignal Event
ev ($WConfig :: V2 Int -> V2 Int -> Bool -> Config
Basic.Config { size :: V2 Int
Basic.size = Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 640 480, position :: V2 Int
Basic.position = Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 0 0, visible :: Bool
Basic.visible = Bool
True })

    case Event -> Maybe LuaComponentEvent
forall a. EventType a => Event -> Maybe a
asSignal Event
ev of
      Just (SetExpr fs :: String
fs) -> do
        UnixTime
t <- IO UnixTime -> StateT LuaComponent (LightT env m) UnixTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UnixTime
getUnixTime
        (LuaComponent -> LuaComponent)
-> StateT LuaComponent (LightT env m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((LuaComponent -> LuaComponent)
 -> StateT LuaComponent (LightT env m) ())
-> (LuaComponent -> LuaComponent)
-> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ \qc :: LuaComponent
qc -> LuaComponent
qc { expr :: String
expr = String
fs, counter :: Int
counter = LuaComponent -> Int
counter LuaComponent
qc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, updatedAt :: UnixTime
updatedAt = UnixTime
t }
      _ -> () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case Event -> Maybe Signal
forall a. EventType a => Event -> Maybe a
asSignal Event
ev of
      Just (Basic.MouseOver p :: V2 Int
p) ->
        (LuaComponent -> LuaComponent)
-> StateT LuaComponent (LightT env m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((LuaComponent -> LuaComponent)
 -> StateT LuaComponent (LightT env m) ())
-> (LuaComponent -> LuaComponent)
-> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ \qc :: LuaComponent
qc -> LuaComponent
qc { state :: LuaComponentState
state = (LuaComponent -> LuaComponentState
state LuaComponent
qc) { mousePosition :: V2 Int
mousePosition = V2 Int
p }, counter :: Int
counter = LuaComponent -> Int
counter LuaComponent
qc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }
      _ -> () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  useCache :: LuaComponent -> LuaComponent -> Bool
useCache c1 :: LuaComponent
c1 c2 :: LuaComponent
c2 = LuaComponent -> UnixTime
updatedAt LuaComponent
c1 UnixTime -> UnixTime -> Bool
forall a. Eq a => a -> a -> Bool
== LuaComponent -> UnixTime
updatedAt LuaComponent
c2

newLuaComponent :: LuaComponent
newLuaComponent :: LuaComponent
newLuaComponent = LuaComponent :: String -> LuaComponentState -> Int -> UnixTime -> LuaComponent
LuaComponent
  { expr :: String
expr      = ""
  , state :: LuaComponentState
state     = LuaComponentState :: V2 Int -> LuaComponentState
LuaComponentState {mousePosition :: V2 Int
mousePosition = 0}
  , counter :: Int
counter   = 0
  , updatedAt :: UnixTime
updatedAt = CTime -> Int32 -> UnixTime
UnixTime 0 0
  }

evalLuaComponent
  :: (HasLightEnv env, MonadIO m, MonadMask m)
  => String
  -> LuaComponentState
  -> LightT env m [Figure]
evalLuaComponent :: String -> LuaComponentState -> LightT env m [Figure]
evalLuaComponent content :: String
content state :: LuaComponentState
state
  | String
content String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" = [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = do
    Either Exception [FigureDSL]
result <- IO (Either Exception [FigureDSL])
-> LightT env m (Either Exception [FigureDSL])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Exception [FigureDSL])
 -> LightT env m (Either Exception [FigureDSL]))
-> IO (Either Exception [FigureDSL])
-> LightT env m (Either Exception [FigureDSL])
forall a b. (a -> b) -> a -> b
$ Lua (Either Exception [FigureDSL])
-> IO (Either Exception [FigureDSL])
forall a. Lua a -> IO a
Lua.run (Lua (Either Exception [FigureDSL])
 -> IO (Either Exception [FigureDSL]))
-> Lua (Either Exception [FigureDSL])
-> IO (Either Exception [FigureDSL])
forall a b. (a -> b) -> a -> b
$ Lua [FigureDSL] -> Lua (Either Exception [FigureDSL])
forall a. Lua a -> Lua (Either Exception a)
Lua.try (Lua [FigureDSL] -> Lua (Either Exception [FigureDSL]))
-> Lua [FigureDSL] -> Lua (Either Exception [FigureDSL])
forall a b. (a -> b) -> a -> b
$ do
      Lua ()
Lua.openlibs
      Lua ()
loadLib
      Status
st <- ByteString -> Lua Status
Lua.dostring (ByteString -> Lua Status) -> ByteString -> Lua Status
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
content
      case Status
st of
        Lua.OK -> String -> () -> Lua [FigureDSL]
forall a. LuaCallFunc a => String -> a
Lua.callFunc "onDraw" ()
        _      -> String -> Lua [FigureDSL]
forall a. String -> Lua a
Lua.throwException (String -> Lua [FigureDSL]) -> String -> Lua [FigureDSL]
forall a b. (a -> b) -> a -> b
$ "Invalid status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Status -> String
forall a. Show a => a -> String
show Status
st

    case Either Exception [FigureDSL]
result of
      Left  err :: Exception
err -> Exception -> LightT env m ()
forall (m :: * -> *) s.
(MonadLogger m, MonadIO m, ToBuilder s) =>
s -> m ()
Caster.err Exception
err LightT env m () -> LightT env m [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Right rs :: [FigureDSL]
rs  -> 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
$ ([Maybe Figure] -> [Figure])
-> LightT LightEnv IO [Maybe Figure] -> MiniLight [Figure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Figure] -> [Figure]
forall a. [Maybe a] -> [a]
catMaybes (LightT LightEnv IO [Maybe Figure] -> MiniLight [Figure])
-> LightT LightEnv IO [Maybe Figure] -> MiniLight [Figure]
forall a b. (a -> b) -> a -> b
$ (FigureDSL -> LightT LightEnv IO (Maybe Figure))
-> [FigureDSL] -> LightT LightEnv IO [Maybe Figure]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FigureDSL -> LightT LightEnv IO (Maybe Figure)
construct [FigureDSL]
rs

reload
  :: (HasLoaderEnv env, HasLightEnv env, HasLoopEnv env, MonadIO m, MonadMask m)
  => T.Text
  -> LightT env m ()
reload :: Text -> LightT env m ()
reload path :: Text
path = do
  String
fs <- IO String -> LightT env m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> LightT env m String)
-> IO String -> LightT env m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile (Text -> String
T.unpack Text
path)
  Text
path Text -> LuaComponentEvent -> LightT env m ()
forall et env (m :: * -> *).
(EventType et, HasLoaderEnv env, HasLoopEnv env, HasLightEnv env,
 MonadIO m) =>
Text -> et -> LightT env m ()
@@! String -> LuaComponentEvent
SetExpr String
fs

loadLib :: Lua.Lua ()
loadLib :: Lua ()
loadLib = String -> Lua () -> Lua ()
Lua.requirehs "minilight" (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
  Lua ()
Lua.create
  String -> (ByteString -> Lua FigureDSL) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "picture"   ByteString -> Lua FigureDSL
minilight_picture
  String -> (Int -> Int -> FigureDSL -> Lua FigureDSL) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "translate" Int -> Int -> FigureDSL -> Lua FigureDSL
minilight_translate
  String
-> (ByteString -> (Int, Int, Int, Int) -> Lua FigureDSL) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "text"      ByteString -> (Int, Int, Int, Int) -> Lua FigureDSL
minilight_text
 where
  minilight_picture :: BS.ByteString -> Lua.Lua FigureDSL
  minilight_picture :: ByteString -> Lua FigureDSL
minilight_picture cs :: ByteString
cs = FigureDSL -> Lua FigureDSL
forall (m :: * -> *) a. Monad m => a -> m a
return (FigureDSL -> Lua FigureDSL) -> FigureDSL -> Lua FigureDSL
forall a b. (a -> b) -> a -> b
$ String -> FigureDSL
Picture (String -> FigureDSL) -> String -> FigureDSL
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 ByteString
cs

  minilight_translate :: Int -> Int -> FigureDSL -> Lua.Lua FigureDSL
  minilight_translate :: Int -> Int -> FigureDSL -> Lua FigureDSL
minilight_translate x :: Int
x y :: Int
y fig :: FigureDSL
fig = FigureDSL -> Lua FigureDSL
forall (m :: * -> *) a. Monad m => a -> m a
return (FigureDSL -> Lua FigureDSL) -> FigureDSL -> Lua FigureDSL
forall a b. (a -> b) -> a -> b
$ V2 Int -> FigureDSL -> FigureDSL
Translate (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
Vect.V2 Int
x Int
y) FigureDSL
fig

  minilight_text :: BS.ByteString -> (Int, Int, Int, Int) -> Lua.Lua FigureDSL
  minilight_text :: ByteString -> (Int, Int, Int, Int) -> Lua FigureDSL
minilight_text cs :: ByteString
cs (r :: Int
r, g :: Int
g, b :: Int
b, a :: Int
a) = FigureDSL -> Lua FigureDSL
forall (m :: * -> *) a. Monad m => a -> m a
return (FigureDSL -> Lua FigureDSL) -> FigureDSL -> Lua FigureDSL
forall a b. (a -> b) -> a -> b
$ V4 Word8 -> Text -> FigureDSL
Text
    ( Word8 -> Word8 -> Word8 -> Word8 -> V4 Word8
forall a. a -> a -> a -> a -> V4 a
Vect.V4 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
              (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g)
              (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
              (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a)
    )
    (ByteString -> Text
TLE.decodeUtf8 ByteString
cs)