module Foreign.Matlab.Engine (
Engine,
newEngine,
engineEval,
engineGetVar,
engineSetVar,
EngineEvalArg(..),
engineEvalFun
) where
import Control.Monad
import Foreign
import Foreign.C.String
import Foreign.C.Types
import Data.List
import Foreign.Matlab.Util
import Foreign.Matlab.Internal
data EngineType
type EnginePtr = Ptr EngineType
newtype Engine = Engine (ForeignPtr EngineType)
foreign import ccall unsafe engOpen :: CString -> IO EnginePtr
foreign import ccall unsafe "&" engClose :: FunPtr (EnginePtr -> IO ())
newEngine :: FilePath -> IO Engine
newEngine bin = do
eng <- withCString bin engOpen
if eng == nullPtr
then fail "engOpen"
else Engine =.< newForeignPtr engClose eng
withEngine :: Engine -> (EnginePtr -> IO a) -> IO a
withEngine (Engine eng) = withForeignPtr eng
foreign import ccall unsafe engEvalString :: EnginePtr -> CString -> IO CInt
engineEval :: Engine -> String -> IO ()
engineEval eng s = do
r <- withEngine eng (withCString s . engEvalString)
when (r /= 0) $ fail "engineEval"
foreign import ccall unsafe engGetVariable :: EnginePtr -> CString -> IO MXArrayPtr
engineGetVar :: Engine -> String -> IO (MXArray a)
engineGetVar eng v = withEngine eng (withCString v . engGetVariable) >>= mkMXArray
foreign import ccall unsafe engPutVariable :: EnginePtr -> CString -> MXArrayPtr -> IO CInt
engineSetVar :: Engine -> String -> MXArray a -> IO ()
engineSetVar eng v x = do
r <- withEngine eng (\eng -> withCString v (withMXArray x . engPutVariable eng))
when (r /= 0) $ fail "engineSetVar"
data EngineEvalArg a = EvalArray (MXArray a) | EvalVar String
engineEvalFun :: Engine -> String -> [EngineEvalArg a] -> Int -> IO [MAnyArray]
engineEvalFun eng fun arg no = do
arg <- zipWithM makearg arg [1 :: Int ..]
let out = map makeout [1..no]
let outs = if out == [] then "" else "[" ++ unwords out ++ "] = "
engineEval eng (outs ++ fun ++ "(" ++ intercalate "," arg ++ ")")
mapM (engineGetVar eng) out
where
makearg (EvalArray x) i = do
let v = "hseval_in" ++ show i
engineSetVar eng v x
return v
makearg (EvalVar v) _ = return v
makeout i = "hseval_out" ++ show i