fresco-binding 0.2.0 → 0.3.0
raw patch · 7 files changed
+746/−785 lines, 7 filesdep +binarydep +binary-serialise-cbordep −cerealdep −messagepacksetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: binary, binary-serialise-cbor
Dependencies removed: cereal, messagepack
API changes (from Hackage documentation)
- Fresco.Component: class ComponentClass a
- Fresco.Component: fromObj :: ComponentClass a => Object -> a
- Fresco.Component: instance Fresco.Component.ComponentClass ()
- Fresco.Component: instance Fresco.Component.ComponentClass (Fresco.Component.ComponentType a)
- Fresco.Component: instance Fresco.Component.ComponentClass Data.ByteString.Internal.ByteString
- Fresco.Component: instance Fresco.Component.ComponentClass Data.Text.Internal.Text
- Fresco.Component: instance Fresco.Component.ComponentClass GHC.Types.Bool
- Fresco.Component: instance Fresco.Component.ComponentClass GHC.Types.Int
- Fresco.Component: instance Fresco.Component.ComponentClass a => Fresco.Component.ComponentClass (GHC.Base.Maybe a)
- Fresco.Component: toObj :: ComponentClass a => a -> Object
- Fresco.System: [cbsCreate] :: EntityInterface -> CallbackSystemCreateFunction
- Fresco.System: [eIdFree] :: EntityInterface -> EntityIdFreeFunction
- Fresco.System: [edGet] :: EntityInterface -> EntityGetDataFunction
- Fresco.System: [edRead] :: EntityInterface -> EntityDataReadFunction
- Fresco.System: [edRelease] :: EntityInterface -> EntityDataReleaseFunction
- Fresco.System: [edSet] :: EntityInterface -> EntitySetFunction
- Fresco.System: [olsCreate] :: EntityInterface -> ObjectLibSystemCreateFunction
- Fresco.System: callMsgFunction :: FunPtr MsgFunction -> Ptr () -> Word64 -> ByteString -> IO Int
- Fresco.System: entityDataRead :: Ptr () -> IO ByteString
- Fresco.System: entityDataRelease :: Ptr () -> IO ()
- Fresco.System: entityGetData :: (Ptr ()) -> Word64 -> IO ((Ptr ()))
- Fresco.System: entitySet :: (ByteString) -> (Ptr ()) -> IO ()
- Fresco.System: mkCallbackSystemCreateFunction :: FunPtr CallbackSystemCreateFunction -> CallbackSystemCreateFunction
- Fresco.System: mkEntityDataReadFunction :: FunPtr EntityDataReadFunction -> EntityDataReadFunction
- Fresco.System: mkEntityDataReleaseFunction :: FunPtr EntityDataReleaseFunction -> EntityDataReleaseFunction
- Fresco.System: mkEntityGetDataFunction :: FunPtr EntityGetDataFunction -> EntityGetDataFunction
- Fresco.System: mkEntityIdFreeFunction :: FunPtr EntityIdFreeFunction -> EntityIdFreeFunction
- Fresco.System: mkEntityIdFunction :: FunPtr EntityIdFunction -> EntityIdFunction
- Fresco.System: mkEntitySetFunction :: FunPtr EntitySetFunction -> EntitySetFunction
- Fresco.System: mkMsgFun :: FunPtr MsgFunction -> MsgFunction
- Fresco.System: mkMsgFunPtr :: MsgFunction -> IO (FunPtr MsgFunction)
- Fresco.System: mkObjectLibSystemCreateFunction :: FunPtr ObjectLibSystemCreateFunction -> ObjectLibSystemCreateFunction
- Fresco.System: type CallbackSystemCreateFunction = (Ptr (Ptr ())) -> (IO ())
- Fresco.System: type EntityDataReadFunction = (Ptr ()) -> (Ptr (Ptr CChar)) -> (Ptr Word32) -> IO ()
- Fresco.System: type EntityDataReleaseFunction = (Ptr ()) -> IO ()
- Fresco.System: type EntityGetDataFunction = (Ptr ()) -> Word64 -> (Ptr (Ptr ())) -> IO ()
- Fresco.System: type EntityIdFreeFunction = (Ptr CChar) -> IO ()
- Fresco.System: type EntityIdFunction = (Ptr ()) -> IO (Ptr CChar)
- Fresco.System: type EntitySetFunction = (Ptr CChar) -> (Word32 -> ((Ptr ()) -> (IO ())))
- Fresco.System: type MsgFunction = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32
- Fresco.System: type ObjectLibSystemCreateFunction = (Ptr (Ptr ())) -> (IO ())
+ Fresco.System: [cbsInit] :: EntityInterface -> CallbackSystemInitFunction
+ Fresco.System: [cbsShutdown] :: EntityInterface -> CallbackSystemShutdownFunction
+ Fresco.System: [eRead] :: EntityInterface -> EntityReadComponentFunction
+ Fresco.System: [eWrite] :: EntityInterface -> EntityWriteComponentFunction
+ Fresco.System: [olsInit] :: EntityInterface -> ObjectLibSystemInitFunction
+ Fresco.System: [olsRemoveEntity] :: EntityInterface -> ObjectLibSystemRemoveEntityFunction
+ Fresco.System: [olsShutdown] :: EntityInterface -> ObjectLibSystemShutdownFunction
+ Fresco.System: callMsgEntityFn :: FunPtr MsgEntityFn -> Ptr () -> Word64 -> ByteString -> IO Int
+ Fresco.System: callbackSystemShutdown :: (Ptr ()) -> IO ()
+ Fresco.System: entityRead :: Ptr () -> Word64 -> IO ByteString
+ Fresco.System: entityWrite :: (Ptr ()) -> Word64 -> ByteString -> IO ()
+ Fresco.System: mkCallbackSystemInitFunction :: FunPtr CallbackSystemInitFunction -> CallbackSystemInitFunction
+ Fresco.System: mkCallbackSystemShutdownFunction :: FunPtr CallbackSystemShutdownFunction -> CallbackSystemShutdownFunction
+ Fresco.System: mkEntityReadComponentFunction :: FunPtr EntityReadComponentFunction -> EntityReadComponentFunction
+ Fresco.System: mkEntityReadIdFunction :: FunPtr EntityReadIdFunction -> EntityReadIdFunction
+ Fresco.System: mkEntityWriteComponentFunction :: FunPtr EntityWriteComponentFunction -> EntityWriteComponentFunction
+ Fresco.System: mkMsgEntityFn :: FunPtr MsgEntityFn -> MsgEntityFn
+ Fresco.System: mkMsgEntityFnPtr :: MsgEntityFn -> IO (FunPtr MsgEntityFn)
+ Fresco.System: mkMsgFn :: FunPtr MsgFn -> MsgFn
+ Fresco.System: mkMsgFnPtr :: MsgFn -> IO (FunPtr MsgFn)
+ Fresco.System: mkObjectLibSystemInitFunction :: FunPtr ObjectLibSystemInitFunction -> ObjectLibSystemInitFunction
+ Fresco.System: mkObjectLibSystemRemoveEntityFunction :: FunPtr ObjectLibSystemRemoveEntityFunction -> ObjectLibSystemRemoveEntityFunction
+ Fresco.System: mkObjectLibSystemShutdownFunction :: FunPtr ObjectLibSystemShutdownFunction -> ObjectLibSystemShutdownFunction
+ Fresco.System: objectLibSystemShutdown :: (Ptr ()) -> IO ()
+ Fresco.System: type CallbackSystemInitFunction = Ptr (Ptr ()) -> IO ()
+ Fresco.System: type CallbackSystemShutdownFunction = Ptr () -> IO ()
+ Fresco.System: type EntityReadComponentFunction = Ptr () -> Word64 -> Ptr () -> FunPtr MsgFn -> IO ()
+ Fresco.System: type EntityReadIdFunction = Ptr () -> Ptr () -> FunPtr MsgFn -> IO ()
+ Fresco.System: type EntityWriteComponentFunction = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO ()
+ Fresco.System: type MsgEntityFn = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Int32
+ Fresco.System: type MsgFn = Ptr () -> Ptr CChar -> Word32 -> IO ()
+ Fresco.System: type ObjectLibSystemInitFunction = Ptr CChar -> Ptr (Ptr ()) -> IO ()
+ Fresco.System: type ObjectLibSystemRemoveEntityFunction = Ptr () -> Ptr () -> IO ()
+ Fresco.System: type ObjectLibSystemShutdownFunction = Ptr () -> IO ()
- Fresco.Entity: (#:) :: ComponentClass a => ComponentType a -> a -> (Word64, Component)
+ Fresco.Entity: (#:) :: Serialise a => ComponentType a -> a -> (Word64, Component)
- Fresco.Entity: readC :: ComponentClass a => Entity -> ComponentType a -> IO a
+ Fresco.Entity: readC :: Serialise a => Entity -> ComponentType a -> IO a
- Fresco.Entity: registerReceiverCBS :: ComponentClass a => CallbackSystem -> Entity -> ComponentType a -> (a -> IO ()) -> IO ()
+ Fresco.Entity: registerReceiverCBS :: Serialise a => CallbackSystem -> Entity -> ComponentType a -> (a -> IO ()) -> IO ()
- Fresco.Entity: setC :: ComponentClass a => Entity -> ComponentType a -> a -> IO ()
+ Fresco.Entity: setC :: Serialise a => Entity -> ComponentType a -> a -> IO ()
- Fresco.Entity: updateC :: ComponentClass a => Entity -> ComponentType a -> (a -> a) -> IO ()
+ Fresco.Entity: updateC :: Serialise a => Entity -> ComponentType a -> (a -> a) -> IO ()
- Fresco.System: EntityInterface :: EntityCreateFunction -> EntityDestroyFunction -> EntityIdFunction -> EntityIdFreeFunction -> EntitySetFunction -> EntityGetDataFunction -> EntityDataReadFunction -> EntityDataReleaseFunction -> ObjectLibSystemCreateFunction -> ObjectLibSystemAddEntityFunction -> ObjectLibSystemStepFunction -> CallbackSystemCreateFunction -> CallbackSystemRegisterReceiverFunction -> CallbackSystemStepFunction -> EntityInterface
+ Fresco.System: EntityInterface :: EntityCreateFunction -> EntityReadComponentFunction -> EntityWriteComponentFunction -> EntityReadIdFunction -> EntityDestroyFunction -> ObjectLibSystemInitFunction -> ObjectLibSystemAddEntityFunction -> ObjectLibSystemRemoveEntityFunction -> ObjectLibSystemShutdownFunction -> ObjectLibSystemStepFunction -> CallbackSystemInitFunction -> CallbackSystemRegisterReceiverFunction -> CallbackSystemShutdownFunction -> CallbackSystemStepFunction -> EntityInterface
- Fresco.System: [eId] :: EntityInterface -> EntityIdFunction
+ Fresco.System: [eId] :: EntityInterface -> EntityReadIdFunction
- Fresco.System: callbackSystemRegisterReceiver :: (Ptr ()) -> (Ptr ()) -> (Word64) -> (FunPtr (Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32)) -> IO ()
+ Fresco.System: callbackSystemRegisterReceiver :: (Ptr ()) -> (Ptr ()) -> (Word64) -> (FunPtr (Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Int32)) -> IO ()
- Fresco.System: entityCreate :: (ByteString) -> IO ((Ptr ()))
+ Fresco.System: entityCreate :: ByteString -> IO (Ptr ())
- Fresco.System: fromMsg :: ComponentClass o => ByteString -> Maybe o
+ Fresco.System: fromMsg :: Serialise o => ByteString -> o
- Fresco.System: objectLibSystemCreate :: IO ((Ptr ()))
+ Fresco.System: objectLibSystemCreate :: ByteString -> IO (Ptr ())
- Fresco.System: toMsg :: ComponentClass o => o -> ByteString
+ Fresco.System: toMsg :: Serialise o => o -> ByteString
- Fresco.System: type CallbackSystemRegisterReceiverFunction = (Ptr ()) -> ((Ptr ()) -> (Word64 -> ((FunPtr ((Ptr ()) -> (Word64 -> ((Ptr CChar) -> (Word32 -> (IO Word32))))) -> (IO ())))))
+ Fresco.System: type CallbackSystemRegisterReceiverFunction = Ptr () -> Ptr () -> Word64 -> FunPtr MsgEntityFn -> IO ()
- Fresco.System: type CallbackSystemStepFunction = (Ptr ()) -> (IO ())
+ Fresco.System: type CallbackSystemStepFunction = Ptr () -> IO ()
- Fresco.System: type EntityCreateFunction = (Ptr CChar) -> (Word32 -> ((Ptr (Ptr ())) -> (IO ())))
+ Fresco.System: type EntityCreateFunction = Ptr CChar -> Word32 -> Ptr (Ptr ()) -> IO ()
- Fresco.System: type EntityDestroyFunction = (Ptr ()) -> IO ()
+ Fresco.System: type EntityDestroyFunction = Ptr () -> IO ()
- Fresco.System: type ObjectLibSystemAddEntityFunction = (Ptr ()) -> ((Ptr ()) -> (IO ()))
+ Fresco.System: type ObjectLibSystemAddEntityFunction = Ptr () -> Ptr () -> IO ()
- Fresco.System: type ObjectLibSystemStepFunction = (Ptr ()) -> (IO ())
+ Fresco.System: type ObjectLibSystemStepFunction = Ptr () -> IO ()
Files
- Fresco.hs +26/−26
- Fresco/Component.hs +34/−70
- Fresco/Entity.hs +202/−202
- Fresco/System.hs +413/−419
- LICENSE +11/−11
- Setup.hs +13/−13
- fresco-binding.cabal +47/−44
Fresco.hs view
@@ -1,26 +1,26 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/Fresco.hs---- --- | Fresco Binding for Haskell-module Fresco--(- module Fresco.Component,- module Fresco.System,- module Fresco.Entity-)--where--import Fresco.Component-import Fresco.System-import Fresco.Entity-+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015-2016 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/Fresco.hs +-- + +-- | Fresco Binding for Haskell +module Fresco + +( + module Fresco.Component, + module Fresco.System, + module Fresco.Entity +) + +where + +import Fresco.Component +import Fresco.System +import Fresco.Entity +
Fresco/Component.hs view
@@ -1,70 +1,34 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/Fresco/Component.hs---- -{-# LANGUAGE TypeSynonymInstances #-}---- | Components of the Entity Component System of Fresco binding-module Fresco.Component-(- ComponentType (..),- Component,- ComponentClass (..)-)-where--import Data.Word-import Data.MessagePack-import Data.ByteString-import Data.Text-import Data.Text.Encoding---- | Components in Entities are indexed by ComponentType-data ComponentType a = ComponentType Word64 deriving (Eq, Show, Ord)---- | Components are stored as ByteString-type Component = ByteString---- | ComponentClass is the typeclass of data types, which can be components-class ComponentClass a where- toObj :: a -> Object- fromObj :: Object -> a--instance ComponentClass () where- toObj () = ObjectNil- fromObj ObjectNil = ()--instance ComponentClass Text where- toObj text = ObjectString (encodeUtf8 text)- fromObj (ObjectString bs) = decodeUtf8 bs --instance ComponentClass (ComponentType a) where- toObj (ComponentType i) = ObjectInt (fromIntegral i)- fromObj (ObjectInt i) = ComponentType (fromIntegral i)- -instance ComponentClass Bool where- toObj b = ObjectBool b- fromObj (ObjectBool b) = b- -instance ComponentClass Int where- toObj i = ObjectInt (fromIntegral i)- fromObj (ObjectInt i) = fromIntegral i- -instance ComponentClass ByteString where- toObj bs = ObjectString bs- fromObj (ObjectString bs) = bs--instance ComponentClass a => ComponentClass (Maybe a) where- toObj Nothing = ObjectArray [ObjectInt 0]- toObj (Just v) = ObjectArray [ObjectInt 1, toObj v]- fromObj (ObjectArray [ObjectInt 0]) = Nothing- fromObj (ObjectArray [ObjectInt 1, v_o]) = Just (fromObj v_o)--+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015 - 2017 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/Fresco/Component.hs +-- + +{-# LANGUAGE TypeSynonymInstances #-} + +-- | Components of the Entity Component System of Fresco binding +module Fresco.Component +( + ComponentType (..), + Component +) +where + +import Data.Word +import Data.ByteString.Lazy +import qualified Data.ByteString as BS +import Data.Text +import Data.Text.Encoding + +-- | Components in Entities are indexed by ComponentType +data ComponentType a = ComponentType Word64 deriving (Eq, Show, Ord) + +-- | Components are stored as ByteString +type Component = ByteString + +
Fresco/Entity.hs view
@@ -1,202 +1,202 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/Fresco/Entity.hs-----{-# Language ExistentialQuantification, FlexibleInstances #-}---- | Entity of the Entity ComponentType System for Fresco Haskell Binding-module Fresco.Entity (---- * EntityData Type--- Entities are a kind of simplified extensible record system. They are basically a Map from ComponentType (64 bit id) to a data item with --- ComponentClass Typeclass. Basic entities are non-mutable but their exists the entity reference.---- EntityData,- (#:),--- (#!),--- (#),---- * Entity Type--- The ERef type, which puts an EntityData into--- an IORef and serves as mutable data structure.--- In HGamer3D those ERefs are also used as thread-safe communication vehicle towards the C/C++ implementation of multimedia functionality.-- Entity (..),- newE,- delE,- idE,-- -- readE,- readC,- updateC,- setC,- -- _setC',-- ObjectLibSystem (..),- createOLS,- stepOLS,- addEntityOLS,-- CallbackSystem (..),- createCBS,- stepCBS,- registerReceiverCBS,--)-where--import Data.Maybe-import Data.ByteString-import qualified Data.Map as M-import Data.IORef--import Control.Concurrent-import Control.Applicative-import Foreign-import Foreign.C--import Data.MessagePack-import Data.Serialize--import Fresco.System-import Fresco.Component----- | EntityData, a simple non-mutable record type, implemented as Map-type EntityData = M.Map Word64 Component---- | pair builder for nice construction syntax, allows [ ct #: val, ...] syntax-(#:) :: ComponentClass a => ComponentType a -> a -> (Word64, Component)-(ComponentType c) #: val = (c, toMsg val)---- | Builder for entities, allows newE = entity [ct #: val, ...] syntax-entityData :: [(Word64, Component)] -> EntityData-entityData clist = M.fromList clist---- | does the entity have the ComponentType-(#?) :: EntityData -> ComponentType a -> Bool-e #? (ComponentType c) = Prelude.elem c $ M.keys e---- | get the ComponentType, throws exception, if ComponentType not present-(#!) :: ComponentClass a => EntityData -> ComponentType a -> a-e #! (ComponentType c) = fromJust $ M.lookup c e >>= fromMsg---- | get the ComponentType as an maybe, in case wrong type-(#) :: ComponentClass a => EntityData -> ComponentType a -> Maybe a-e # (ComponentType c) = M.lookup c e >>= fromMsg---- | modification function, throws exception, if ComponentType not present-updateDataC :: ComponentClass a => EntityData -> ComponentType a -> (a -> a) -> EntityData-updateDataC e c'@(ComponentType c) f = M.insert c ((toMsg . f) (e #! c')) e---- | modification function, sets entity ComponentType, needed for events-setDataC :: ComponentClass a => EntityData -> ComponentType a -> a -> EntityData-setDataC e (ComponentType c) val = M.insert c (toMsg val) e---data CallbackSystem = CallbackSystem (Ptr ())--createCBS :: IO CallbackSystem-createCBS = do- cbs <- callbackSystemCreate- return $ CallbackSystem cbs--stepCBS :: CallbackSystem -> IO ()-stepCBS (CallbackSystem cbs) = callbackSystemStep cbs---registerReceiverCBS :: ComponentClass a => CallbackSystem -> Entity -> ComponentType a -> (a -> IO ()) -> IO ()-registerReceiverCBS (CallbackSystem cbs) (Entity ep) (ComponentType ct) f = do- -- MsgFunction: Ptr () -> CULong -> Ptr CChar -> CInt -> IO CInt- let f' = \_ _ cdata len -> do- bs <- packCStringLen (cdata, fromIntegral len)- let c = fromJust(fromMsg bs)- f c- return 0- mf <- mkMsgFunPtr f'- callbackSystemRegisterReceiver cbs ep ct mf- return ()--data ObjectLibSystem = ObjectLibSystem (Ptr ())--createOLS :: IO ObjectLibSystem-createOLS = do - ols <- objectLibSystemCreate- return $ ObjectLibSystem ols--stepOLS :: ObjectLibSystem -> IO ()-stepOLS (ObjectLibSystem ols) = objectLibSystemStep ols--addEntityOLS :: ObjectLibSystem -> Entity -> IO ()-addEntityOLS (ObjectLibSystem ols) (Entity ep) = objectLibSystemAddEntity ols ep---- References to Entities---- besides Entity, we need atomic references to entities, we call them ERef--- ERefs also have listeners for updates---- Listener Map, for each k, manages a map of writers, writers geting the old and the new value after a change---- type Listeners = IORef (M.Map Word64 [EntityData -> EntityData -> IO ()])-type Listeners = ()---- | ERef, composable objects, referenced Entities with listeners-data Entity = Entity (Ptr ()) deriving (Eq)--msgFromE :: EntityData -> Component-msgFromE ed = let - pairs = (M.toList ed) -- [(Word64, Component)]- bs = Prelude.concatMap (\(a, b) -> [encode (ObjectUInt (fromIntegral a)), b]) pairs- in Data.ByteString.concat bs--msgFromC :: ComponentClass a => ComponentType a -> EntityData -> Component-msgFromC (ComponentType u) e = let- d = fromJust $ M.lookup u e- in Data.ByteString.concat [encode (ObjectUInt (fromIntegral u)), d]---- | creates an Entity-newE :: [(Word64, Component)] -> IO Entity-newE inlist = do- let e = entityData inlist- ep <- entityCreate (msgFromE e)- return $ Entity ep---- | destroys an Entity-delE :: Entity -> IO ()-delE (Entity ep) = entityDestroy ep---- | gets id of an Entity-idE :: Entity -> IO ByteString-idE (Entity ep) = entityId ep---- | reads one ComponentType, throws exception, if ComponentType not present, or wrong type-readC :: ComponentClass a => Entity -> ComponentType a -> IO a-readC (Entity ep) (ComponentType ct) = do- edat <- entityGetData ep ct- bs <- entityDataRead edat- entityDataRelease edat- return (fromJust (fromMsg bs))---- | updates one ComponentType-updateC :: ComponentClass a => Entity -> ComponentType a -> (a -> a) -> IO ()-updateC er@(Entity ep) c f = do- val <- readC er c- let val' = f val- setC er c val'- return ()---- | sets one ComponentType-setC :: ComponentClass a => Entity -> ComponentType a -> a -> IO ()-setC er@(Entity ep) (ComponentType ct) val = do- let d = Data.ByteString.concat [encode (ObjectUInt (fromIntegral ct)), toMsg val]- entitySet d ep- return ()--+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015 - 2017 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/Fresco/Entity.hs +-- + +{-# Language OverloadedStrings, ExistentialQuantification, FlexibleInstances #-} + +-- | Entity of the Entity ComponentType System for Fresco Haskell Binding +module Fresco.Entity ( + +-- * EntityData Type +-- Entities are a kind of simplified extensible record system. They are basically a Map from ComponentType (64 bit id) to a data item with +-- ComponentClass Typeclass. Basic entities are non-mutable but their exists the entity reference. + +-- EntityData, + (#:), +-- (#!), +-- (#), + +-- * Entity Type +-- The ERef type, which puts an EntityData into +-- an IORef and serves as mutable data structure. +-- In HGamer3D those ERefs are also used as thread-safe communication vehicle towards the C/C++ implementation of multimedia functionality. + + Entity (..), + newE, + delE, + idE, + + -- readE, + readC, + updateC, + setC, + -- _setC', + + ObjectLibSystem (..), + createOLS, + stepOLS, + addEntityOLS, + + CallbackSystem (..), + createCBS, + stepCBS, + registerReceiverCBS, + +) +where + +import Data.Maybe +import Data.ByteString.Lazy +import Data.ByteString (packCStringLen) +import qualified Data.Map as M +import Data.IORef + +import Control.Concurrent +import Control.Applicative +import Foreign +import Foreign.C + +import Data.Binary.Serialise.CBOR +import Data.Binary.Serialise.CBOR.Term + +import Fresco.System +import Fresco.Component + +import Numeric (showHex) + + +-- | EntityData, a simple non-mutable record type, implemented as Map +type EntityData = M.Map Word64 Component + +-- | pair builder for nice construction syntax, allows [ ct #: val, ...] syntax +(#:) :: Serialise a => ComponentType a -> a -> (Word64, Component) +(ComponentType c) #: val = (c, toMsg val) + +-- | Builder for entities, allows newE = entity [ct #: val, ...] syntax +entityData :: [(Word64, Component)] -> EntityData +entityData clist = M.fromList clist + +-- | does the entity have the ComponentType +(#?) :: EntityData -> ComponentType a -> Bool +e #? (ComponentType c) = Prelude.elem c $ M.keys e + +-- | get the ComponentType, throws exception, if ComponentType not present +(#!) :: Serialise a => EntityData -> ComponentType a -> a +e #! (ComponentType c) = fromJust $ M.lookup c e >>= fromMsg + +-- | get the ComponentType as an maybe, in case wrong type +(#) :: Serialise a => EntityData -> ComponentType a -> Maybe a +e # (ComponentType c) = case M.lookup c e of + Nothing -> Nothing + Just msg -> fromMsg msg + +-- | modification function, throws exception, if ComponentType not present +updateDataC :: Serialise a => EntityData -> ComponentType a -> (a -> a) -> EntityData +updateDataC e c'@(ComponentType c) f = M.insert c ((toMsg . f) (e #! c')) e + +-- | modification function, sets entity ComponentType, needed for events +setDataC :: Serialise a => EntityData -> ComponentType a -> a -> EntityData +setDataC e (ComponentType c) val = M.insert c (toMsg val) e + + +data CallbackSystem = CallbackSystem (Ptr ()) + +createCBS :: IO CallbackSystem +createCBS = do + cbs <- callbackSystemCreate + return $ CallbackSystem cbs + +stepCBS :: CallbackSystem -> IO () +stepCBS (CallbackSystem cbs) = callbackSystemStep cbs + + +registerReceiverCBS :: Serialise a => CallbackSystem -> Entity -> ComponentType a -> (a -> IO ()) -> IO () +registerReceiverCBS (CallbackSystem cbs) (Entity ep) (ComponentType ct) f = do + -- MsgFunction: Ptr () -> CULong -> Ptr CChar -> CInt -> IO CInt + let f' = \_ _ cdata len -> do + bs <- packCStringLen (cdata, fromIntegral len) + let c = fromMsg (fromStrict bs) + f c + return 0 + mf <- mkMsgEntityFnPtr f' + callbackSystemRegisterReceiver cbs ep ct mf + return () + +data ObjectLibSystem = ObjectLibSystem (Ptr ()) + +createOLS :: IO ObjectLibSystem +createOLS = do + ols <- objectLibSystemCreate "GIORNATA\0" + return $ ObjectLibSystem ols + +stepOLS :: ObjectLibSystem -> IO () +stepOLS (ObjectLibSystem ols) = objectLibSystemStep ols + +addEntityOLS :: ObjectLibSystem -> Entity -> IO () +addEntityOLS (ObjectLibSystem ols) (Entity ep) = objectLibSystemAddEntity ols ep + +-- References to Entities + +-- besides Entity, we need atomic references to entities, we call them ERef +-- ERefs also have listeners for updates + +-- Listener Map, for each k, manages a map of writers, writers geting the old and the new value after a change + +-- type Listeners = IORef (M.Map Word64 [EntityData -> EntityData -> IO ()]) +type Listeners = () + +-- | ERef, composable objects, referenced Entities with listeners +data Entity = Entity (Ptr ()) deriving (Eq) + +msgFromE :: [(Word64, Component)] -> Component +msgFromE ed = let + bs = Prelude.map (\(a, b) -> Data.ByteString.Lazy.concat [toMsg a, toMsg b]) ed + in Data.ByteString.Lazy.concat bs + +prettyPrint :: ByteString -> String +prettyPrint = Prelude.concat . Prelude.map (flip showHex " ") . unpack + +-- | creates an Entity +newE :: [(Word64, Component)] -> IO Entity +newE inlist = do + let msg = msgFromE inlist + ep <- entityCreate msg + return $ Entity ep + +-- | destroys an Entity +delE :: Entity -> IO () +delE (Entity ep) = entityDestroy ep + +-- | gets id of an Entity +idE :: Entity -> IO ByteString +idE (Entity ep) = entityId ep + +-- | reads one ComponentType, throws exception, if ComponentType not present, or wrong type +readC :: Serialise a => Entity -> ComponentType a -> IO a +readC (Entity ep) (ComponentType ct) = do + bs <- entityRead ep ct + return (fromMsg bs) + +-- | updates one ComponentType +updateC :: Serialise a => Entity -> ComponentType a -> (a -> a) -> IO () +updateC er@(Entity ep) c f = do + val <- readC er c + let val' = f val + setC er c val' + return () + +-- | sets one ComponentType +setC :: Serialise a => Entity -> ComponentType a -> a -> IO () +setC er@(Entity ep) (ComponentType ct) val = do +-- let d = Data.ByteString.Lazy.concat [serialise (TInteger (fromIntegral ct)), toMsg val] + entityWrite ep ct (toMsg val) + return () + +
Fresco/System.hs view
@@ -1,419 +1,413 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/Fresco/System.hs-----{-# LANGUAGE ForeignFunctionInterface, CPP #-}---- | Helper functions for binding ffi, encoding, decoding via messagepack-module Fresco.System--where--import Data.ByteString-import Data.ByteString.Unsafe-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---- helper functions--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)--- unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> print "msgfun" >> print dat'1 >> print dat'2 >> f p 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)------- Entity Interface--type EntityCreateFunction = ((Ptr CChar) -> (Word32 -> ((Ptr (Ptr ())) -> (IO ())))) -foreign import ccall "dynamic" - mkEntityCreateFunction :: FunPtr EntityCreateFunction -> EntityCreateFunction--type EntityDestroyFunction = ((Ptr ()) -> IO ()) -foreign import ccall "dynamic" - mkEntityDestroyFunction :: FunPtr EntityDestroyFunction -> EntityDestroyFunction--type EntityIdFunction = ((Ptr ()) -> IO (Ptr CChar))-foreign import ccall "dynamic"- mkEntityIdFunction :: FunPtr EntityIdFunction -> EntityIdFunction--type EntityIdFreeFunction = ((Ptr CChar) -> IO ())-foreign import ccall "dynamic"- mkEntityIdFreeFunction :: FunPtr EntityIdFreeFunction -> EntityIdFreeFunction---type EntitySetFunction = ((Ptr CChar) -> (Word32 -> ((Ptr ()) -> (IO ()))))-foreign import ccall "dynamic" - mkEntitySetFunction :: FunPtr EntitySetFunction -> EntitySetFunction---- pub extern "C" fn entity_get_data(ep: EntityPointer, ct: u64, pp: *mut *mut DataPointer) -type EntityGetDataFunction = ((Ptr ()) -> Word64 -> (Ptr (Ptr ())) -> IO ())-foreign import ccall "dynamic" - mkEntityGetDataFunction :: FunPtr EntityGetDataFunction -> EntityGetDataFunction---- pub extern "C" fn entity_data_read(dp: *mut DataPointer, p_cp: *mut *const libc::c_char, p_len: *mut libc::c_int)-type EntityDataReadFunction = ((Ptr ()) -> (Ptr (Ptr CChar)) -> (Ptr Word32) -> IO ())-foreign import ccall "dynamic" - mkEntityDataReadFunction :: FunPtr EntityDataReadFunction -> EntityDataReadFunction---- pub extern "C" fn entity_data_release(dp: *mut DataPointer)-type EntityDataReleaseFunction = ((Ptr ()) -> IO ())-foreign import ccall "dynamic" - mkEntityDataReleaseFunction :: FunPtr EntityDataReleaseFunction -> EntityDataReleaseFunction----- pub extern "C" fn callback_system_create(pp: *mut *mut CallbackSystem) {-type ObjectLibSystemCreateFunction = ((Ptr (Ptr ())) -> (IO ()))-foreign import ccall "dynamic" - mkObjectLibSystemCreateFunction :: FunPtr ObjectLibSystemCreateFunction -> ObjectLibSystemCreateFunction---- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {-type ObjectLibSystemAddEntityFunction = ((Ptr ()) -> ((Ptr ()) -> (IO ())))-foreign import ccall "dynamic" - mkObjectLibSystemAddEntityFunction:: FunPtr ObjectLibSystemAddEntityFunction -> ObjectLibSystemAddEntityFunction- --- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {-type ObjectLibSystemStepFunction = ((Ptr ()) -> (IO ()))-foreign import ccall "dynamic" - mkObjectLibSystemStepFunction:: FunPtr ObjectLibSystemStepFunction -> ObjectLibSystemStepFunction- ----- pub extern "C" fn callback_system_create(pp: *mut *mut CallbackSystem) {-type CallbackSystemCreateFunction = ((Ptr (Ptr ())) -> (IO ()))-foreign import ccall "dynamic" - mkCallbackSystemCreateFunction :: FunPtr CallbackSystemCreateFunction -> CallbackSystemCreateFunction---- pub extern "C" fn callback_system_register_receiver (cbs: *mut CallbackSystem, ep: EntityPointer, ct: u64, mfp: MessageFunctionPointer) {-type CallbackSystemRegisterReceiverFunction = ((Ptr ()) -> ((Ptr ()) -> (Word64 -> ((FunPtr ((Ptr ()) -> (Word64 -> ((Ptr CChar) -> (Word32 -> (IO Word32))))) -> (IO ()))))))-foreign import ccall "dynamic"- mkCallbackSystemRegisterReceiverFunction :: FunPtr CallbackSystemRegisterReceiverFunction -> CallbackSystemRegisterReceiverFunction---- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {-type CallbackSystemStepFunction = ((Ptr ()) -> (IO ()))-foreign import ccall "dynamic" - mkCallbackSystemStepFunction:: FunPtr CallbackSystemStepFunction -> CallbackSystemStepFunction- --data EntityInterface = EntityInterface {- eCreate :: EntityCreateFunction,- eDestroy :: EntityDestroyFunction,- eId :: EntityIdFunction,- eIdFree :: EntityIdFreeFunction,-- edSet :: EntitySetFunction,- edGet :: EntityGetDataFunction,- edRead :: EntityDataReadFunction,- edRelease :: EntityDataReleaseFunction,-- olsCreate :: ObjectLibSystemCreateFunction,- olsAddEntity :: ObjectLibSystemAddEntityFunction,- olsStep :: ObjectLibSystemStepFunction,-- cbsCreate :: CallbackSystemCreateFunction,- cbsRegisterReceiver :: CallbackSystemRegisterReceiverFunction,- cbsStep :: CallbackSystemStepFunction- }--#ifdef UseWinDLLLoading-dynamicEI :: IORef EntityInterface-{-# NOINLINE dynamicEI #-}-dynamicEI = unsafePerformIO (do- libname <- getEnv "INTONACO"- dll <- loadLibrary libname-- ec <- getProcAddress dll "entity_create"- let ec' = mkEntityCreateFunction $ castPtrToFunPtr ec-- ed <- getProcAddress dll "entity_destroy"- let ed' = mkEntityDestroyFunction $ castPtrToFunPtr ed-- ei <- getProcAddress dll "entity_id"- let ei' = mkEntityIdFunction $ castPtrToFunPtr ei-- eif <- getProcAddress dll "entity_id_free"- let eif' = mkEntityIdFreeFunction $ castPtrToFunPtr eif--- eds <- getProcAddress dll "entity_set" - let eds' = mkEntitySetFunction $ castPtrToFunPtr eds-- edg <- getProcAddress dll "entity_get_data"- let edg' = mkEntityGetDataFunction $ castPtrToFunPtr edg-- edr <- getProcAddress dll "entity_data_read"- let edr' = mkEntityDataReadFunction $ castPtrToFunPtr edr-- edrl <- getProcAddress dll "entity_data_release"- let edrl' = mkEntityDataReleaseFunction $ castPtrToFunPtr edrl--- olc <- getProcAddress dll "object_lib_system_create" - let olc' = mkObjectLibSystemCreateFunction $ castPtrToFunPtr olc-- ola <- getProcAddress dll "object_lib_system_add_entity" - let ola' = mkObjectLibSystemAddEntityFunction $ castPtrToFunPtr ola-- ols <- getProcAddress dll "object_lib_system_step" - let ols' = mkObjectLibSystemStepFunction $ castPtrToFunPtr ols--- 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--- ref <- newIORef $ EntityInterface ec' ed' ei' eif' eds' edg' edr' edrl' olc' ola' ols' cbc' cbr' cbs' - return ref- )-- --#else-dynamicEI :: IORef EntityInterface-{-# NOINLINE dynamicEI #-}-dynamicEI = unsafePerformIO ( - do- libname <- getEnv "INTONACO"- dll <- dlopen libname [RTLD_NOW]-- ec <- dlsym dll "entity_create"- let ec' = mkEntityCreateFunction ec-- ed <- dlsym dll "entity_destroy"- let ed' = mkEntityDestroyFunction ed-- ei <- dlsym dll "entity_id"- let ei' = mkEntityIdFunction ei-- eif <- dlsym dll "entity_id_free"- let eif' = mkEntityIdFreeFunction eif--- eds <- dlsym dll "entity_set" - let eds' = mkEntitySetFunction eds-- edg <- dlsym dll "entity_get_data"- let edg' = mkEntityGetDataFunction edg-- edr <- dlsym dll "entity_data_read"- let edr' = mkEntityDataReadFunction edr-- edrl <- dlsym dll "entity_data_release"- let edrl' = mkEntityDataReleaseFunction edrl--- olc <- dlsym dll "object_lib_system_create" - let olc' = mkObjectLibSystemCreateFunction olc-- ola <- dlsym dll "object_lib_system_add_entity" - let ola' = mkObjectLibSystemAddEntityFunction ola-- ols <- dlsym dll "object_lib_system_step" - let ols' = mkObjectLibSystemStepFunction ols--- 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--- ref <- newIORef $ EntityInterface ec' ed' ei' eif' eds' edg' edr' edrl' olc' ola' ols' cbc' cbr' cbs' - 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- (eCreate dei) a1'1 a1'2 a2') >>- peek a2' >>= \a2'' -> - return (a2'')--entityDestroy :: Ptr () -> IO ()-entityDestroy a1 =- (do- dei <- readIORef dynamicEI- (eDestroy dei) a1) >>- return ()--entityId :: Ptr () -> IO ByteString-entityId ep = do- dei <- readIORef dynamicEI- p <- ((eId dei) ep)- bs <- packCStringLen (p, 16)- (eIdFree dei) p- return bs----entitySet :: (ByteString) -> (Ptr ()) -> IO ()-entitySet a1 a2 =- unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) -> - let {a2' = id a2} in - (do- dei <- readIORef dynamicEI- (edSet 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 ()----objectLibSystemCreate :: IO ((Ptr ()))-objectLibSystemCreate =- alloca $ \a1' -> - (do- dei <- readIORef dynamicEI- (olsCreate dei) a1') >>- peek a1'>>= \a1'' -> - return (a1'')--objectLibSystemAddEntity :: (Ptr ()) -> (Ptr ()) -> IO ()-objectLibSystemAddEntity a1 a2 =- let {a1' = id a1; a2' = id a2} in - (do- dei <- readIORef dynamicEI- (olsAddEntity dei) a1' a2') >>- return ()--objectLibSystemStep :: (Ptr ()) -> IO ()-objectLibSystemStep a1 =- let {a1' = id a1} in - (do- dei <- readIORef dynamicEI- (olsStep dei) a1') >>- return ()-----callbackSystemCreate :: IO ((Ptr ()))-callbackSystemCreate =- alloca $ \a1' -> - (do- dei <- readIORef dynamicEI- (cbsCreate 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- (cbsRegisterReceiver dei) a1' a2' a3' a4') >>- return ()--callbackSystemStep :: (Ptr ()) -> IO ()-callbackSystemStep a1 =- let {a1' = id a1} in - (do- dei <- readIORef dynamicEI- (cbsStep dei) a1') >>- return ()--+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015 - 2017 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/Fresco/System.hs +-- + +{-# LANGUAGE ForeignFunctionInterface, CPP #-} + +-- | Helper functions for binding ffi, encoding, decoding via messagepack +module Fresco.System + +where + +import Data.ByteString.Lazy +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.ByteString (packCStringLen) + +import Data.Binary.Serialise.CBOR + +import Data.Either +import Data.Maybe + +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 :: Serialise o => o -> ByteString +toMsg o = serialise o + +fromMsg :: Serialise o => ByteString -> o +fromMsg bs = deserialise bs + +-- helper functions + +-- different callback functions and dynamic wrapper generation + +type MsgFn = Ptr () -> Ptr CChar -> Word32 -> IO () + +foreign import ccall "dynamic" + mkMsgFn :: FunPtr MsgFn -> MsgFn +foreign import ccall "wrapper" + mkMsgFnPtr :: MsgFn -> IO (FunPtr MsgFn) + +type MsgEntityFn = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Int32 + +foreign import ccall "dynamic" + mkMsgEntityFn :: FunPtr MsgEntityFn -> MsgEntityFn +foreign import ccall "wrapper" + mkMsgEntityFnPtr :: MsgEntityFn -> IO (FunPtr MsgEntityFn) + +callMsgEntityFn :: FunPtr MsgEntityFn -> Ptr () -> Word64 -> ByteString -> IO Int +callMsgEntityFn mf p ct msg = do + let f = mkMsgEntityFn mf + let dat = msg + unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> f p ct dat'1 dat'2 >>= \res -> return (fromIntegral res) +-- unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> print "msgfun" >> print dat'1 >> print dat'2 >> f p 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) + + +-- Entity Interface + +type EntityCreateFunction = Ptr CChar -> Word32 -> Ptr (Ptr ()) -> IO () +foreign import ccall "dynamic" + mkEntityCreateFunction :: FunPtr EntityCreateFunction -> EntityCreateFunction + +type EntityDestroyFunction = Ptr () -> IO () +foreign import ccall "dynamic" + mkEntityDestroyFunction :: FunPtr EntityDestroyFunction -> EntityDestroyFunction + +type EntityReadComponentFunction = Ptr () -> Word64 -> Ptr () -> FunPtr MsgFn -> IO () +foreign import ccall "dynamic" + mkEntityReadComponentFunction :: FunPtr EntityReadComponentFunction -> EntityReadComponentFunction + +type EntityWriteComponentFunction = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO () +foreign import ccall "dynamic" + mkEntityWriteComponentFunction :: FunPtr EntityWriteComponentFunction -> EntityWriteComponentFunction + +type EntityReadIdFunction = Ptr () -> Ptr () -> FunPtr MsgFn -> IO () +foreign import ccall "dynamic" + mkEntityReadIdFunction :: FunPtr EntityReadIdFunction -> EntityReadIdFunction + +-- Object Lib System Interface + +type ObjectLibSystemInitFunction = Ptr CChar -> Ptr (Ptr ()) -> IO () +foreign import ccall "dynamic" + mkObjectLibSystemInitFunction :: FunPtr ObjectLibSystemInitFunction -> ObjectLibSystemInitFunction + +type ObjectLibSystemAddEntityFunction = Ptr () -> Ptr () -> IO () +foreign import ccall "dynamic" + mkObjectLibSystemAddEntityFunction:: FunPtr ObjectLibSystemAddEntityFunction -> ObjectLibSystemAddEntityFunction + +type ObjectLibSystemRemoveEntityFunction = Ptr () -> Ptr () -> IO () +foreign import ccall "dynamic" + mkObjectLibSystemRemoveEntityFunction:: FunPtr ObjectLibSystemRemoveEntityFunction -> ObjectLibSystemRemoveEntityFunction + +type ObjectLibSystemShutdownFunction = Ptr () -> IO () +foreign import ccall "dynamic" + mkObjectLibSystemShutdownFunction:: FunPtr ObjectLibSystemShutdownFunction -> ObjectLibSystemShutdownFunction + +type ObjectLibSystemStepFunction = Ptr () -> IO () +foreign import ccall "dynamic" + mkObjectLibSystemStepFunction:: FunPtr ObjectLibSystemStepFunction -> ObjectLibSystemStepFunction + +-- Callback System Interface + +type CallbackSystemInitFunction = Ptr (Ptr ()) -> IO () +foreign import ccall "dynamic" + mkCallbackSystemInitFunction :: FunPtr CallbackSystemInitFunction -> CallbackSystemInitFunction + +type CallbackSystemRegisterReceiverFunction = Ptr () -> Ptr () -> Word64 -> FunPtr MsgEntityFn -> IO () +foreign import ccall "dynamic" + mkCallbackSystemRegisterReceiverFunction :: FunPtr CallbackSystemRegisterReceiverFunction -> CallbackSystemRegisterReceiverFunction + +type CallbackSystemShutdownFunction = Ptr () -> IO () +foreign import ccall "dynamic" + mkCallbackSystemShutdownFunction:: FunPtr CallbackSystemShutdownFunction -> CallbackSystemShutdownFunction + +type CallbackSystemStepFunction = Ptr () -> IO () +foreign import ccall "dynamic" + mkCallbackSystemStepFunction:: FunPtr CallbackSystemStepFunction -> CallbackSystemStepFunction + + +data EntityInterface = EntityInterface { + eCreate :: EntityCreateFunction, + eRead :: EntityReadComponentFunction, + eWrite :: EntityWriteComponentFunction, + eId :: EntityReadIdFunction, + eDestroy :: EntityDestroyFunction, + + olsInit :: ObjectLibSystemInitFunction, + olsAddEntity :: ObjectLibSystemAddEntityFunction, + olsRemoveEntity :: ObjectLibSystemRemoveEntityFunction, + olsShutdown :: ObjectLibSystemShutdownFunction, + olsStep :: ObjectLibSystemStepFunction, + + cbsInit :: CallbackSystemInitFunction, + cbsRegisterReceiver :: CallbackSystemRegisterReceiverFunction, + cbsShutdown :: CallbackSystemShutdownFunction, + cbsStep :: CallbackSystemStepFunction + } + + +#ifdef UseWinDLLLoading +dynamicEI :: IORef EntityInterface +{-# NOINLINE dynamicEI #-} +dynamicEI = unsafePerformIO (do + libname <- getEnv "INTONACO" + dll <- loadLibrary libname + + + ec <- getProcAddress dll "inEntityCreate" + let ec' = mkEntityCreateFunction $ castPtrToFunPtr ec + + er <- getProcAddress dll "inEntityReadComponent" + let er' = mkEntityReadComponentFunction $ castPtrToFunPtr er + + ew <- getProcAddress dll "inEntityWriteComponent" + let ew' = mkEntityWriteComponentFunction $ castPtrToFunPtr ew + + ei <- getProcAddress dll "inEntityId" + let ei' = mkEntityReadIdFunction $ castPtrToFunPtr ei + + ed <- getProcAddress dll "inEntityDestroy" + let ed' = mkEntityDestroyFunction $ castPtrToFunPtr ed + + + oli <- getProcAddress dll "inObjectLibSystemInit" + let oli' = mkObjectLibSystemInitFunction $ castPtrToFunPtr oli + + ola <- getProcAddress dll "inObjectLibSystemAddEntity" + let ola' = mkObjectLibSystemAddEntityFunction $ castPtrToFunPtr ola + + olr <- getProcAddress dll "inObjectLibSystemRemoveEntity" + let olr' = mkObjectLibSystemRemoveEntityFunction $ castPtrToFunPtr olr + + olu <- getProcAddress dll "inObjectLibSystemShutdown" + let olu' = mkObjectLibSystemShutdownFunction $ castPtrToFunPtr olu + + ols <- getProcAddress dll "inObjectLibSystemStep" + let ols' = mkObjectLibSystemStepFunction $ castPtrToFunPtr ols + + + cbi <- getProcAddress dll "inCallbackSystemInit" + let cbi' = mkCallbackSystemInitFunction $ castPtrToFunPtr cbi + + cbr <- getProcAddress dll "inCallbackSystemRegisterReceiver" + let cbr' = mkCallbackSystemRegisterReceiverFunction $ castPtrToFunPtr cbr + + cbu <- getProcAddress dll "inCallbackSystemShutdown" + let cbu' = mkCallbackSystemShutdownFunction $ castPtrToFunPtr cbu + + cbs <- getProcAddress dll "inCallbackSystemStep" + let cbs' = mkCallbackSystemStepFunction $ castPtrToFunPtr cbs + + ref <- newIORef $ EntityInterface ec' er' ew' ei' ed' oli' ola' olr' olu' ols' cbi' cbr' cbu' cbs' + return ref + ) + + + +#else +dynamicEI :: IORef EntityInterface +{-# NOINLINE dynamicEI #-} +dynamicEI = unsafePerformIO ( + do + libname <- getEnv "INTONACO" + dll <- dlopen libname [RTLD_NOW] + + ec <- dlsym dll "inEntityCreate" + let ec' = mkEntityCreateFunction ec + + er <- dlsym dll "inEntityReadComponent" + let er' = mkEntityReadComponentFunction er + + ew <- dlsym dll "inEntityWriteComponent" + let ew' = mkEntityWriteComponentFunction ew + + ei <- dlsym dll "inEntityId" + let ei' = mkEntityReadIdFunction ei + + ed <- dlsym dll "inEntityDestroy" + let ed' = mkEntityDestroyFunction ed + + + oli <- dlsym dll "inObjectLibSystemInit" + let oli' = mkObjectLibSystemInitFunction oli + + ola <- dlsym dll "inObjectLibSystemAddEntity" + let ola' = mkObjectLibSystemAddEntityFunction ola + + olr <- dlsym dll "inObjectLibSystemRemoveEntity" + let olr' = mkObjectLibSystemRemoveEntityFunction olr + + olu <- dlsym dll "inObjectLibSystemShutdown" + let olu' = mkObjectLibSystemShutdownFunction olu + + ols <- dlsym dll "inObjectLibSystemStep" + let ols' = mkObjectLibSystemStepFunction ols + + + cbi <- dlsym dll "inCallbackSystemInit" + let cbi' = mkCallbackSystemInitFunction cbi + + cbr <- dlsym dll "inCallbackSystemRegisterReceiver" + let cbr' = mkCallbackSystemRegisterReceiverFunction cbr + + cbu <- dlsym dll "inCallbackSystemShutdown" + let cbu' = mkCallbackSystemShutdownFunction cbu + + cbs <- dlsym dll "inCallbackSystemStep" + let cbs' = mkCallbackSystemStepFunction cbs + + ref <- newIORef $ EntityInterface ec' er' ew' ei' ed' oli' ola' olr' olu' ols' cbi' cbr' cbu' cbs' + return ref + ) +#endif + +type CStringCLen i = (CString, i) + +unsafeUseAsCStringLen' :: (Integral i) => ByteString -> (CStringCLen i -> IO a) -> IO a +unsafeUseAsCStringLen' str fn = + unsafeUseAsCStringLen (toStrict 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 + (eCreate dei) a1'1 a1'2 a2') >> + peek a2' >>= \a2'' -> + return (a2'') + +entityDestroy :: Ptr () -> IO () +entityDestroy a1 = + (do + dei <- readIORef dynamicEI + (eDestroy dei) a1) >> + return () + + +entityId :: Ptr () -> IO ByteString +entityId ep = do + dei <- readIORef dynamicEI + pbs <- newIORef undefined + fp <- (mkMsgFnPtr (\_ p len -> do + bs <- packCStringLen (p, fromIntegral len) + writeIORef pbs bs + return () + )) + (eId dei) ep nullPtr fp + bs <- readIORef pbs + return (fromStrict bs) + +entityWrite :: (Ptr ()) -> Word64 -> ByteString -> IO () +entityWrite a1 a2 a3 = + unsafeUseAsCStringLen' a3 $ \(a3'1, a3'2) -> + (do + dei <- readIORef dynamicEI + (eWrite dei) a1 a2 a3'1 a3'2) >> + return () + +entityRead :: Ptr () -> Word64 -> IO ByteString +entityRead ep ct = do + dei <- readIORef dynamicEI + pbs <- newIORef undefined + fp <- (mkMsgFnPtr (\_ p len -> do + bs <- packCStringLen (p, fromIntegral len) + writeIORef pbs bs + return () + )) + (eRead dei) ep ct (nullPtr) fp + bs <- readIORef pbs + return (fromStrict bs) + +objectLibSystemCreate :: ByteString -> IO (Ptr ()) +objectLibSystemCreate a1 = + unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) -> + alloca $ \a2' -> + (do + dei <- readIORef dynamicEI + (olsInit dei) a1'1 a2') >> + peek a2'>>= \a2'' -> + return (a2'') + +objectLibSystemAddEntity :: (Ptr ()) -> (Ptr ()) -> IO () +objectLibSystemAddEntity a1 a2 = + let {a1' = id a1; a2' = id a2} in + (do + dei <- readIORef dynamicEI + (olsAddEntity dei) a1' a2') >> + return () + +objectLibSystemStep :: (Ptr ()) -> IO () +objectLibSystemStep a1 = + let {a1' = id a1} in + (do + dei <- readIORef dynamicEI + (olsStep dei) a1') >> + return () + +objectLibSystemShutdown :: (Ptr ()) -> IO () +objectLibSystemShutdown a1 = + let {a1' = id a1} in + (do + dei <- readIORef dynamicEI + (olsShutdown dei) a1') >> + return () + + +callbackSystemCreate :: IO ((Ptr ())) +callbackSystemCreate = + alloca $ \a1' -> + (do + dei <- readIORef dynamicEI + (cbsInit dei) a1') >> + peek a1'>>= \a1'' -> + return (a1'') + +callbackSystemRegisterReceiver :: (Ptr ()) -> (Ptr ()) -> (Word64) -> (FunPtr (Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Int32)) -> 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 + (cbsRegisterReceiver dei) a1' a2' a3' a4') >> + return () + +callbackSystemStep :: (Ptr ()) -> IO () +callbackSystemStep a1 = + let {a1' = id a1} in + (do + dei <- readIORef dynamicEI + (cbsStep dei) a1') >> + return () + +callbackSystemShutdown :: (Ptr ()) -> IO () +callbackSystemShutdown a1 = + let {a1' = id a1} in + (do + dei <- readIORef dynamicEI + (cbsShutdown dei) a1') >> + return () + +
LICENSE view
@@ -1,12 +1,12 @@-LICENSE----------(c) 2015-2016 Peter Althainz--Fresco Haskell is licensed under the Apache License, Version 2.0 (the "License"); you may not use this software except in compliance with the License. You may obtain a copy of the License at--http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.-+LICENSE +------- + +(c) 2015 - 2017 Peter Althainz + +Fresco Haskell is licensed under the Apache License, Version 2.0 (the "License"); you may not use this software except in compliance with the License. You may obtain a copy of the License at + +http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. + You can obtain the latest version of the source code under http://www.github.com/urs-of-the-backwoods/fresco-haskell.
Setup.hs view
@@ -1,13 +1,13 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/Setup.hs-----import Distribution.Simple-main = defaultMain+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015-2016 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/Setup.hs +-- + +import Distribution.Simple +main = defaultMain
fresco-binding.cabal view
@@ -1,44 +1,47 @@------ Fresco Framework for Multi-Language Programming--- Copyright 2015-2016 Peter Althainz--- --- Distributed under the Apache License, Version 2.0--- (See attached file LICENSE or copy at --- http:--www.apache.org/licenses/LICENSE-2.0)--- --- file: haskell/fresco-binding.cabal-----Name: fresco-binding-Version: 0.2.0-Synopsis: Fresco binding for Haskell-Description: - Fresco is a framwork for multi-language programming. This is the Haskell binding.-License: OtherLicense-License-file: LICENSE-Author: Peter Althainz-Maintainer: althainz@gmail.com-Build-Type: Simple-Cabal-Version: >=1.4-Category: Development, FFI, Interfaces-Extra-source-files: Setup.hs - -Library- Build-Depends: base >= 3 && < 5, containers, bytestring, text, messagepack >=0.5 && <0.6, cereal >=0.5 && < 0.6-- Exposed-modules: Fresco.Component, Fresco.System, Fresco.Entity, Fresco-- Other-modules: -- c-sources: - - ghc-options: - cc-options: -Wno-attributes - hs-source-dirs: .- Include-dirs: .- - if os(win32)- cpp-options: -DUseWinDLLLoading- build-depends: Win32- else- build-depends: unix+-- +-- Fresco Framework for Multi-Language Programming +-- Copyright 2015 - 2017 Peter Althainz +-- +-- Distributed under the Apache License, Version 2.0 +-- (See attached file LICENSE or copy at +-- http:--www.apache.org/licenses/LICENSE-2.0) +-- +-- file: haskell/fresco-binding.cabal +-- + +Name: fresco-binding +Version: 0.3.0 +Synopsis: Fresco binding for Haskell +Description: + Fresco is a framwork for multi-language programming. This is the Haskell binding. +License: OtherLicense +License-file: LICENSE +Author: Peter Althainz +Maintainer: althainz@gmail.com +Build-Type: Simple +Cabal-Version: >=1.4 +Category: Development, FFI, Interfaces +Extra-source-files: Setup.hs + +Library + Build-Depends: base >= 3 && < 5, containers, bytestring, binary, text, binary-serialise-cbor + + Exposed-modules: Fresco.Component, Fresco.System, Fresco.Entity, Fresco + + Other-modules: + + c-sources: + + ghc-options: + cc-options: -Wno-attributes + hs-source-dirs: . + Include-dirs: . + + if os(win32) + cpp-options: -DUseWinDLLLoading + build-depends: Win32 + else + build-depends: unix + + +