{-# 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.Cache as Cache
import qualified Data.Component.Basic as Basic
import Data.IORef
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as TLE
import Data.UnixTime
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Types.Peekable as Lua
import Foreign.Ptr
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Storable
import Linear
import MiniLight
import MiniLight.FigureDSL
import qualified SDL
import qualified SDL.Vect as Vect
import SDL.Font (Font)
import Paths_minilight_lua

data LuaValue
  = LuaNil
  | LuaBoolean Bool
  | LuaString T.Text
  | LuaNumber Double
  | LuaTable Table
  deriving (ReadPrec [LuaValue]
ReadPrec LuaValue
Int -> ReadS LuaValue
ReadS [LuaValue]
(Int -> ReadS LuaValue)
-> ReadS [LuaValue]
-> ReadPrec LuaValue
-> ReadPrec [LuaValue]
-> Read LuaValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LuaValue]
$creadListPrec :: ReadPrec [LuaValue]
readPrec :: ReadPrec LuaValue
$creadPrec :: ReadPrec LuaValue
readList :: ReadS [LuaValue]
$creadList :: ReadS [LuaValue]
readsPrec :: Int -> ReadS LuaValue
$creadsPrec :: Int -> ReadS LuaValue
Read, Int -> LuaValue -> ShowS
[LuaValue] -> ShowS
LuaValue -> String
(Int -> LuaValue -> ShowS)
-> (LuaValue -> String) -> ([LuaValue] -> ShowS) -> Show LuaValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaValue] -> ShowS
$cshowList :: [LuaValue] -> ShowS
show :: LuaValue -> String
$cshow :: LuaValue -> String
showsPrec :: Int -> LuaValue -> ShowS
$cshowsPrec :: Int -> LuaValue -> ShowS
Show)

newtype Table = Table [(LuaValue, LuaValue)]
  deriving (ReadPrec [Table]
ReadPrec Table
Int -> ReadS Table
ReadS [Table]
(Int -> ReadS Table)
-> ReadS [Table]
-> ReadPrec Table
-> ReadPrec [Table]
-> Read Table
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Table]
$creadListPrec :: ReadPrec [Table]
readPrec :: ReadPrec Table
$creadPrec :: ReadPrec Table
readList :: ReadS [Table]
$creadList :: ReadS [Table]
readsPrec :: Int -> ReadS Table
$creadsPrec :: Int -> ReadS Table
Read, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show)

instance Lua.Peekable LuaValue where
  peek :: StackIndex -> Lua LuaValue
peek i :: StackIndex
i = do
    Type
ltype <- StackIndex -> Lua Type
Lua.ltype StackIndex
i
    case Type
ltype of
      Lua.TypeNil -> LuaValue -> Lua LuaValue
forall (m :: * -> *) a. Monad m => a -> m a
return LuaValue
LuaNil
      Lua.TypeBoolean -> (Bool -> LuaValue) -> Lua Bool -> Lua LuaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> LuaValue
LuaBoolean (Lua Bool -> Lua LuaValue) -> Lua Bool -> Lua LuaValue
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua Bool
Lua.toboolean StackIndex
i
      Lua.TypeNumber -> (Maybe Number -> LuaValue) -> Lua (Maybe Number) -> Lua LuaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just (Lua.Number v :: Double
v)) -> Double -> LuaValue
LuaNumber Double
v) (Lua (Maybe Number) -> Lua LuaValue)
-> Lua (Maybe Number) -> Lua LuaValue
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua (Maybe Number)
Lua.tonumber StackIndex
i
      Lua.TypeString -> (Maybe ByteString -> LuaValue)
-> Lua (Maybe ByteString) -> Lua LuaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just v :: ByteString
v) -> Text -> LuaValue
LuaString (Text -> LuaValue) -> Text -> LuaValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 ByteString
v) (Lua (Maybe ByteString) -> Lua LuaValue)
-> Lua (Maybe ByteString) -> Lua LuaValue
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua (Maybe ByteString)
Lua.tostring StackIndex
i
      Lua.TypeTable -> (Table -> LuaValue) -> Lua Table -> Lua LuaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Table -> LuaValue
LuaTable (Lua Table -> Lua LuaValue) -> Lua Table -> Lua LuaValue
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua Table
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
i

instance Lua.Pushable LuaValue where
  push :: LuaValue -> Lua ()
push val :: LuaValue
val = case LuaValue
val of
    LuaNil -> Lua ()
Lua.pushnil
    LuaBoolean b :: Bool
b -> Bool -> Lua ()
Lua.pushboolean Bool
b
    LuaString t :: Text
t -> ByteString -> Lua ()
Lua.pushstring (ByteString -> Lua ()) -> ByteString -> Lua ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
t
    LuaNumber d :: Double
d -> Number -> Lua ()
Lua.pushnumber (Number -> Lua ()) -> Number -> Lua ()
forall a b. (a -> b) -> a -> b
$ Double -> Number
Lua.Number Double
d
    LuaTable t :: Table
t -> Table -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Table
t

instance Lua.Peekable Table where
  peek :: StackIndex -> Lua Table
peek i :: StackIndex
i = ([(LuaValue, LuaValue)] -> Table)
-> Lua [(LuaValue, LuaValue)] -> Lua Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(LuaValue, LuaValue)] -> Table
Table (Lua [(LuaValue, LuaValue)] -> Lua Table)
-> Lua [(LuaValue, LuaValue)] -> Lua Table
forall a b. (a -> b) -> a -> b
$ StackIndex -> Lua [(LuaValue, LuaValue)]
forall a b. (Peekable a, Peekable b) => StackIndex -> Lua [(a, b)]
Lua.peekKeyValuePairs StackIndex
i

instance Lua.Pushable Table where
  push :: Table -> Lua ()
push (Table kv :: [(LuaValue, LuaValue)]
kv) = do
    Lua ()
Lua.newtable
    ((LuaValue, LuaValue) -> Lua ())
-> [(LuaValue, LuaValue)] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(k :: LuaValue
k,v :: LuaValue
v) -> LuaValue -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push LuaValue
k Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LuaValue -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push LuaValue
v Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-3)) [(LuaValue, LuaValue)]
kv

data LuaComponentState = LuaComponentState {
  LuaComponentState -> IORef (V2 Int)
mousePosition :: IORef (V2 Int),
  LuaComponentState -> IORef Bool
mousePressed :: IORef Bool,
  LuaComponentState -> IORef Bool
mouseReleased :: IORef Bool,
  LuaComponentState -> CacheRegistry Figure
figCache :: Cache.CacheRegistry Figure,
  LuaComponentState -> CacheRegistry Font
ttfCache :: Cache.CacheRegistry Font,
  LuaComponentState -> State
luaState :: Lua.State,
  LuaComponentState -> IORef (Map String (Ptr Double))
numberStates :: IORef (M.Map String (Ptr Double)),
  LuaComponentState -> IORef (Map String (Ptr Bool))
boolStates :: IORef (M.Map String (Ptr Bool)),
  LuaComponentState -> IORef (Map String (Ptr CString))
stringStates :: IORef (M.Map String (Ptr CString)),
  LuaComponentState -> IORef (Map String (Ptr CString))
tableStates :: IORef (M.Map String (Ptr CString)),

  -- Luaでの更新判定用
  LuaComponentState -> IORef UnixTime
updatedAtRef :: IORef UnixTime
}

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

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
    StateT LuaComponent (LightT env m) LuaComponent
forall s (m :: * -> *). MonadState s m => m s
get StateT LuaComponent (LightT env m) LuaComponent
-> (LuaComponent -> StateT LuaComponent (LightT env m) ())
-> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \qc :: LuaComponent
qc -> IO () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT LuaComponent (LightT env m) ())
-> IO () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef Bool
mousePressed (LuaComponentState -> IORef Bool)
-> LuaComponentState -> IORef Bool
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
qc) Bool
False
      IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef Bool
mouseReleased (LuaComponentState -> IORef Bool)
-> LuaComponentState -> IORef Bool
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
qc) Bool
False
    (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 { counter :: Int
counter = LuaComponent -> Int
counter LuaComponent
qc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }

    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, updatedAt :: UnixTime
updatedAt = UnixTime
t }

        LuaComponent
qc <- StateT LuaComponent (LightT env m) LuaComponent
forall s (m :: * -> *). MonadState s m => m s
get
        IO () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT LuaComponent (LightT env m) ())
-> IO () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ IORef UnixTime -> UnixTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef UnixTime
updatedAtRef (LuaComponentState -> IORef UnixTime)
-> LuaComponentState -> IORef UnixTime
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
qc) (UnixTime -> IO ()) -> UnixTime -> IO ()
forall a b. (a -> b) -> a -> b
$ LuaComponent -> UnixTime
updatedAt LuaComponent
qc
      _ -> () -> 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) -> do
        LuaComponent
st <- StateT LuaComponent (LightT env m) LuaComponent
forall s (m :: * -> *). MonadState s m => m s
get
        IO () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT LuaComponent (LightT env m) ())
-> IO () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ IORef (V2 Int) -> V2 Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef (V2 Int)
mousePosition (LuaComponentState -> IORef (V2 Int))
-> LuaComponentState -> IORef (V2 Int)
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
st) V2 Int
p
      Just (Basic.MousePressed _) -> do
        LuaComponent
st <- StateT LuaComponent (LightT env m) LuaComponent
forall s (m :: * -> *). MonadState s m => m s
get
        IO () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT LuaComponent (LightT env m) ())
-> IO () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef Bool
mousePressed (LuaComponentState -> IORef Bool)
-> LuaComponentState -> IORef Bool
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
st) Bool
True
      Just (Basic.MouseReleased _) -> do
        LuaComponent
st <- StateT LuaComponent (LightT env m) LuaComponent
forall s (m :: * -> *). MonadState s m => m s
get
        IO () -> StateT LuaComponent (LightT env m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT LuaComponent (LightT env m) ())
-> IO () -> StateT LuaComponent (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef Bool
mouseReleased (LuaComponentState -> IORef Bool)
-> LuaComponentState -> IORef Bool
forall a b. (a -> b) -> a -> b
$ LuaComponent -> LuaComponentState
state LuaComponent
st) Bool
True
      _ -> () -> 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 Bool -> Bool -> Bool
&& LuaComponent -> Int
counter LuaComponent
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== LuaComponent -> Int
counter LuaComponent
c2

newLuaComponent :: IO LuaComponent
newLuaComponent :: IO LuaComponent
newLuaComponent = do
  IORef (V2 Int)
p   <- V2 Int -> IO (IORef (V2 Int))
forall a. a -> IO (IORef a)
newIORef 0
  CacheRegistry Figure
fc  <- IO (CacheRegistry Figure)
forall (m :: * -> *) v. MonadIO m => m (CacheRegistry v)
Cache.new
  CacheRegistry Font
tc  <- IO (CacheRegistry Font)
forall (m :: * -> *) v. MonadIO m => m (CacheRegistry v)
Cache.new
  State
lua <- IO State
Lua.newstate
  IORef Bool
mp  <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IORef Bool
mr  <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IORef (Map String (Ptr Double))
ns  <- Map String (Ptr Double) -> IO (IORef (Map String (Ptr Double)))
forall a. a -> IO (IORef a)
newIORef Map String (Ptr Double)
forall k a. Map k a
M.empty
  IORef (Map String (Ptr Bool))
bs  <- Map String (Ptr Bool) -> IO (IORef (Map String (Ptr Bool)))
forall a. a -> IO (IORef a)
newIORef Map String (Ptr Bool)
forall k a. Map k a
M.empty
  IORef (Map String (Ptr CString))
ss  <- Map String (Ptr CString) -> IO (IORef (Map String (Ptr CString)))
forall a. a -> IO (IORef a)
newIORef Map String (Ptr CString)
forall k a. Map k a
M.empty
  IORef (Map String (Ptr CString))
ts  <- Map String (Ptr CString) -> IO (IORef (Map String (Ptr CString)))
forall a. a -> IO (IORef a)
newIORef Map String (Ptr CString)
forall k a. Map k a
M.empty
  IORef UnixTime
u   <- UnixTime -> IO (IORef UnixTime)
forall a. a -> IO (IORef a)
newIORef (UnixTime -> IO (IORef UnixTime))
-> UnixTime -> IO (IORef UnixTime)
forall a b. (a -> b) -> a -> b
$ CTime -> Int32 -> UnixTime
UnixTime 0 0

  let state :: LuaComponentState
state = LuaComponentState :: IORef (V2 Int)
-> IORef Bool
-> IORef Bool
-> CacheRegistry Figure
-> CacheRegistry Font
-> State
-> IORef (Map String (Ptr Double))
-> IORef (Map String (Ptr Bool))
-> IORef (Map String (Ptr CString))
-> IORef (Map String (Ptr CString))
-> IORef UnixTime
-> LuaComponentState
LuaComponentState
        { mousePosition :: IORef (V2 Int)
mousePosition = IORef (V2 Int)
p
        , figCache :: CacheRegistry Figure
figCache      = CacheRegistry Figure
fc
        , ttfCache :: CacheRegistry Font
ttfCache      = CacheRegistry Font
tc
        , luaState :: State
luaState      = State
lua
        , mousePressed :: IORef Bool
mousePressed  = IORef Bool
mp
        , mouseReleased :: IORef Bool
mouseReleased = IORef Bool
mr
        , numberStates :: IORef (Map String (Ptr Double))
numberStates  = IORef (Map String (Ptr Double))
ns
        , boolStates :: IORef (Map String (Ptr Bool))
boolStates    = IORef (Map String (Ptr Bool))
bs
        , stringStates :: IORef (Map String (Ptr CString))
stringStates  = IORef (Map String (Ptr CString))
ss
        , tableStates :: IORef (Map String (Ptr CString))
tableStates   = IORef (Map String (Ptr CString))
ts
        , updatedAtRef :: IORef UnixTime
updatedAtRef  = IORef UnixTime
u
        }

  State -> Lua () -> IO ()
forall a. State -> Lua a -> IO a
Lua.runWith State
lua (Lua () -> IO ()) -> Lua () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Lua ()
Lua.openlibs
    LuaComponentState -> Lua ()
loadLib LuaComponentState
state

  LuaComponent -> IO LuaComponent
forall (m :: * -> *) a. Monad m => a -> m a
return (LuaComponent -> IO LuaComponent)
-> LuaComponent -> IO LuaComponent
forall a b. (a -> b) -> a -> b
$ LuaComponent :: String -> LuaComponentState -> UnixTime -> Int -> LuaComponent
LuaComponent
    { expr :: String
expr      = ""
    , state :: LuaComponentState
state     = LuaComponentState
state
    , updatedAt :: UnixTime
updatedAt = CTime -> Int32 -> UnixTime
UnixTime 0 0
    , counter :: Int
counter   = 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
    let lua :: State
lua = LuaComponentState -> State
luaState LuaComponentState
state
    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
$ State
-> Lua (Either Exception [FigureDSL])
-> IO (Either Exception [FigureDSL])
forall a. State -> Lua a -> IO a
Lua.runWith State
lua (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
      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
        (CacheRegistry Font
-> CacheRegistry Figure
-> FigureDSL
-> LightT LightEnv IO (Maybe Figure)
construct (LuaComponentState -> CacheRegistry Font
ttfCache LuaComponentState
state) (LuaComponentState -> CacheRegistry Figure
figCache LuaComponentState
state))
        [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 :: LuaComponentState -> Lua.Lua ()
loadLib :: LuaComponentState -> Lua ()
loadLib state :: LuaComponentState
state = do
  String -> Lua () -> Lua ()
Lua.requirehs "minilight_raw" (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
    String -> Lua (Int, Int) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "useMouseMove"      Lua (Int, Int)
minilight_useMouseMove
    String -> Lua Bool -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "useMousePressed"   Lua Bool
minilight_useMousePressed
    String -> Lua Bool -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "useMouseReleased"  Lua Bool
minilight_useMouseReleased
    String -> (Int -> Bool -> Lua (Ptr Bool)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "newState_bool"     Int -> Bool -> Lua (Ptr Bool)
minilight_newStateBool
    String -> (Ptr Bool -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "readState_bool"    Ptr Bool -> Lua Bool
minilight_readStateBool
    String -> (Ptr Bool -> Bool -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "writeState_bool"   Ptr Bool -> Bool -> Lua ()
minilight_writeStateBool
    String -> (Int -> String -> Lua (Ptr CString)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "newState_string"   Int -> String -> Lua (Ptr CString)
minilight_newStateString
    String -> (Ptr CString -> Lua String) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "readState_string"  Ptr CString -> Lua String
minilight_readStateString
    String -> (Ptr CString -> String -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "writeState_string" Ptr CString -> String -> Lua ()
minilight_writeStateString
    String -> (Int -> Number -> Lua (Ptr Double)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "newState_number"   Int -> Number -> Lua (Ptr Double)
minilight_newStateNumber
    String -> (Ptr Double -> Lua Number) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "readState_number"  Ptr Double -> Lua Number
minilight_readStateNumber
    String -> (Ptr Double -> Number -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "writeState_number" Ptr Double -> Number -> Lua ()
minilight_writeStateNumber
    String -> (Int -> Table -> Lua (Ptr CString)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "newState_table"    Int -> Table -> Lua (Ptr CString)
minilight_newStateTable
    String -> (Ptr CString -> Lua Table) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "readState_table"   Ptr CString -> Lua Table
minilight_readStateTable
    String -> (Ptr CString -> Table -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "writeState_table"  Ptr CString -> Table -> Lua ()
minilight_writeStateTable

  String -> Lua () -> Lua ()
Lua.requirehs "minilight" (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
    String
lib <- IO String -> Lua String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Lua String) -> IO String -> Lua String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getDataFileName "src/lib.lua"
    Status
st  <- String -> Lua Status
Lua.dofile String
lib
    case Status
st of
      Lua.OK -> () -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      _      -> String -> Lua ()
forall a. String -> Lua a
Lua.throwException (String -> Lua ()) -> String -> Lua ()
forall a b. (a -> b) -> a -> b
$ "Invalid status (lib): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Status -> String
forall a. Show a => a -> String
show Status
st
 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)

  minilight_useMouseMove :: Lua.Lua (Int, Int)
  minilight_useMouseMove :: Lua (Int, Int)
minilight_useMouseMove = do
    Vect.V2 x :: Int
x y :: Int
y <- IO (V2 Int) -> Lua (V2 Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V2 Int) -> Lua (V2 Int)) -> IO (V2 Int) -> Lua (V2 Int)
forall a b. (a -> b) -> a -> b
$ IORef (V2 Int) -> IO (V2 Int)
forall a. IORef a -> IO a
readIORef (IORef (V2 Int) -> IO (V2 Int)) -> IORef (V2 Int) -> IO (V2 Int)
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef (V2 Int)
mousePosition LuaComponentState
state
    (Int, Int) -> Lua (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x, Int
y)

  minilight_useMousePressed :: Lua.Lua Bool
  minilight_useMousePressed :: Lua Bool
minilight_useMousePressed = IO Bool -> Lua Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Lua Bool) -> IO Bool -> Lua Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef Bool
mousePressed LuaComponentState
state

  minilight_useMouseReleased :: Lua.Lua Bool
  minilight_useMouseReleased :: Lua Bool
minilight_useMouseReleased = IO Bool -> Lua Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Lua Bool) -> IO Bool -> Lua Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef Bool
mouseReleased LuaComponentState
state

  minilight_newStateBool :: Int -> Bool -> Lua.Lua (Ptr Bool)
  minilight_newStateBool :: Int -> Bool -> Lua (Ptr Bool)
minilight_newStateBool index :: Int
index def :: Bool
def = IO (Ptr Bool) -> Lua (Ptr Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Bool) -> Lua (Ptr Bool))
-> IO (Ptr Bool) -> Lua (Ptr Bool)
forall a b. (a -> b) -> a -> b
$ do
    Map String (Ptr Bool)
m   <- IORef (Map String (Ptr Bool)) -> IO (Map String (Ptr Bool))
forall a. IORef a -> IO a
readIORef (IORef (Map String (Ptr Bool)) -> IO (Map String (Ptr Bool)))
-> IORef (Map String (Ptr Bool)) -> IO (Map String (Ptr Bool))
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef (Map String (Ptr Bool))
boolStates LuaComponentState
state
    UnixTime
uat <- IORef UnixTime -> IO UnixTime
forall a. IORef a -> IO a
readIORef (IORef UnixTime -> IO UnixTime) -> IORef UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef UnixTime
updatedAtRef LuaComponentState
state
    let key :: String
key = UnixTime -> String
forall a. Show a => a -> String
show UnixTime
uat String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index
    case Map String (Ptr Bool)
m Map String (Ptr Bool) -> String -> Maybe (Ptr Bool)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? String
key of
      Just k :: Ptr Bool
k  -> Ptr Bool -> IO (Ptr Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bool
k
      Nothing -> do
        Ptr Bool
p <- IO (Ptr Bool)
forall a. Storable a => IO (Ptr a)
malloc
        Ptr Bool -> Bool -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Bool
p Bool
def
        IORef (Map String (Ptr Bool)) -> Map String (Ptr Bool) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef (Map String (Ptr Bool))
boolStates LuaComponentState
state) (Map String (Ptr Bool) -> IO ()) -> Map String (Ptr Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Ptr Bool -> Map String (Ptr Bool) -> Map String (Ptr Bool)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
key Ptr Bool
p Map String (Ptr Bool)
m
        Ptr Bool -> IO (Ptr Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bool
p

  minilight_readStateBool :: Ptr Bool -> Lua.Lua Bool
  minilight_readStateBool :: Ptr Bool -> Lua Bool
minilight_readStateBool = IO Bool -> Lua Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Lua Bool)
-> (Ptr Bool -> IO Bool) -> Ptr Bool -> Lua Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Bool -> IO Bool
forall a. Storable a => Ptr a -> IO a
peek

  minilight_writeStateBool :: Ptr Bool -> Bool -> Lua.Lua ()
  minilight_writeStateBool :: Ptr Bool -> Bool -> Lua ()
minilight_writeStateBool p :: Ptr Bool
p v :: Bool
v = IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool -> Bool -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Bool
p Bool
v

  minilight_newStateString :: Int -> String -> Lua.Lua (Ptr CString)
  minilight_newStateString :: Int -> String -> Lua (Ptr CString)
minilight_newStateString index :: Int
index def :: String
def = IO (Ptr CString) -> Lua (Ptr CString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CString) -> Lua (Ptr CString))
-> IO (Ptr CString) -> Lua (Ptr CString)
forall a b. (a -> b) -> a -> b
$ do
    Map String (Ptr CString)
m   <- IORef (Map String (Ptr CString)) -> IO (Map String (Ptr CString))
forall a. IORef a -> IO a
readIORef (IORef (Map String (Ptr CString)) -> IO (Map String (Ptr CString)))
-> IORef (Map String (Ptr CString))
-> IO (Map String (Ptr CString))
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef (Map String (Ptr CString))
stringStates LuaComponentState
state
    UnixTime
uat <- IORef UnixTime -> IO UnixTime
forall a. IORef a -> IO a
readIORef (IORef UnixTime -> IO UnixTime) -> IORef UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef UnixTime
updatedAtRef LuaComponentState
state
    let key :: String
key = UnixTime -> String
forall a. Show a => a -> String
show UnixTime
uat String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index
    case Map String (Ptr CString)
m Map String (Ptr CString) -> String -> Maybe (Ptr CString)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? String
key of
      Just k :: Ptr CString
k  -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
k
      Nothing -> do
        Ptr CString
p  <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
malloc
        CString
cs <- String -> IO CString
newCString String
def
        Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
p CString
cs
        IORef (Map String (Ptr CString))
-> Map String (Ptr CString) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef (Map String (Ptr CString))
stringStates LuaComponentState
state) (Map String (Ptr CString) -> IO ())
-> Map String (Ptr CString) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Ptr CString
-> Map String (Ptr CString)
-> Map String (Ptr CString)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
key Ptr CString
p Map String (Ptr CString)
m
        Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
p

  minilight_readStateString :: Ptr CString -> Lua.Lua String
  minilight_readStateString :: Ptr CString -> Lua String
minilight_readStateString p :: Ptr CString
p = IO String -> Lua String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Lua String) -> IO String -> Lua String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p

  minilight_writeStateString :: Ptr CString -> String -> Lua.Lua ()
  minilight_writeStateString :: Ptr CString -> String -> Lua ()
minilight_writeStateString p :: Ptr CString
p v :: String
v = IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p IO CString -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ()
forall a. Ptr a -> IO ()
free
    CString
cs <- String -> IO CString
newCString String
v
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
p CString
cs

  minilight_newStateNumber :: Int -> Lua.Number -> Lua.Lua (Ptr Double)
  minilight_newStateNumber :: Int -> Number -> Lua (Ptr Double)
minilight_newStateNumber index :: Int
index (Lua.Number def :: Double
def) = IO (Ptr Double) -> Lua (Ptr Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Double) -> Lua (Ptr Double))
-> IO (Ptr Double) -> Lua (Ptr Double)
forall a b. (a -> b) -> a -> b
$ do
    Map String (Ptr Double)
m   <- IORef (Map String (Ptr Double)) -> IO (Map String (Ptr Double))
forall a. IORef a -> IO a
readIORef (IORef (Map String (Ptr Double)) -> IO (Map String (Ptr Double)))
-> IORef (Map String (Ptr Double)) -> IO (Map String (Ptr Double))
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef (Map String (Ptr Double))
numberStates LuaComponentState
state
    UnixTime
uat <- IORef UnixTime -> IO UnixTime
forall a. IORef a -> IO a
readIORef (IORef UnixTime -> IO UnixTime) -> IORef UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef UnixTime
updatedAtRef LuaComponentState
state
    let key :: String
key = UnixTime -> String
forall a. Show a => a -> String
show UnixTime
uat String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index
    case Map String (Ptr Double)
m Map String (Ptr Double) -> String -> Maybe (Ptr Double)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? String
key of
      Just k :: Ptr Double
k  -> Ptr Double -> IO (Ptr Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Double
k
      Nothing -> do
        Ptr Double
p <- IO (Ptr Double)
forall a. Storable a => IO (Ptr a)
malloc
        Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Double
p Double
def
        IORef (Map String (Ptr Double)) -> Map String (Ptr Double) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef (Map String (Ptr Double))
numberStates LuaComponentState
state) (Map String (Ptr Double) -> IO ())
-> Map String (Ptr Double) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Ptr Double -> Map String (Ptr Double) -> Map String (Ptr Double)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
key Ptr Double
p Map String (Ptr Double)
m
        Ptr Double -> IO (Ptr Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Double
p

  minilight_readStateNumber :: Ptr Double -> Lua.Lua Lua.Number
  minilight_readStateNumber :: Ptr Double -> Lua Number
minilight_readStateNumber p :: Ptr Double
p = IO Number -> Lua Number
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Number -> Lua Number) -> IO Number -> Lua Number
forall a b. (a -> b) -> a -> b
$ (Double -> Number) -> IO Double -> IO Number
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Number
Lua.Number (IO Double -> IO Number) -> IO Double -> IO Number
forall a b. (a -> b) -> a -> b
$ Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
p

  minilight_writeStateNumber :: Ptr Double -> Lua.Number -> Lua.Lua ()
  minilight_writeStateNumber :: Ptr Double -> Number -> Lua ()
minilight_writeStateNumber p :: Ptr Double
p (Lua.Number v :: Double
v) = IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Double
p Double
v

  minilight_newStateTable :: Int -> Table -> Lua.Lua (Ptr CString)
  minilight_newStateTable :: Int -> Table -> Lua (Ptr CString)
minilight_newStateTable index :: Int
index def :: Table
def = IO (Ptr CString) -> Lua (Ptr CString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CString) -> Lua (Ptr CString))
-> IO (Ptr CString) -> Lua (Ptr CString)
forall a b. (a -> b) -> a -> b
$ do
    Map String (Ptr CString)
m   <- IORef (Map String (Ptr CString)) -> IO (Map String (Ptr CString))
forall a. IORef a -> IO a
readIORef (IORef (Map String (Ptr CString)) -> IO (Map String (Ptr CString)))
-> IORef (Map String (Ptr CString))
-> IO (Map String (Ptr CString))
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef (Map String (Ptr CString))
tableStates LuaComponentState
state
    UnixTime
uat <- IORef UnixTime -> IO UnixTime
forall a. IORef a -> IO a
readIORef (IORef UnixTime -> IO UnixTime) -> IORef UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ LuaComponentState -> IORef UnixTime
updatedAtRef LuaComponentState
state
    let key :: String
key = UnixTime -> String
forall a. Show a => a -> String
show UnixTime
uat String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index
    case Map String (Ptr CString)
m Map String (Ptr CString) -> String -> Maybe (Ptr CString)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? String
key of
      Just k :: Ptr CString
k  -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
k
      Nothing -> do
        Ptr CString
p  <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
malloc
        CString
cs <- String -> IO CString
newCString (String -> IO CString) -> String -> IO CString
forall a b. (a -> b) -> a -> b
$ Table -> String
forall a. Show a => a -> String
show Table
def
        Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
p CString
cs
        IORef (Map String (Ptr CString))
-> Map String (Ptr CString) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (LuaComponentState -> IORef (Map String (Ptr CString))
tableStates LuaComponentState
state) (Map String (Ptr CString) -> IO ())
-> Map String (Ptr CString) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Ptr CString
-> Map String (Ptr CString)
-> Map String (Ptr CString)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
key Ptr CString
p Map String (Ptr CString)
m
        Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
p

  minilight_readStateTable :: Ptr CString -> Lua.Lua Table
  minilight_readStateTable :: Ptr CString -> Lua Table
minilight_readStateTable p :: Ptr CString
p = IO Table -> Lua Table
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Table -> Lua Table) -> IO Table -> Lua Table
forall a b. (a -> b) -> a -> b
$ do
    CString
cs <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p
    (String -> Table) -> IO String -> IO Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Table
forall a. Read a => String -> a
read (IO String -> IO Table) -> IO String -> IO Table
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString CString
cs

  minilight_writeStateTable :: Ptr CString -> Table -> Lua.Lua ()
  minilight_writeStateTable :: Ptr CString -> Table -> Lua ()
minilight_writeStateTable p :: Ptr CString
p val :: Table
val = IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p IO CString -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ()
forall a. Ptr a -> IO ()
free
    CString
cs <- String -> IO CString
newCString (String -> IO CString) -> String -> IO CString
forall a b. (a -> b) -> a -> b
$ Table -> String
forall a. Show a => a -> String
show Table
val
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
p CString
cs