minilight-lua 0.1.0.0 → 0.2.0.0

raw patch · 8 files changed

+380/−41 lines, 8 filesdep +containersdep +sdl2-ttfPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, sdl2-ttf

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +73/−0
• example/Main.hs +1/−1
• minilight-lua.cabal +13/−2
• src/Data/Cache.hs +42/−0
• src/MiniLight/FigureDSL.hs +23/−11
• src/MiniLight/Lua.hs +180/−27
• src/lib.lua +42/−0

@@ -1,5 +1,11 @@ # Revision history for minilight-lua +## 0.2.0.0 -- 2020-05-13++* Some hooks supported:+  * mouse state: useMouseMove, useMousePressed, useMouseReleased+  * extra utility: useState+ ## 0.1.0.0 -- 2020-05-10  * First version.

@@ -0,0 +1,73 @@+# minilight-lua++[![Hackage](http://img.shields.io/hackage/v/minilight-lua.svg)](https://hackage.haskell.org/package/minilight-lua) [![MIT license](http://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)++A binding library of [minilight](https://github.com/myuon/minilight) for Lua language.++*NB: This package is in the very early stage.*++## What's this?++- [minilight](http://hackage.haskell.org/package/minilight) is a SDL2-based graphics library, equipped with component system.+- [Lua](https://www.lua.org) is a lightweight interpreted language.++With this library, you can write a minilight component in Lua language.++## Getting Started++See [example](https://github.com/myuon/minilight-lua/tree/master/example) directory. `Main.hs` is an entrypoint for minilight engine.++```hs+mainFile = "example/main.lua"++main :: IO ()+main = runLightT $ runMiniloop+  (defConfig { hotConfigReplacement = Just "example", appConfigFile = Just "" })+  initial+  (const mainloop)+ where+  initial = do+    comp <- registerComponent mainFile newLuaComponent+    reload mainFile++    return ()++  mainloop :: MiniLoop ()+  mainloop = do+    ref <- view _events+    evs <- liftIO $ tryReadMVar ref++    let notifys = case evs of+          Just evs -> mapMaybe asNotifyEvent evs+          _        -> []+    unless (null notifys) $ reload mainFile+```++Some notes here:++- When you pass `hotConfigReplacement` field, minilight will watch the given directory and emits *file changed/created/delete* events during the mainloop.+- For `registerComponent` you need to pass the filename like `example/main.lua`. The path is relative where you run `cabal run`.+- In `mainloop`, watches any events and `reload` the component. The `reload` function will load the lua file again and swap the component dynamically (code swapping).++```lua+local minilight = require("minilight")++function onDraw()+    print("[LUA OUTPUT] hello")++    return {+        minilight.translate(50, 50, minilight.picture("example/example.png")),+        minilight.translate(100, 100, minilight.text("こんにちは世界",+                                                     {0, 0, 0, 0})),+        minilight.translate(30, 50,+                            minilight.text("Hello, World!", {255, 0, 0, 0}))+    }+end++_G.onDraw = onDraw+```++For lua part:++- Require `minilight` library. This will be implicitly loaded by minilight-lua.+- You need to export `onDraw : () -> Array<minilight.Figure>` function globally. This function will be called from Haskell and the returned array will be rendered in the component.

@@ -17,7 +17,7 @@   (const mainloop)  where   initial = do-    comp <- registerComponent mainFile newLuaComponent+    comp <- registerComponent mainFile =<< liftIO newLuaComponent     reload mainFile      return ()

@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/  name:                minilight-lua-version:             0.1.0.0+version:             0.2.0.0 synopsis:            A binding library of minilight for Lua langauge. description:   This library provides a way to write minilight component in Lua language.@@ -15,27 +15,38 @@ maintainer:          ioi.joi.koi.loi@gmail.com -- copyright: category:            Graphics-extra-source-files:  CHANGELOG.md+extra-source-files:+  CHANGELOG.md+  README.md +data-files:+  src/lib.lua+ source-repository head   type:     git   location: https://github.com/myuon/minilight-lua.git  library   exposed-modules:+    Data.Cache     MiniLight.Lua     MiniLight.FigureDSL+    Paths_minilight_lua+  autogen-modules:+    Paths_minilight_lua   -- other-modules:   -- other-extensions:   build-depends:     base ^>=4.13.0.0,     bytestring >= 0.10,+    containers,     exceptions >= 0.10,     hslua >= 1.1,     linear >= 1.20,     minilight >= 0.5.0,     mtl >= 2.2,     sdl2 >= 2.4 && < 2.5,+    sdl2-ttf,     text >= 1.2,     unix-time >= 0.4,   hs-source-dirs:      src

@@ -0,0 +1,42 @@+module Data.Cache where++import Control.Monad.IO.Class+import Data.IORef+import qualified Data.Map as M+import qualified Data.Text as T++newtype CacheRegistry v = CacheRegistry { getCacheRegistry :: IORef (M.Map T.Text v) }++new :: MonadIO m => m (CacheRegistry v)+new = liftIO $ fmap CacheRegistry $ newIORef M.empty++size :: MonadIO m => CacheRegistry v -> m Int+size (CacheRegistry ref) = liftIO $ fmap M.size $ readIORef ref++register :: MonadIO m => T.Text -> v -> CacheRegistry v -> m ()+register t v cache =+  liftIO $ modifyIORef' (getCacheRegistry cache) $ M.insert t v++lookup :: MonadIO m => T.Text -> CacheRegistry v -> m (Maybe v)+lookup t cache =+  liftIO $ fmap (M.lookup t) $ readIORef (getCacheRegistry cache)++clear :: MonadIO m => CacheRegistry v -> m (M.Map T.Text v)+clear cache = liftIO $ do+  let ref = getCacheRegistry cache+  m <- readIORef ref+  writeIORef ref M.empty+  return m++getOrCreate :: MonadIO m => (T.Text -> m v) -> T.Text -> CacheRegistry v -> m v+getOrCreate alloc key cache = do+  result <- Data.Cache.lookup key cache+  (\f -> maybe f return result) $ do+    fig <- alloc key+    register key fig cache+    return fig++clearAll :: MonadIO m => (v -> m ()) -> CacheRegistry v -> m ()+clearAll free cache = do+  m <- clear cache+  mapM_ free (M.elems m)

@@ -3,11 +3,13 @@  import Control.Monad import qualified Data.Config.Font as Font+import qualified Data.Cache as Cache import qualified Data.Text as T import Data.Word (Word8) import MiniLight import qualified SDL import qualified SDL.Vect as Vect+import SDL.Font (Font) import Foreign.Lua  data FigureDSL@@ -24,14 +26,24 @@ instance Pushable FigureDSL where   push = push . show -construct :: FigureDSL -> MiniLight (Maybe Figure)-construct dsl = case dsl of-  Empty           -> return $ Just emptyFigure-  Translate p fig -> fmap (fmap (translate p)) $ construct fig-  Clip p q fig ->-    fmap (fmap (clip (SDL.Rectangle (Vect.P p) q))) $ construct fig-  Picture path -> fmap Just $ picture path-  Text color t -> do-    font <- Font.loadFontFrom-      $ Font.Config (FontDescriptor "IPAGothic" (FontStyle False False)) 24 0-    fmap Just $ text font color t+construct+  :: Cache.CacheRegistry Font+  -> Cache.CacheRegistry Figure+  -> FigureDSL+  -> MiniLight (Maybe Figure)+construct tc fc = go+ where+  go dsl = case dsl of+    Empty           -> return $ Just emptyFigure+    Translate p fig -> fmap (fmap (translate p)) $ go fig+    Clip p q fig    -> fmap (fmap (clip (SDL.Rectangle (Vect.P p) q))) $ go fig+    Picture path ->+      fmap Just $ Cache.getOrCreate (picture . T.unpack) (T.pack path) fc+    Text color t -> do+      font <- Cache.getOrCreate+        ( \name -> Font.loadFontFrom+          $ Font.Config (FontDescriptor name (FontStyle False False)) 24 0+        )+        "IPAGothic"+        tc+      fmap Just $ text font color t

@@ -5,31 +5,47 @@ 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 Foreign.C.String import Foreign.Ptr-import GHC.Generics (Generic)+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 LuaComponentState = LuaComponentState {-  mousePosition :: V2 Int-} deriving (Eq, Show)+  mousePosition :: IORef (V2 Int),+  mousePressed :: IORef Bool,+  mouseReleased :: IORef Bool,+  figCache :: Cache.CacheRegistry Figure,+  ttfCache :: Cache.CacheRegistry Font,+  luaState :: Lua.State,+  numberStates :: IORef (M.Map String (Ptr Double)),+  boolStates :: IORef (M.Map String (Ptr Bool)),+  stringStates :: IORef (M.Map String (Ptr CString)), +  -- Luaでの更新判定用+  updatedAtRef :: IORef UnixTime+}+ data LuaComponent = LuaComponent {   expr :: String,   state :: LuaComponentState,-  counter :: Int,-  updatedAt :: UnixTime+  updatedAt :: UnixTime,+  counter :: Int }  data LuaComponentEvent@@ -42,29 +58,73 @@   figures comp = evalLuaComponent (expr comp) (state comp)    onSignal ev = execStateT $ do+    get >>= \qc -> liftIO $ do+      writeIORef (mousePressed $ state qc) False+      writeIORef (mouseReleased $ state qc) False+    modify' $ \qc -> qc { counter = counter qc + 1 }+     lift $ Basic.emitBasicSignal ev (Basic.Config { Basic.size = V2 640 480, Basic.position = V2 0 0, Basic.visible = True })      case asSignal ev of       Just (SetExpr fs) -> do         t <- liftIO getUnixTime-        modify $ \qc -> qc { expr = fs, counter = counter qc + 1, updatedAt = t }+        modify' $ \qc -> qc { expr = fs, updatedAt = t }++        qc <- get+        liftIO $ writeIORef (updatedAtRef $ state qc) $ updatedAt qc       _ -> return ()      case asSignal ev of-      Just (Basic.MouseOver p) ->-        modify $ \qc -> qc { state = (state qc) { mousePosition = p }, counter = counter qc + 1 }+      Just (Basic.MouseOver p) -> do+        st <- get+        liftIO $ writeIORef (mousePosition $ state st) p+      Just (Basic.MousePressed _) -> do+        st <- get+        liftIO $ writeIORef (mousePressed $ state st) True+      Just (Basic.MouseReleased _) -> do+        st <- get+        liftIO $ writeIORef (mouseReleased $ state st) True       _ -> return () -  useCache c1 c2 = updatedAt c1 == updatedAt c2+  useCache c1 c2 = updatedAt c1 == updatedAt c2 && counter c1 == counter c2 -newLuaComponent :: LuaComponent-newLuaComponent = LuaComponent-  { expr      = ""-  , state     = LuaComponentState {mousePosition = 0}-  , counter   = 0-  , updatedAt = UnixTime 0 0-  }+newLuaComponent :: IO LuaComponent+newLuaComponent = do+  p   <- newIORef 0+  fc  <- Cache.new+  tc  <- Cache.new+  lua <- Lua.newstate+  mp  <- newIORef False+  mr  <- newIORef False+  ns  <- newIORef M.empty+  bs  <- newIORef M.empty+  ss  <- newIORef M.empty+  u   <- newIORef $ UnixTime 0 0 +  let state = LuaComponentState+        { mousePosition = p+        , figCache      = fc+        , ttfCache      = tc+        , luaState      = lua+        , mousePressed  = mp+        , mouseReleased = mr+        , numberStates  = ns+        , boolStates    = bs+        , stringStates  = ss+        , updatedAtRef  = u+        }++  Lua.runWith lua $ do+    Lua.openlibs+    loadLib state++  return $ LuaComponent+    { expr      = ""+    , state     = state+    , updatedAt = UnixTime 0 0+    , counter   = 0+    }+ evalLuaComponent   :: (HasLightEnv env, MonadIO m, MonadMask m)   => String@@ -73,9 +133,8 @@ evalLuaComponent content state   | content == "" = return []   | otherwise = do-    result <- liftIO $ Lua.run $ Lua.try $ do-      Lua.openlibs-      loadLib+    let lua = luaState state+    result <- liftIO $ Lua.runWith lua $ Lua.try $ do       st <- Lua.dostring $ TLE.encodeUtf8 $ T.pack content       case st of         Lua.OK -> Lua.callFunc "onDraw" ()@@ -83,7 +142,9 @@      case result of       Left  err -> Caster.err err >> return []-      Right rs  -> liftMiniLight $ fmap catMaybes $ mapM construct rs+      Right rs  -> liftMiniLight $ fmap catMaybes $ mapM+        (construct (ttfCache state) (figCache state))+        rs  reload   :: (HasLoaderEnv env, HasLightEnv env, HasLoopEnv env, MonadIO m, MonadMask m)@@ -93,12 +154,32 @@   fs <- liftIO $ readFile (T.unpack path)   path @@! SetExpr fs -loadLib :: Lua.Lua ()-loadLib = Lua.requirehs "minilight" $ do-  Lua.create-  Lua.addfunction "picture"   minilight_picture-  Lua.addfunction "translate" minilight_translate-  Lua.addfunction "text"      minilight_text+loadLib :: LuaComponentState -> Lua.Lua ()+loadLib state = do+  Lua.requirehs "minilight_raw" $ do+    Lua.create+    Lua.addfunction "picture"           minilight_picture+    Lua.addfunction "translate"         minilight_translate+    Lua.addfunction "text"              minilight_text+    Lua.addfunction "useMouseMove"      minilight_useMouseMove+    Lua.addfunction "useMousePressed"   minilight_useMousePressed+    Lua.addfunction "useMouseReleased"  minilight_useMouseReleased+    Lua.addfunction "newState_bool"     minilight_newStateBool+    Lua.addfunction "readState_bool"    minilight_readStateBool+    Lua.addfunction "writeState_bool"   minilight_writeStateBool+    Lua.addfunction "newState_string"   minilight_newStateString+    Lua.addfunction "readState_string"  minilight_readStateString+    Lua.addfunction "writeState_string" minilight_writeStateString+    Lua.addfunction "newState_number"   minilight_newStateNumber+    Lua.addfunction "readState_number"  minilight_readStateNumber+    Lua.addfunction "writeState_number" minilight_writeStateNumber++  Lua.requirehs "minilight" $ do+    lib <- liftIO $ getDataFileName "src/lib.lua"+    st  <- Lua.dofile lib+    case st of+      Lua.OK -> return ()+      _      -> Lua.throwException $ "Invalid status (lib): " ++ show st  where   minilight_picture :: BS.ByteString -> Lua.Lua FigureDSL   minilight_picture cs = return $ Picture $ T.unpack $ TLE.decodeUtf8 cs@@ -114,3 +195,75 @@               (fromIntegral a)     )     (TLE.decodeUtf8 cs)++  minilight_useMouseMove :: Lua.Lua (Int, Int)+  minilight_useMouseMove = do+    Vect.V2 x y <- liftIO $ readIORef $ mousePosition state+    return (x, y)++  minilight_useMousePressed :: Lua.Lua Bool+  minilight_useMousePressed = liftIO $ readIORef $ mousePressed state++  minilight_useMouseReleased :: Lua.Lua Bool+  minilight_useMouseReleased = liftIO $ readIORef $ mouseReleased state++  minilight_newStateBool :: Int -> Bool -> Lua.Lua (Ptr Bool)+  minilight_newStateBool index def = liftIO $ do+    m   <- readIORef $ boolStates state+    uat <- readIORef $ updatedAtRef state+    let key = show uat ++ "-" ++ show index+    case m M.!? key of+      Just k  -> return k+      Nothing -> do+        p <- malloc+        poke p def+        writeIORef (boolStates state) $ M.insert key p m+        return p++  minilight_readStateBool :: Ptr Bool -> Lua.Lua Bool+  minilight_readStateBool = liftIO . peek++  minilight_writeStateBool :: Ptr Bool -> Bool -> Lua.Lua ()+  minilight_writeStateBool p v = liftIO $ poke p v++  minilight_newStateString :: Int -> String -> Lua.Lua (Ptr CString)+  minilight_newStateString index def = liftIO $ do+    m   <- readIORef $ stringStates state+    uat <- readIORef $ updatedAtRef state+    let key = show uat ++ "-" ++ show index+    case m M.!? key of+      Just k  -> return k+      Nothing -> do+        p  <- malloc+        cs <- newCString def+        poke p cs+        writeIORef (stringStates state) $ M.insert key p m+        return p++  minilight_readStateString :: Ptr CString -> Lua.Lua String+  minilight_readStateString p = liftIO $ peekCString =<< peek p++  minilight_writeStateString :: Ptr CString -> String -> Lua.Lua ()+  minilight_writeStateString p v = liftIO $ do+    peek p >>= free+    cs <- newCString v+    poke p cs++  minilight_newStateNumber :: Int -> Lua.Number -> Lua.Lua (Ptr Double)+  minilight_newStateNumber index (Lua.Number def) = liftIO $ do+    m   <- readIORef $ numberStates state+    uat <- readIORef $ updatedAtRef state+    let key = show uat ++ "-" ++ show index+    case m M.!? key of+      Just k  -> return k+      Nothing -> do+        p <- malloc+        poke p def+        writeIORef (numberStates state) $ M.insert key p m+        return p++  minilight_readStateNumber :: Ptr Double -> Lua.Lua Lua.Number+  minilight_readStateNumber p = liftIO $ fmap Lua.Number $ peek p++  minilight_writeStateNumber :: Ptr Double -> Lua.Number -> Lua.Lua ()+  minilight_writeStateNumber p (Lua.Number v) = liftIO $ poke p v

@@ -0,0 +1,42 @@+local minilight_raw = require("minilight_raw")+local mod = minilight_raw++function mod.init() mod.useState_index = 0 end++function mod.useState(def)+    mod.useState_index = mod.useState_index + 1+    local index = mod.useState_index++    if (type(def) == "number") then+        local ref = minilight_raw.newState_number(index, def)++        return {+            value = minilight_raw.readState_number(ref),+            write = function(v)+                return minilight_raw.writeState_number(ref, v)+            end+        }+    elseif (type(def) == "string") then+        local ref = minilight_raw.newState_string(index, def)++        return {+            value = minilight_raw.readState_string(ref),+            write = function(v)+                return minilight_raw.writeState_string(ref, v)+            end+        }+    elseif (type(def) == "bool") then+        local ref = minilight_raw.newState_bool(index, def)++        return {+            value = minilight_raw.readState_bool(ref),+            write = function(v)+                return minilight_raw.writeState_bool(ref, v)+            end+        }+    else+        error("Type(" .. type(def) .. ") is not supported!")+    end+end++return mod