module Fresco.System
where
import Data.ByteString
import Data.ByteString.Unsafe
import qualified Data.ByteString.Lazy as BL
import Data.MessagePack
import Data.Either
import Data.Maybe
import Data.Serialize
import Foreign
import Foreign.C
import Foreign.Ptr
import Fresco.Component
#ifdef UseWinDLLLoading
import System.Win32.DLL
#else
import System.Posix.DynamicLinker
#endif
import System.Environment
import System.IO.Unsafe
import Data.IORef
toMsg :: ComponentClass o => o -> ByteString
toMsg o = encode (toObj o)
fromMsg :: ComponentClass o => ByteString -> Maybe o
fromMsg bs = case decode bs of
Right o -> Just $ fromObj o
_ -> Nothing
type MsgFunction = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32
foreign import ccall "dynamic"
mkMsgFun :: FunPtr MsgFunction -> MsgFunction
foreign import ccall "wrapper"
mkMsgFunPtr :: MsgFunction -> IO (FunPtr MsgFunction)
callMsgFunction :: FunPtr MsgFunction -> Ptr () -> Word64 -> ByteString -> IO Int
callMsgFunction mf p ct msg = do
let f = mkMsgFun mf
let dat = msg
unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> f p ct dat'1 dat'2 >>= \res -> return (fromIntegral res)
type InitFunction = Ptr () -> IO Word32
foreign import ccall "dynamic"
mkInitFun :: FunPtr InitFunction -> InitFunction
callInitFunction :: FunPtr InitFunction -> Ptr () -> IO Int
callInitFunction ifp p = do
let f = mkInitFun ifp
res <- f p
return (fromIntegral res)
type EntityCreateFunction = ((Ptr CChar) -> (Word32 -> ((Ptr (Ptr ())) -> (IO ()))))
foreign import ccall "dynamic"
mkEntityCreateFunction :: FunPtr EntityCreateFunction -> EntityCreateFunction
type EntitySetFunction = ((Ptr CChar) -> (Word32 -> ((Ptr ()) -> (IO ()))))
foreign import ccall "dynamic"
mkEntitySetFunction :: FunPtr EntitySetFunction -> EntitySetFunction
type EntityGetDataFunction = ((Ptr ()) -> Word64 -> (Ptr (Ptr ())) -> IO ())
foreign import ccall "dynamic"
mkEntityGetDataFunction :: FunPtr EntityGetDataFunction -> EntityGetDataFunction
type EntityDataReadFunction = ((Ptr ()) -> (Ptr (Ptr CChar)) -> (Ptr Word32) -> IO ())
foreign import ccall "dynamic"
mkEntityDataReadFunction :: FunPtr EntityDataReadFunction -> EntityDataReadFunction
type EntityDataReleaseFunction = ((Ptr ()) -> IO ())
foreign import ccall "dynamic"
mkEntityDataReleaseFunction :: FunPtr EntityDataReleaseFunction -> EntityDataReleaseFunction
type CallbackSystemCreateFunction = ((Ptr (Ptr ())) -> (IO ()))
foreign import ccall "dynamic"
mkCallbackSystemCreateFunction :: FunPtr CallbackSystemCreateFunction -> CallbackSystemCreateFunction
type CallbackSystemRegisterReceiverFunction = ((Ptr ()) -> ((Ptr ()) -> (Word64 -> ((FunPtr ((Ptr ()) -> (Word64 -> ((Ptr CChar) -> (Word32 -> (IO Word32))))) -> (IO ()))))))
foreign import ccall "dynamic"
mkCallbackSystemRegisterReceiverFunction :: FunPtr CallbackSystemRegisterReceiverFunction -> CallbackSystemRegisterReceiverFunction
type CallbackSystemStepFunction = ((Ptr ()) -> (IO ()))
foreign import ccall "dynamic"
mkCallbackSystemStepFunction:: FunPtr CallbackSystemStepFunction -> CallbackSystemStepFunction
data EntityInterface = EntityInterface {
efCreate :: EntityCreateFunction,
efSet :: EntitySetFunction,
cbsfCreate :: CallbackSystemCreateFunction,
cbsfRegisterReceiver :: CallbackSystemRegisterReceiverFunction,
cbsfStep :: CallbackSystemStepFunction,
edGet :: EntityGetDataFunction,
edRead :: EntityDataReadFunction,
edRelease :: EntityDataReleaseFunction
}
#ifdef UseWinDLLLoading
dynamicEI :: IORef EntityInterface
dynamicEI = unsafePerformIO (do
libname <- getEnv "INTONACO"
dll <- loadLibrary libname
efc <- getProcAddress dll "entity_create"
let efc' = mkEntityCreateFunction $ castPtrToFunPtr efc
efs <- getProcAddress dll "entity_set"
let efs' = mkEntitySetFunction $ castPtrToFunPtr efs
cbc <- getProcAddress dll "callback_system_create"
let cbc' = mkCallbackSystemCreateFunction $ castPtrToFunPtr cbc
cbr <- getProcAddress dll "callback_system_register_receiver"
let cbr' = mkCallbackSystemRegisterReceiverFunction $ castPtrToFunPtr cbr
cbs <- getProcAddress dll "callback_system_step"
let cbs' = mkCallbackSystemStepFunction $ castPtrToFunPtr cbs
edg <- getProcAddress dll "entity_get_data"
let edg' = mkEntityGetDataFunction $ castPtrToFunPtr edg
edr <- getProcAddress dll "entity_data_read"
let edr' = mkEntityDataReadFunction $ castPtrToFunPtr edr
edd <- getProcAddress dll "entity_data_release"
let edd' = mkEntityDataReleaseFunction $ castPtrToFunPtr edd
ref <- newIORef $ EntityInterface efc' efs' cbc' cbr' cbs' edg' edr' edd'
return ref
)
#else
dynamicEI :: IORef EntityInterface
dynamicEI = unsafePerformIO (
do
libname <- getEnv "INTONACO"
dll <- dlopen libname [RTLD_NOW]
efc <- dlsym dll "entity_create"
let efc' = mkEntityCreateFunction efc
efs <- dlsym dll "entity_set"
let efs' = mkEntitySetFunction efs
cbc <- dlsym dll "callback_system_create"
let cbc' = mkCallbackSystemCreateFunction cbc
cbr <- dlsym dll "callback_system_register_receiver"
let cbr' = mkCallbackSystemRegisterReceiverFunction cbr
cbs <- dlsym dll "callback_system_step"
let cbs' = mkCallbackSystemStepFunction cbs
edg <- dlsym dll "entity_get_data"
let edg' = mkEntityGetDataFunction edg
edr <- dlsym dll "entity_data_read"
let edr' = mkEntityDataReadFunction edr
edd <- dlsym dll "entity_data_release"
let edd' = mkEntityDataReleaseFunction edd
ref <- newIORef $ EntityInterface efc' efs' cbc' cbr' cbs' edg' edr' edd'
return ref
)
#endif
type CStringCLen i = (CString, i)
unsafeUseAsCStringLen' :: (Integral i) => ByteString -> (CStringCLen i -> IO a) -> IO a
unsafeUseAsCStringLen' str fn =
unsafeUseAsCStringLen str (\(ptr, len) -> fn (ptr, fromIntegral len))
entityCreate :: (ByteString) -> IO ((Ptr ()))
entityCreate a1 =
unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) ->
alloca $ \a2' ->
(do
dei <- readIORef dynamicEI
(efCreate dei) a1'1 a1'2 a2') >>
peek a2' >>= \a2'' ->
return (a2'')
entitySet :: (ByteString) -> (Ptr ()) -> IO ()
entitySet a1 a2 =
unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) ->
let {a2' = id a2} in
(do
dei <- readIORef dynamicEI
(efSet dei) a1'1 a1'2 a2') >>
return ()
entityGetData :: (Ptr ()) -> Word64 -> IO ((Ptr ()))
entityGetData a1 a2 =
alloca $ \a3' ->
(do
dei <- readIORef dynamicEI
(edGet dei) a1 (fromIntegral a2) a3') >>
peek a3' >>= \a3'' ->
return (a3'')
entityDataRead :: Ptr () -> IO ByteString
entityDataRead a1 =
alloca $ \a2' ->
alloca $ \a3' ->
(do
dei <- readIORef dynamicEI
(edRead dei) a1 a2' a3') >>
peek a2' >>= \a2'' ->
peek a3' >>= \a3'' ->
(do
bs <- packCStringLen (a2'', fromIntegral a3'')
return bs
)
entityDataRelease :: Ptr () -> IO ()
entityDataRelease a1 = do
dei <- readIORef dynamicEI
(edRelease dei) a1
return ()
callbackSystemCreate :: IO ((Ptr ()))
callbackSystemCreate =
alloca $ \a1' ->
(do
dei <- readIORef dynamicEI
(cbsfCreate dei) a1') >>
peek a1'>>= \a1'' ->
return (a1'')
callbackSystemRegisterReceiver :: (Ptr ()) -> (Ptr ()) -> (Word64) -> (FunPtr (Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32)) -> IO ()
callbackSystemRegisterReceiver a1 a2 a3 a4 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = fromIntegral a3} in
let {a4' = id a4} in
(do
dei <- readIORef dynamicEI
(cbsfRegisterReceiver dei) a1' a2' a3' a4') >>
return ()
callbackSystemStep :: (Ptr ()) -> IO ()
callbackSystemStep a1 =
let {a1' = id a1} in
(do
dei <- readIORef dynamicEI
(cbsfStep dei) a1') >>
return ()