{-# 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)