diff --git a/IrrHaskell.cabal b/IrrHaskell.cabal new file mode 100644 --- /dev/null +++ b/IrrHaskell.cabal @@ -0,0 +1,30 @@ +name: IrrHaskell +version: 0.1 +cabal-version: >= 1.6 +build-type: Simple +license: LGPL +license-file: LICENSE +author: Maciej Baranski +maintainer: let at = "@" in concat ["m.baranski", at, "sms.ed.ac.uk"] +stability: prototype +homepage: +category: Graphics, FFI, Game Engine +tested-with: GHC == 6.10.1 +synopsis: Haskell binding to the Irrlicht game engine. +description: + Haskell binding to the Irrlicht game engine. + +library + build-depends: + base >= 4.0.0.0 && < 5 + exposed-modules: + exposed: True + other-modules: + + extensions: ForeignFunctionInterface + + + c-sources: irrlicht_interface.cpp + + + diff --git a/IrrHaskell.cabal~ b/IrrHaskell.cabal~ new file mode 100644 --- /dev/null +++ b/IrrHaskell.cabal~ @@ -0,0 +1,30 @@ +name: IrrHaskell +version: 0.1 +cabal-version: >= 1.6 +build-type: Simple +license: LGPL +license-file: LICENSE +author: Maciej Baranski +maintainer: let at = "@" in concat ["m.baranski", at, "sms.ed.ac.uk"] +stability: prototype +homepage: +category: Graphics, FFI, Game Engine +tested-with: GHC == 6.10.1 +synopsis: Haskell binding to the Irrlicht game engine. +description: + Haskell binding to the Irrlicht game engine. + +library + build-depends: + base >= 4.0.0.0 && < 5 + exposed-modules: + exposed: True + other-modules: + + extensions: ForeignFunctionInterface + + + c-sources: + + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ + diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,57 @@ +MainProgramm = sample +FalApplication = Fal + +IrrlichtHome = /home/maciek/Desktop/irrlicht-1.6 +HaskellHome = /usr/lib/ghc-6.8.2 + +USERCPPFLAGS = +USERCXXFLAGS = -O3 -ffast-math -Wno-deprecated -Wno-write-strings +USERLDFLAGS = + +CPPFLAGS = -I$(IrrlichtHome)/include -I$(HaskellHome)/include -I/usr/X11R6/include $(USERCPPFLAGS) +CXXFLAGS = $(USERCXXFLAGS) + +LDFLAGS = $(USERLDFLAGS) +LDFLAGS += -L$(IrrlichtHome)/lib/Linux -lIrrlicht +LDFLAGS += -lopengl32 -lm +LDFLAGS += -lgdi32 -lwinspool -lcomdlg32 -lole32 -loleaut32 -luuid -lodbc32 -lodbccp32 -lopengl32 + +SYSTEM=Linux + +HASKLIB = -L$(HaskellHome) -lHSrts -L$(HaskellHome)/base-4.1.0.0 -lHSbase-4.1.0.0 + +TARGET = main + +main: $(MainProgramm) aux_files + +$(MainProgramm): $(MainProgramm).hs irrlicht.hs irrlicht_interface_ffi.o irrlicht_interface.o + rm -f $(MainProgramm).o Irrlicht.o + ghc --make $(MainProgramm).hs -L$(IrrlichtHome)/lib/Linux -package greencard irrlicht.hs -lIrrlicht irrlicht_interface_ffi.o irrlicht_interface.o -lstdc++ -lXxf86vm -lXext -lglut -lGL -lX11 + +irlicht.hs irrlicht_interface_ffi.c irrlicht_interface_ffi.h: irrlicht_interface.hs irrlicht_interface.h + greencard irrlicht_interface.hs -o irrlicht.hs -c irrlicht_interface_ffi.c + +irrlicht_interface_ffi.o: irrlicht_interface_ffi.c irrlicht_interface_ffi.h + $(CXX) -c -xc $(CPPFLAGS) $(CXXFLAGS) $< + +irrlicht_interface.o: irrlicht_interface.cpp irrlicht_interface.h + $(CXX) -c $(CPPFLAGS) $(CXXFLAGS) $< + +aux_files: Irrlicht.a + +Irrlicht.a: + cp $(IrrlichtHome)/lib/Linux/libIrrlicht.a libIrrlicht.a + +.cpp.o: + $(CXX) -c $(CPPFLAGS) $(CXXFLAGS) $< + +.c.o: + $(CXX) -c -xc $(CPPFLAGS) $(CXXFLAGS) $< + +clean: + rm -f *.o *.hi + rm -f irrlicht_interface_ffi.* + rm -f irrlicht.hs + + +.PHONY: main aux_files clean diff --git a/Memo1.lhs b/Memo1.lhs new file mode 100644 --- /dev/null +++ b/Memo1.lhs @@ -0,0 +1,61 @@ +This code was automatically extracted from a .lhs file that +uses the following convention: + +-- lines beginning with ">" are executable +-- lines beginning with "<" are in the text, + but not necessarily executable +-- lines beginning with "|" are also in the text, + but are often just expressions or code fragments. + +> {-# OPTIONS_GHC -fglasgow-exts #-} + +> module Memo1 (memo1) where + +> import Data.IORef +> import System.IO.Unsafe + +For GHC users, comment the Hugs part and uncomment the following + +> import GHC.Prim +> unsafePtrEq x y = case reallyUnsafePtrEquality# x y of +> 1# -> True +> _ -> False + +For Hugs users, comment the GHC part, and uncomment the following + +> -- import Hugs.IOExts (unsafePtrEq) + +> memo1 :: (a->b) -> (a->b) +> memo1 f = unsafePerformIO $ do +> cache <- newIORef [] +> return $ \x -> unsafePerformIO $ do +> vals <- readIORef cache +> case x `inCache` vals of +> Nothing -> do let y = f x +> writeIORef cache [(x,y)] -- ((x,y) : +> -- if null vals then [] else [head vals]) +> return y +> Just y -> do return y + +> inCache :: a -> [(a,b)] -> Maybe b +> x `inCache` [] = Nothing +> x `inCache` ((x',y'):xys) = +> if unsafePtrEq x x' then Just y' else x `inCache` xys + +> fib1 n = fibstr !! n +> where fibstr = 0 : 1 : zipWith (+) fibstr (tail fibstr) + +> fib2 n = fibstr nil !! n +> where fibstr = +> \x -> 0 : 1 : zipWith (+) (fibstr x) (tail (fibstr x)) + +> fib3 n = fibstr nil !! n +> where fibstr = memo1 $ +> \x -> 0 : 1 : zipWith (+) (fibstr x) (tail (fibstr x)) + +> nil = [] :: [Int] + +> ones = 1 : ones +> twos = 2 : twos +> oats = (ones,twos) +> taos = (twos,ones) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +-- Simple setup +import Distribution.Simple +main = defaultMain diff --git a/irrlicht.hs b/irrlicht.hs new file mode 100644 --- /dev/null +++ b/irrlicht.hs @@ -0,0 +1,883 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Irrlicht where + +import Foreign.GreenCard + +data MeshPtr = MeshPtr Int +data NodePtr = NodePtr Int +data TexturePtr = TexturePtr Int + + + + + + +data VideoDriverType + = EDT_NULL + | EDT_SOFTWARE + | EDT_BURNINGSVIDEO + | EDT_DIRECT3D8 + | EDT_DIRECT3D9 + | EDT_OPENGL + deriving () +marshall_VideoDriverType :: VideoDriverType -> Int +marshall_VideoDriverType arg1 = + case arg1 of { + EDT_NULL -> eDT_NULL; + EDT_SOFTWARE -> eDT_SOFTWARE; + EDT_BURNINGSVIDEO -> eDT_BURNINGSVIDEO; + EDT_DIRECT3D8 -> eDT_DIRECT3D8; + EDT_DIRECT3D9 -> eDT_DIRECT3D9; + EDT_OPENGL -> eDT_OPENGL + } +unmarshall_VideoDriverType :: Int -> VideoDriverType +unmarshall_VideoDriverType arg1 = + if arg1 == eDT_NULL + then EDT_NULL + else if arg1 == eDT_SOFTWARE + then EDT_SOFTWARE + else if arg1 == eDT_BURNINGSVIDEO + then EDT_BURNINGSVIDEO + else if arg1 == eDT_DIRECT3D8 + then EDT_DIRECT3D8 + else if arg1 == eDT_DIRECT3D9 + then EDT_DIRECT3D9 + else if arg1 == eDT_OPENGL + then EDT_OPENGL + else error ("unmarshall_VideoDriverType: unknown value ("++show arg1++")\n") +eDT_NULL :: Int +eDT_NULL = + unsafePerformIO( + prim_eDT_NULL + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_NULL" prim_eDT_NULL :: IO (Int) +eDT_SOFTWARE :: Int +eDT_SOFTWARE = + unsafePerformIO( + prim_eDT_SOFTWARE + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_SOFTWARE" prim_eDT_SOFTWARE :: IO (Int) +eDT_BURNINGSVIDEO :: Int +eDT_BURNINGSVIDEO = + unsafePerformIO( + prim_eDT_BURNINGSVIDEO + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_BURNINGSVIDEO" prim_eDT_BURNINGSVIDEO :: IO (Int) +eDT_DIRECT3D8 :: Int +eDT_DIRECT3D8 = + unsafePerformIO( + prim_eDT_DIRECT3D8 + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_DIRECT3D8" prim_eDT_DIRECT3D8 :: IO (Int) +eDT_DIRECT3D9 :: Int +eDT_DIRECT3D9 = + unsafePerformIO( + prim_eDT_DIRECT3D9 + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_DIRECT3D9" prim_eDT_DIRECT3D9 :: IO (Int) +eDT_OPENGL :: Int +eDT_OPENGL = + unsafePerformIO( + prim_eDT_OPENGL + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eDT_OPENGL" prim_eDT_OPENGL :: IO (Int) + +data VideoMaterialFlag + = EMF_WIREFRAME + | EMF_POINTCLOUD + | EMF_GOURARD_SHADING + | EMF_LIGHTING + | EMF_ZBUFFER + | EMF_ZWRITE_ENABLE + | EMF_BACK_FACE_CULLING + | EMF_FRONT_FACE_CULLING + | EMF_BILINEAR_FILTER + | EMF_TRILINEAR_FILTER + | EMF_ANISOTROPIC_FILTER + | EMF_FOG_ENABLE + | EMF_NORMALIZE_NORMALS + | EMF_TEXTURE_WRAP + | EMF_ANTI_ALIASING + | EMF_COLOR_MASK + | EMF_COLOR_MATERIAL + deriving () +marshall_VideoMaterialFlag :: VideoMaterialFlag -> Int +marshall_VideoMaterialFlag arg1 = + case arg1 of { + EMF_WIREFRAME -> eMF_WIREFRAME; + EMF_POINTCLOUD -> eMF_POINTCLOUD; + EMF_GOURARD_SHADING -> eMF_GOURARD_SHADING; + EMF_LIGHTING -> eMF_LIGHTING; + EMF_ZBUFFER -> eMF_ZBUFFER; + EMF_ZWRITE_ENABLE -> eMF_ZWRITE_ENABLE; + EMF_BACK_FACE_CULLING -> eMF_BACK_FACE_CULLING; + EMF_FRONT_FACE_CULLING -> eMF_FRONT_FACE_CULLING; + EMF_BILINEAR_FILTER -> eMF_BILINEAR_FILTER; + EMF_TRILINEAR_FILTER -> eMF_TRILINEAR_FILTER; + EMF_ANISOTROPIC_FILTER -> eMF_ANISOTROPIC_FILTER; + EMF_FOG_ENABLE -> eMF_FOG_ENABLE; + EMF_NORMALIZE_NORMALS -> eMF_NORMALIZE_NORMALS; + EMF_TEXTURE_WRAP -> eMF_TEXTURE_WRAP; + EMF_ANTI_ALIASING -> eMF_ANTI_ALIASING; + EMF_COLOR_MASK -> eMF_COLOR_MASK; + EMF_COLOR_MATERIAL -> eMF_COLOR_MATERIAL + } +unmarshall_VideoMaterialFlag :: Int -> VideoMaterialFlag +unmarshall_VideoMaterialFlag arg1 = + if arg1 == eMF_WIREFRAME + then EMF_WIREFRAME + else if arg1 == eMF_POINTCLOUD + then EMF_POINTCLOUD + else if arg1 == eMF_GOURARD_SHADING + then EMF_GOURARD_SHADING + else if arg1 == eMF_LIGHTING + then EMF_LIGHTING + else if arg1 == eMF_ZBUFFER + then EMF_ZBUFFER + else if arg1 == eMF_ZWRITE_ENABLE + then EMF_ZWRITE_ENABLE + else if arg1 == eMF_BACK_FACE_CULLING + then EMF_BACK_FACE_CULLING + else if arg1 == eMF_FRONT_FACE_CULLING + then EMF_FRONT_FACE_CULLING + else if arg1 == eMF_BILINEAR_FILTER + then EMF_BILINEAR_FILTER + else if arg1 == eMF_TRILINEAR_FILTER + then EMF_TRILINEAR_FILTER + else if arg1 == eMF_ANISOTROPIC_FILTER + then EMF_ANISOTROPIC_FILTER + else if arg1 == eMF_FOG_ENABLE + then EMF_FOG_ENABLE + else if arg1 == eMF_NORMALIZE_NORMALS + then EMF_NORMALIZE_NORMALS + else if arg1 == eMF_TEXTURE_WRAP + then EMF_TEXTURE_WRAP + else if arg1 == eMF_ANTI_ALIASING + then EMF_ANTI_ALIASING + else if arg1 == eMF_COLOR_MASK + then EMF_COLOR_MASK + else if arg1 == eMF_COLOR_MATERIAL + then EMF_COLOR_MATERIAL + else error ("unmarshall_VideoMaterialFlag: unknown value ("++show arg1++")\n") +eMF_WIREFRAME :: Int +eMF_WIREFRAME = + unsafePerformIO( + prim_eMF_WIREFRAME + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_WIREFRAME" prim_eMF_WIREFRAME :: IO (Int) +eMF_POINTCLOUD :: Int +eMF_POINTCLOUD = + unsafePerformIO( + prim_eMF_POINTCLOUD + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_POINTCLOUD" prim_eMF_POINTCLOUD :: IO (Int) +eMF_GOURARD_SHADING :: Int +eMF_GOURARD_SHADING = + unsafePerformIO( + prim_eMF_GOURARD_SHADING + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_GOURARD_SHADING" prim_eMF_GOURARD_SHADING :: IO (Int) +eMF_LIGHTING :: Int +eMF_LIGHTING = + unsafePerformIO( + prim_eMF_LIGHTING + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_LIGHTING" prim_eMF_LIGHTING :: IO (Int) +eMF_ZBUFFER :: Int +eMF_ZBUFFER = + unsafePerformIO( + prim_eMF_ZBUFFER + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_ZBUFFER" prim_eMF_ZBUFFER :: IO (Int) +eMF_ZWRITE_ENABLE :: Int +eMF_ZWRITE_ENABLE = + unsafePerformIO( + prim_eMF_ZWRITE_ENABLE + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_ZWRITE_ENABLE" prim_eMF_ZWRITE_ENABLE :: IO (Int) +eMF_BACK_FACE_CULLING :: Int +eMF_BACK_FACE_CULLING = + unsafePerformIO( + prim_eMF_BACK_FACE_CULLING + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_BACK_FACE_CULLING" prim_eMF_BACK_FACE_CULLING :: IO (Int) +eMF_FRONT_FACE_CULLING :: Int +eMF_FRONT_FACE_CULLING = + unsafePerformIO( + prim_eMF_FRONT_FACE_CULLING + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_FRONT_FACE_CULLING" prim_eMF_FRONT_FACE_CULLING :: IO (Int) +eMF_BILINEAR_FILTER :: Int +eMF_BILINEAR_FILTER = + unsafePerformIO( + prim_eMF_BILINEAR_FILTER + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_BILINEAR_FILTER" prim_eMF_BILINEAR_FILTER :: IO (Int) +eMF_TRILINEAR_FILTER :: Int +eMF_TRILINEAR_FILTER = + unsafePerformIO( + prim_eMF_TRILINEAR_FILTER + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_TRILINEAR_FILTER" prim_eMF_TRILINEAR_FILTER :: IO (Int) +eMF_ANISOTROPIC_FILTER :: Int +eMF_ANISOTROPIC_FILTER = + unsafePerformIO( + prim_eMF_ANISOTROPIC_FILTER + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_ANISOTROPIC_FILTER" prim_eMF_ANISOTROPIC_FILTER :: IO (Int) +eMF_FOG_ENABLE :: Int +eMF_FOG_ENABLE = + unsafePerformIO( + prim_eMF_FOG_ENABLE + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_FOG_ENABLE" prim_eMF_FOG_ENABLE :: IO (Int) +eMF_NORMALIZE_NORMALS :: Int +eMF_NORMALIZE_NORMALS = + unsafePerformIO( + prim_eMF_NORMALIZE_NORMALS + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_NORMALIZE_NORMALS" prim_eMF_NORMALIZE_NORMALS :: IO (Int) +eMF_TEXTURE_WRAP :: Int +eMF_TEXTURE_WRAP = + unsafePerformIO( + prim_eMF_TEXTURE_WRAP + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_TEXTURE_WRAP" prim_eMF_TEXTURE_WRAP :: IO (Int) +eMF_ANTI_ALIASING :: Int +eMF_ANTI_ALIASING = + unsafePerformIO( + prim_eMF_ANTI_ALIASING + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_ANTI_ALIASING" prim_eMF_ANTI_ALIASING :: IO (Int) +eMF_COLOR_MASK :: Int +eMF_COLOR_MASK = + unsafePerformIO( + prim_eMF_COLOR_MASK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_COLOR_MASK" prim_eMF_COLOR_MASK :: IO (Int) +eMF_COLOR_MATERIAL :: Int +eMF_COLOR_MATERIAL = + unsafePerformIO( + prim_eMF_COLOR_MATERIAL + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMF_COLOR_MATERIAL" prim_eMF_COLOR_MATERIAL :: IO (Int) + +data SceneMd2AnimationType + = EMAT_STAND + | EMAT_RUN + | EMAT_ATTACK + | EMAT_PAIN_A + | EMAT_PAIN_B + | EMAT_PAIN_C + | EMAT_JUMP + | EMAT_FLIP + | EMAT_SALUTE + | EMAT_FALLBACK + | EMAT_WAVE + | EMAT_POINT + | EMAT_CROUCH_STAND + | EMAT_CROUCH_WALK + | EMAT_CROUCH_ATTACK + | EMAT_CROUCH_PAIN + | EMAT_CROUCH_DEATH + | EMAT_DEATH_FALLBACK + | EMAT_DEATH_FALLFORWARD + | EMAT_DEATH_FALLBACKSLOW + | EMAT_BOOM + | EMAT_COUNT + deriving () +marshall_SceneMd2AnimationType :: SceneMd2AnimationType -> Int +marshall_SceneMd2AnimationType arg1 = + case arg1 of { + EMAT_STAND -> eMAT_STAND; + EMAT_RUN -> eMAT_RUN; + EMAT_ATTACK -> eMAT_ATTACK; + EMAT_PAIN_A -> eMAT_PAIN_A; + EMAT_PAIN_B -> eMAT_PAIN_B; + EMAT_PAIN_C -> eMAT_PAIN_C; + EMAT_JUMP -> eMAT_JUMP; + EMAT_FLIP -> eMAT_FLIP; + EMAT_SALUTE -> eMAT_SALUTE; + EMAT_FALLBACK -> eMAT_FALLBACK; + EMAT_WAVE -> eMAT_WAVE; + EMAT_POINT -> eMAT_POINT; + EMAT_CROUCH_STAND -> eMAT_CROUCH_STAND; + EMAT_CROUCH_WALK -> eMAT_CROUCH_WALK; + EMAT_CROUCH_ATTACK -> eMAT_CROUCH_ATTACK; + EMAT_CROUCH_PAIN -> eMAT_CROUCH_PAIN; + EMAT_CROUCH_DEATH -> eMAT_CROUCH_DEATH; + EMAT_DEATH_FALLBACK -> eMAT_DEATH_FALLBACK; + EMAT_DEATH_FALLFORWARD -> eMAT_DEATH_FALLFORWARD; + EMAT_DEATH_FALLBACKSLOW -> eMAT_DEATH_FALLBACKSLOW; + EMAT_BOOM -> eMAT_BOOM; + EMAT_COUNT -> eMAT_COUNT + } +unmarshall_SceneMd2AnimationType :: Int -> SceneMd2AnimationType +unmarshall_SceneMd2AnimationType arg1 = + if arg1 == eMAT_STAND + then EMAT_STAND + else if arg1 == eMAT_RUN + then EMAT_RUN + else if arg1 == eMAT_ATTACK + then EMAT_ATTACK + else if arg1 == eMAT_PAIN_A + then EMAT_PAIN_A + else if arg1 == eMAT_PAIN_B + then EMAT_PAIN_B + else if arg1 == eMAT_PAIN_C + then EMAT_PAIN_C + else if arg1 == eMAT_JUMP + then EMAT_JUMP + else if arg1 == eMAT_FLIP + then EMAT_FLIP + else if arg1 == eMAT_SALUTE + then EMAT_SALUTE + else if arg1 == eMAT_FALLBACK + then EMAT_FALLBACK + else if arg1 == eMAT_WAVE + then EMAT_WAVE + else if arg1 == eMAT_POINT + then EMAT_POINT + else if arg1 == eMAT_CROUCH_STAND + then EMAT_CROUCH_STAND + else if arg1 == eMAT_CROUCH_WALK + then EMAT_CROUCH_WALK + else if arg1 == eMAT_CROUCH_ATTACK + then EMAT_CROUCH_ATTACK + else if arg1 == eMAT_CROUCH_PAIN + then EMAT_CROUCH_PAIN + else if arg1 == eMAT_CROUCH_DEATH + then EMAT_CROUCH_DEATH + else if arg1 == eMAT_DEATH_FALLBACK + then EMAT_DEATH_FALLBACK + else if arg1 == eMAT_DEATH_FALLFORWARD + then EMAT_DEATH_FALLFORWARD + else if arg1 == eMAT_DEATH_FALLBACKSLOW + then EMAT_DEATH_FALLBACKSLOW + else if arg1 == eMAT_BOOM + then EMAT_BOOM + else if arg1 == eMAT_COUNT + then EMAT_COUNT + else error ("unmarshall_SceneMd2AnimationType: unknown value ("++show arg1++")\n") +eMAT_STAND :: Int +eMAT_STAND = + unsafePerformIO( + prim_eMAT_STAND + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_STAND" prim_eMAT_STAND :: IO (Int) +eMAT_RUN :: Int +eMAT_RUN = + unsafePerformIO( + prim_eMAT_RUN + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_RUN" prim_eMAT_RUN :: IO (Int) +eMAT_ATTACK :: Int +eMAT_ATTACK = + unsafePerformIO( + prim_eMAT_ATTACK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_ATTACK" prim_eMAT_ATTACK :: IO (Int) +eMAT_PAIN_A :: Int +eMAT_PAIN_A = + unsafePerformIO( + prim_eMAT_PAIN_A + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_PAIN_A" prim_eMAT_PAIN_A :: IO (Int) +eMAT_PAIN_B :: Int +eMAT_PAIN_B = + unsafePerformIO( + prim_eMAT_PAIN_B + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_PAIN_B" prim_eMAT_PAIN_B :: IO (Int) +eMAT_PAIN_C :: Int +eMAT_PAIN_C = + unsafePerformIO( + prim_eMAT_PAIN_C + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_PAIN_C" prim_eMAT_PAIN_C :: IO (Int) +eMAT_JUMP :: Int +eMAT_JUMP = + unsafePerformIO( + prim_eMAT_JUMP + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_JUMP" prim_eMAT_JUMP :: IO (Int) +eMAT_FLIP :: Int +eMAT_FLIP = + unsafePerformIO( + prim_eMAT_FLIP + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_FLIP" prim_eMAT_FLIP :: IO (Int) +eMAT_SALUTE :: Int +eMAT_SALUTE = + unsafePerformIO( + prim_eMAT_SALUTE + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_SALUTE" prim_eMAT_SALUTE :: IO (Int) +eMAT_FALLBACK :: Int +eMAT_FALLBACK = + unsafePerformIO( + prim_eMAT_FALLBACK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_FALLBACK" prim_eMAT_FALLBACK :: IO (Int) +eMAT_WAVE :: Int +eMAT_WAVE = + unsafePerformIO( + prim_eMAT_WAVE + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_WAVE" prim_eMAT_WAVE :: IO (Int) +eMAT_POINT :: Int +eMAT_POINT = + unsafePerformIO( + prim_eMAT_POINT + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_POINT" prim_eMAT_POINT :: IO (Int) +eMAT_CROUCH_STAND :: Int +eMAT_CROUCH_STAND = + unsafePerformIO( + prim_eMAT_CROUCH_STAND + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_CROUCH_STAND" prim_eMAT_CROUCH_STAND :: IO (Int) +eMAT_CROUCH_WALK :: Int +eMAT_CROUCH_WALK = + unsafePerformIO( + prim_eMAT_CROUCH_WALK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_CROUCH_WALK" prim_eMAT_CROUCH_WALK :: IO (Int) +eMAT_CROUCH_ATTACK :: Int +eMAT_CROUCH_ATTACK = + unsafePerformIO( + prim_eMAT_CROUCH_ATTACK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_CROUCH_ATTACK" prim_eMAT_CROUCH_ATTACK :: IO (Int) +eMAT_CROUCH_PAIN :: Int +eMAT_CROUCH_PAIN = + unsafePerformIO( + prim_eMAT_CROUCH_PAIN + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_CROUCH_PAIN" prim_eMAT_CROUCH_PAIN :: IO (Int) +eMAT_CROUCH_DEATH :: Int +eMAT_CROUCH_DEATH = + unsafePerformIO( + prim_eMAT_CROUCH_DEATH + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_CROUCH_DEATH" prim_eMAT_CROUCH_DEATH :: IO (Int) +eMAT_DEATH_FALLBACK :: Int +eMAT_DEATH_FALLBACK = + unsafePerformIO( + prim_eMAT_DEATH_FALLBACK + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_DEATH_FALLBACK" prim_eMAT_DEATH_FALLBACK :: IO (Int) +eMAT_DEATH_FALLFORWARD :: Int +eMAT_DEATH_FALLFORWARD = + unsafePerformIO( + prim_eMAT_DEATH_FALLFORWARD + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_DEATH_FALLFORWARD" prim_eMAT_DEATH_FALLFORWARD :: IO (Int) +eMAT_DEATH_FALLBACKSLOW :: Int +eMAT_DEATH_FALLBACKSLOW = + unsafePerformIO( + prim_eMAT_DEATH_FALLBACKSLOW + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_DEATH_FALLBACKSLOW" prim_eMAT_DEATH_FALLBACKSLOW :: IO (Int) +eMAT_BOOM :: Int +eMAT_BOOM = + unsafePerformIO( + prim_eMAT_BOOM + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_BOOM" prim_eMAT_BOOM :: IO (Int) +eMAT_COUNT :: Int +eMAT_COUNT = + unsafePerformIO( + prim_eMAT_COUNT + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_eMAT_COUNT" prim_eMAT_COUNT :: IO (Int) + +{- Device -} + +getEvent :: IO Int +getEvent = + prim_getEvent + >>= \ result -> + (return (result)) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_getEvent" prim_getEvent :: IO (Int) + +getCharEvent :: IO Char +getCharEvent = + prim_getCharEvent + >>= \ result -> + (return (result)) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_getCharEvent" prim_getCharEvent :: IO (Char) + +deviceSetEventReceiver :: Int -> IO () +deviceSetEventReceiver control = + prim_deviceSetEventReceiver control + >>= \ gc_result -> + access_prim_deviceSetEventReceiver_gc_failed gc_result >>= \ gc_failed -> + access_prim_deviceSetEventReceiver_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_deviceSetEventReceiver" prim_deviceSetEventReceiver :: Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceSetEventReceiver_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceSetEventReceiver_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +deviceSetWindowCaption :: String -> IO () +deviceSetWindowCaption gc_arg1 = + (marshall_string_ gc_arg1) >>= \ (caption) -> + prim_deviceSetWindowCaption caption + >>= \ gc_result -> + access_prim_deviceSetWindowCaption_gc_failed gc_result >>= \ gc_failed -> + access_prim_deviceSetWindowCaption_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_deviceSetWindowCaption" prim_deviceSetWindowCaption :: Ptr a1 -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceSetWindowCaption_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceSetWindowCaption_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +deviceRun :: IO Int +deviceRun = + prim_deviceRun + >>= \ gc_result -> + access_prim_deviceRun_result gc_result >>= \ result -> + access_prim_deviceRun_gc_failed gc_result >>= \ gc_failed -> + access_prim_deviceRun_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (result)) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_deviceRun" prim_deviceRun :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceRun_result :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceRun_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceRun_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +deviceDrop :: IO () +deviceDrop = + prim_deviceDrop + >>= \ gc_result -> + access_prim_deviceDrop_gc_failed gc_result >>= \ gc_failed -> + access_prim_deviceDrop_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_deviceDrop" prim_deviceDrop :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceDrop_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_deviceDrop_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +irrCreateDevice :: VideoDriverType -> Int -> Int -> Bool -> Bool -> Bool -> IO () +irrCreateDevice gc_arg1 sizex sizey gc_arg2 gc_arg3 gc_arg4 = + case (marshall_VideoDriverType gc_arg1) of { dtype -> + (marshall_bool_ gc_arg2) >>= \ (fullscreen) -> + (marshall_bool_ gc_arg3) >>= \ (stencilbuffer) -> + (marshall_bool_ gc_arg4) >>= \ (vsync) -> + prim_irrCreateDevice dtype sizex sizey fullscreen stencilbuffer vsync + >>= \ gc_result -> + access_prim_irrCreateDevice_gc_failed gc_result >>= \ gc_failed -> + access_prim_irrCreateDevice_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_irrCreateDevice" prim_irrCreateDevice :: Int -> Int -> Int -> Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_irrCreateDevice_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_irrCreateDevice_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +{- Gui -} + +guiAddStaticText :: String -> Int -> Int -> Int -> Int -> IO () +guiAddStaticText gc_arg1 topleftx toplefty lowrightx lowrighty = + (marshall_string_ gc_arg1) >>= \ (text) -> + prim_guiAddStaticText text topleftx toplefty lowrightx lowrighty + >>= \ gc_result -> + access_prim_guiAddStaticText_gc_failed gc_result >>= \ gc_failed -> + access_prim_guiAddStaticText_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_guiAddStaticText" prim_guiAddStaticText :: Ptr a1 -> Int -> Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_guiAddStaticText_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_guiAddStaticText_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +guiDrawAll :: IO () +guiDrawAll = + prim_guiDrawAll + >>= \ gc_result -> + access_prim_guiDrawAll_gc_failed gc_result >>= \ gc_failed -> + access_prim_guiDrawAll_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_guiDrawAll" prim_guiDrawAll :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_guiDrawAll_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_guiDrawAll_gc_failstring :: Ptr a1 -> IO (Ptr r1) + + +{- VideoDriver -} + +videoBeginScene :: Bool -> Bool -> Int -> Int -> Int -> Int -> IO () +videoBeginScene gc_arg1 gc_arg2 colr colg colb colt = + (marshall_bool_ gc_arg1) >>= \ (a) -> + (marshall_bool_ gc_arg2) >>= \ (b) -> + prim_videoBeginScene a b colr colg colb colt + >>= \ gc_result -> + access_prim_videoBeginScene_gc_failed gc_result >>= \ gc_failed -> + access_prim_videoBeginScene_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_videoBeginScene" prim_videoBeginScene :: Int -> Int -> Int -> Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoBeginScene_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoBeginScene_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +videoEndScene :: IO () +videoEndScene = + prim_videoEndScene + >>= \ gc_result -> + access_prim_videoEndScene_gc_failed gc_result >>= \ gc_failed -> + access_prim_videoEndScene_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_videoEndScene" prim_videoEndScene :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoEndScene_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoEndScene_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +videoGetTexture :: String -> IO TexturePtr +videoGetTexture gc_arg1 = + (marshall_string_ gc_arg1) >>= \ (texture) -> + prim_videoGetTexture texture + >>= \ gc_result -> + access_prim_videoGetTexture_pTexture gc_result >>= \ pTexture -> + access_prim_videoGetTexture_gc_failed gc_result >>= \ gc_failed -> + access_prim_videoGetTexture_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return ((TexturePtr pTexture))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_videoGetTexture" prim_videoGetTexture :: Ptr a1 -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoGetTexture_pTexture :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoGetTexture_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_videoGetTexture_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +{- Scene -} + +sceneDrawAll :: IO () +sceneDrawAll = + prim_sceneDrawAll + >>= \ gc_result -> + access_prim_sceneDrawAll_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneDrawAll_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneDrawAll" prim_sceneDrawAll :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneDrawAll_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneDrawAll_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneGetMesh :: String -> IO MeshPtr +sceneGetMesh gc_arg1 = + (marshall_string_ gc_arg1) >>= \ (mesh) -> + prim_sceneGetMesh mesh + >>= \ gc_result -> + access_prim_sceneGetMesh_pMesh gc_result >>= \ pMesh -> + access_prim_sceneGetMesh_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneGetMesh_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return ((MeshPtr pMesh))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneGetMesh" prim_sceneGetMesh :: Ptr a1 -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneGetMesh_pMesh :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneGetMesh_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneGetMesh_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneAddAnimatedMeshSceneNode :: MeshPtr -> IO NodePtr +sceneAddAnimatedMeshSceneNode gc_arg1 = + case gc_arg1 of { (MeshPtr pMesh) -> + prim_sceneAddAnimatedMeshSceneNode pMesh + >>= \ gc_result -> + access_prim_sceneAddAnimatedMeshSceneNode_pNode gc_result >>= \ pNode -> + access_prim_sceneAddAnimatedMeshSceneNode_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneAddAnimatedMeshSceneNode_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return ((NodePtr pNode)))} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneAddAnimatedMeshSceneNode" prim_sceneAddAnimatedMeshSceneNode :: Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddAnimatedMeshSceneNode_pNode :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddAnimatedMeshSceneNode_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddAnimatedMeshSceneNode_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneAddCameraSceneNode :: (Int,Int,Int) -> (Int,Int,Int) -> IO () +sceneAddCameraSceneNode gc_arg1 gc_arg2 = + case gc_arg1 of { (posx,posy,posz) -> + case gc_arg2 of { (tox,toy,toz) -> + prim_sceneAddCameraSceneNode posx posy posz tox toy toz + >>= \ gc_result -> + access_prim_sceneAddCameraSceneNode_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneAddCameraSceneNode_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))}} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneAddCameraSceneNode" prim_sceneAddCameraSceneNode :: Int -> Int -> Int -> Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddCameraSceneNode_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddCameraSceneNode_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneAddOctTreeSceneNode :: MeshPtr -> IO NodePtr +sceneAddOctTreeSceneNode gc_arg1 = + case gc_arg1 of { (MeshPtr pMesh) -> + prim_sceneAddOctTreeSceneNode pMesh + >>= \ gc_result -> + access_prim_sceneAddOctTreeSceneNode_pNode gc_result >>= \ pNode -> + access_prim_sceneAddOctTreeSceneNode_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneAddOctTreeSceneNode_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return ((NodePtr pNode)))} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneAddOctTreeSceneNode" prim_sceneAddOctTreeSceneNode :: Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddOctTreeSceneNode_pNode :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddOctTreeSceneNode_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddOctTreeSceneNode_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneNodeSetPosition :: (Int,Int,Int) -> NodePtr -> IO () +sceneNodeSetPosition gc_arg1 gc_arg2 = + case gc_arg1 of { (posx,posy,posz) -> + case gc_arg2 of { (NodePtr pNode) -> + prim_sceneNodeSetPosition posx posy posz pNode + >>= \ gc_result -> + access_prim_sceneNodeSetPosition_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneNodeSetPosition_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))}} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneNodeSetPosition" prim_sceneNodeSetPosition :: Int -> Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneNodeSetPosition_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneNodeSetPosition_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +sceneAddCameraSceneNodeFPS :: IO () +sceneAddCameraSceneNodeFPS = + prim_sceneAddCameraSceneNodeFPS + >>= \ gc_result -> + access_prim_sceneAddCameraSceneNodeFPS_gc_failed gc_result >>= \ gc_failed -> + access_prim_sceneAddCameraSceneNodeFPS_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_sceneAddCameraSceneNodeFPS" prim_sceneAddCameraSceneNodeFPS :: IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddCameraSceneNodeFPS_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_sceneAddCameraSceneNodeFPS_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +{- Node -} + +nodeSetMaterialTexture :: NodePtr -> TexturePtr -> IO () +nodeSetMaterialTexture gc_arg1 gc_arg2 = + case gc_arg1 of { (NodePtr pNode) -> + case gc_arg2 of { (TexturePtr pTexture) -> + prim_nodeSetMaterialTexture pNode pTexture + >>= \ gc_result -> + access_prim_nodeSetMaterialTexture_gc_failed gc_result >>= \ gc_failed -> + access_prim_nodeSetMaterialTexture_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))}} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_nodeSetMaterialTexture" prim_nodeSetMaterialTexture :: Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMaterialTexture_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMaterialTexture_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +nodeSetMaterialFlag :: NodePtr -> VideoMaterialFlag -> Bool -> IO () +nodeSetMaterialFlag gc_arg1 gc_arg2 gc_arg3 = + case gc_arg1 of { (NodePtr pNode) -> + case (marshall_VideoMaterialFlag gc_arg2) of { mflag -> + (marshall_bool_ gc_arg3) >>= \ (value) -> + prim_nodeSetMaterialFlag pNode mflag value + >>= \ gc_result -> + access_prim_nodeSetMaterialFlag_gc_failed gc_result >>= \ gc_failed -> + access_prim_nodeSetMaterialFlag_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))}} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_nodeSetMaterialFlag" prim_nodeSetMaterialFlag :: Int -> Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMaterialFlag_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMaterialFlag_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +nodeSetMd2Animation :: NodePtr -> SceneMd2AnimationType -> IO () +nodeSetMd2Animation gc_arg1 gc_arg2 = + case gc_arg1 of { (NodePtr pNode) -> + case (marshall_SceneMd2AnimationType gc_arg2) of { atype -> + prim_nodeSetMd2Animation pNode atype + >>= \ gc_result -> + access_prim_nodeSetMd2Animation_gc_failed gc_result >>= \ gc_failed -> + access_prim_nodeSetMd2Animation_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (()))}} +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_nodeSetMd2Animation" prim_nodeSetMd2Animation :: Int -> Int -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMd2Animation_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_nodeSetMd2Animation_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +{- Files -} +fileSystemAddZipFileArchive :: String -> IO () +fileSystemAddZipFileArchive gc_arg1 = + (marshall_string_ gc_arg1) >>= \ (file) -> + prim_fileSystemAddZipFileArchive file + >>= \ gc_result -> + access_prim_fileSystemAddZipFileArchive_gc_failed gc_result >>= \ gc_failed -> + access_prim_fileSystemAddZipFileArchive_gc_failstring gc_result >>= \ gc_failstring -> + if ( gc_failed /= (0::Int)) + then unmarshall_string_ gc_failstring >>= ioError . userError + else (return (())) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_fileSystemAddZipFileArchive" prim_fileSystemAddZipFileArchive :: Ptr a1 -> IO (Ptr r1) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_fileSystemAddZipFileArchive_gc_failed :: Ptr a1 -> IO (Int) +foreign import ccall unsafe "irrlicht_stub_ffi.h" access_prim_fileSystemAddZipFileArchive_gc_failstring :: Ptr a1 -> IO (Ptr r1) + +{- Timer -} +getVirtualTime :: Int +getVirtualTime = + unsafePerformIO( + prim_getVirtualTime + >>= \ res1 -> + (return (res1))) +foreign import ccall unsafe "irrlicht_stub_ffi.h prim_getVirtualTime" prim_getVirtualTime :: IO (Int) + + diff --git a/irrlicht_interface.cpp b/irrlicht_interface.cpp new file mode 100644 --- /dev/null +++ b/irrlicht_interface.cpp @@ -0,0 +1,609 @@ +#include "irrlicht.h" + +#include +#include + +using namespace std; +using namespace irr; +using namespace core; +using namespace scene; +using namespace video; +using namespace io; +using namespace gui; +using namespace std; + +#include "irrlicht_interface.h" + +class HelperEvent { + + public: + + int helper_event; + char char_event; + + HelperEvent() { + helper_event = -1; + char_event = ' '; + } + + void setHelperEvent(int event_value) { + helper_event = event_value; + } + + void setCharEvent(char event_char) { + char_event = event_char; + } + + int getHelperEvent() { + return helper_event; + } + + char getCharEvent() { + return char_event; + } + +}; + +/* key listener class */ + +class MyEventReceiver : public IEventReceiver +{ +public: + + MyEventReceiver(HelperEvent *irrlicht_helper_event) : Irrlicht_helper_event(irrlicht_helper_event) + { + } + + bool OnEvent(const SEvent& event) + { + if (event.EventType == irr::EET_KEY_INPUT_EVENT && !event.KeyInput.PressedDown) + { + + switch (event.KeyInput.Key) + { + case irr::KEY_KEY_A: + //cout << event.KeyInput.Key << endl; + Irrlicht_helper_event->setHelperEvent(1); + Irrlicht_helper_event->setCharEvent('a'); + return true; + + case irr::KEY_KEY_B: + + Irrlicht_helper_event->setHelperEvent(2); + Irrlicht_helper_event->setCharEvent('b'); + return true; + + case irr::KEY_KEY_C: + Irrlicht_helper_event->setHelperEvent(3); + Irrlicht_helper_event->setCharEvent('c'); + return true; + + case irr::KEY_KEY_D: + Irrlicht_helper_event->setHelperEvent(4); + Irrlicht_helper_event->setCharEvent('d'); + return true; + + default: + break; + } + } + + return false; + } + +private: + HelperEvent* Irrlicht_helper_event; +}; + + +/* helper classes */ +class HelperSceneNode +{ + irr::scene::ISceneNode *sceneNode; + irr::scene::IAnimatedMeshSceneNode *animatedMeshSceneNode; + + public: + HelperSceneNode(IAnimatedMeshSceneNode* amsn) + { + animatedMeshSceneNode = amsn; + sceneNode = amsn; + } + + irr::scene::ISceneNode* getSceneNode() + { + return sceneNode; + } + + irr::scene::IAnimatedMeshSceneNode* getAnimatedMeshSceneNode() + { + return animatedMeshSceneNode; + } +}; + +class HelperMesh +{ + irr::scene::IMesh *mesh; + irr::scene::IAnimatedMesh *animatedMesh; + + public: + HelperMesh(IAnimatedMesh* am) + { + animatedMesh = am; + mesh = am; + } + + irr::scene::IMesh* getMesh() + { + return mesh; + } + irr::scene::IAnimatedMesh* getAnimatedMesh() + { + return animatedMesh; + } +}; + + +static IrrlichtDevice* irrDevice = 0; +static IVideoDriver* irrVideoDriver = 0; +static ISceneManager* irrSceneManager = 0; +static IGUIEnvironment* irrGuiEnvironment = 0; + +static HelperEvent* helperEvent = new HelperEvent(); + +static MyEventReceiver receiver(helperEvent); + + +static wchar_t wcstring[2000]; +wchar_t * toWchar(char* text) +{ + // Convert to a wchar_t* + size_t convertedChars = 0; + int len = strlen(text)+1; + + if (len > 500) + { + return NULL; + } + else + { + mbstowcs(wcstring, text, strlen(text)+1); + return wcstring; + } +}; + + +static char lastError[512]; + +void setError(char* error) +{ + strcpy(lastError, "Irrlicht Wrapper Library, "); + strcpy(lastError, error); +}; + +char* getError() +{ + return lastError; +}; + + +// Device Functions + +extern "C" int DeviceSetEventReceiver(int control) { + + if (irrDevice == 0) { + setError("DeviceSetEventReceiver error"); + return -1; + } else { + irrDevice->setEventReceiver(&receiver); + return 0; + } + +} + +extern "C" int GetEvent() { + + int event = helperEvent->getHelperEvent(); + helperEvent->setHelperEvent(0); + + return event; + +} + +extern "C" char GetCharEvent() { + + char event = helperEvent->getCharEvent(); + helperEvent->setCharEvent(' '); + return event; + +} + +extern "C" int DeviceSetWindowCaption(char* caption) +{ + if (irrDevice == 0) + { + setError("DeviceSetWindowCaption: library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + wchar_t *wCaption = toWchar(caption); + if (wCaption == NULL) + { + setError("DeviceSetWindowCaption: input text larger then 500 chars"); + return -1; + } + else + { + irrDevice->setWindowCaption(wCaption); + return 0; + } + } +} + +extern "C" int DeviceRun() +{ + if (irrDevice == 0) + { + setError("DeviceRun: library not initialized (use irrCreateDevice)"); + return -1; + } + else + return irrDevice->run(); +} + +extern "C" int DeviceDrop() +{ + if (irrDevice == 0) + { + setError("DeviceDrop: library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrDevice->drop(); + return 0; + } +} + +extern "C" int IrrCreateDevice (int dtype, int sizex, int sizey, int fullscreen, int stencilbuffer, int vsync) +{ + if (sizey < 0 || sizex < 0) + { + setError("IrrCreateDevice: sizex or sizey is negative"); + return -1; + } + + irrDevice = + createDevice( (irr::video::E_DRIVER_TYPE) dtype, dimension2d(sizex, sizey), 16, + fullscreen, stencilbuffer, vsync, 0); + + + if (!irrDevice) + { + setError("IrrCreateDevice: device could not be created"); + return -1; + } + else + { + irrVideoDriver = irrDevice->getVideoDriver(); + irrSceneManager = irrDevice->getSceneManager(); + irrGuiEnvironment = irrDevice->getGUIEnvironment(); + return 0; + } +} + +// Gui Functions + +extern "C" int GuiAddStaticText(char* text, int topleftx, int toplefty, int lowrightx, int lowrighty) +{ + if (irrGuiEnvironment == 0) + { + setError("GuiAddStaticText: library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + wchar_t *wtext = toWchar(text); + if (wtext == NULL) + { + setError("GuiAddStaticText: input text larger then 500 chars"); + return -1; + } + else + { + irrGuiEnvironment->addStaticText(wtext, + rect(topleftx,toplefty,lowrightx,lowrighty), true); + return 0; + } + } +} + +extern "C" int GuiDrawAll() +{ + if (irrGuiEnvironment == 0) + { + setError("GuiDrawAll: library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrGuiEnvironment->drawAll(); + return 0; + } +} + + +// Video-Driver Functions + +extern "C" int VideoBeginScene(int a, int b, int colr, int colg, int colb, int colt) +{ + if (irrVideoDriver == 0) + { + setError("VideoBeginScene: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrVideoDriver->beginScene(a, b, SColor(colt,colr,colg,colb)); + return 0; + } +} + +extern "C" int VideoEndScene() +{ + if (irrVideoDriver == 0) + { + setError("VideoEndScene: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrVideoDriver->endScene(); + return 0; + } +} + +extern "C" int VideoGetTexture(char* texture) +{ + if (irrVideoDriver == 0) + { + setError("VideoGetTexture: Irrlicht library not initialized (use irrCreateDevice)"); + return 0; + } + else + return (int) irrVideoDriver->getTexture(texture); +} + + +// Scene-Manager Functions + +extern "C" int SceneDrawAll() +{ + if (irrSceneManager == 0) + { + setError("SceneDrawAll: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrSceneManager->drawAll(); + return 0; + } +} + +extern "C" int SceneGetMesh(char* mesh) +{ + if (irrSceneManager == 0) + { + setError("SceneGetMesh: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + IAnimatedMesh* pMesh = irrSceneManager->getMesh(mesh); + if (pMesh == 0) + { + setError("SceneGetMesh: could not load mesh"); + return -1; + } + else + return (int) new HelperMesh(pMesh); + } +} + +extern "C" int SceneAddAnimatedMeshSceneNode(int pMesh) +{ + if (irrSceneManager == 0) + { + setError("SceneAddAnimatedMeshSceneNode: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + IAnimatedMesh *pam = ((HelperMesh *) pMesh)->getAnimatedMesh(); + if (pam != NULL) + return (int) new HelperSceneNode((IAnimatedMeshSceneNode* )irrSceneManager->addAnimatedMeshSceneNode(pam)); + else + { + setError("SceneAddAnimatedMeshSceneNode: provided mesh pointer is of wrong type"); + return -1; + } + } +} + +extern "C" int SceneAddCameraSceneNode(int posx, int posy, int posz, int tox, int toy, int toz) +{ + if (irrSceneManager == 0) + { + setError("SceneAddCameraSceneNode: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + irrSceneManager->addCameraSceneNode(0, vector3df(posx,posy,posz), vector3df(tox,toy,toz)); + return 0; + } +} + + +// Node Functions + +extern "C" int NodeSetMaterialTexture(int pNode, int pTexture) +{ + if (pNode == 0) + { + setError("NodeSetMaterialTexture: node parameter is zero in NodeSetMaterialTexture"); + return -1; + } + else if (pTexture == 0) + { + setError("NodeSetMaterialTexture: texture parameter is zero in NodeSetMaterialTexture"); + return -1; + } + else + { + ISceneNode* sceneNode = ((HelperSceneNode *) pNode)->getSceneNode(); + if (sceneNode == NULL) + { + setError("NodeSetMaterialTexture: node parameter is of wrong type"); + return -1; + } + else + { + sceneNode->setMaterialTexture(0, (ITexture *) pTexture); + return 0; + } + } +} + +extern "C" int NodeSetMaterialFlag(int pNode, int mflag, int value) +{ + if (pNode == 0) + { + setError("NodeSetMaterialFlag: node parameter is zero in NodeSetMaterialTexture"); + return -1; + } + else + { + ISceneNode* sceneNode = ((HelperSceneNode *) pNode)->getSceneNode(); + if (sceneNode == NULL) + { + setError("NodeSetMaterialFlag: node parameter is of wrong type"); + return -1; + } + else + { + sceneNode->setMaterialFlag((video::E_MATERIAL_FLAG) mflag, value); + return 0; + } + } +} + +extern "C" int NodeSetMd2Animation(int pNode, int atype) +{ + if (pNode == 0) + { + setError("NodeSetMd2Animation: node parameter is zero in NodeSetMaterialTexture"); + return -1; + } + else + { + IAnimatedMeshSceneNode* sceneNode = ((HelperSceneNode *) pNode)->getAnimatedMeshSceneNode(); + if (sceneNode == NULL) + { + setError("NodeSetMd2Animation: node parameter is of wrong type"); + return -1; + } + else + { + sceneNode->setMD2Animation((scene::EMD2_ANIMATION_TYPE) atype); + return 0; + } + } +} + +//MY STUFF +extern "C" int FileSystemAddZipFileArchive(char *file) +{ + //wchar_t *archiveFile = toWchar(file); + int r; + r = irrDevice->getFileSystem()->addZipFileArchive(file); + + if (r == 0) //false + { + setError("no file map loaded"); + return -1; + } else { + + return 0; + } + +//device->getFileSystem()->addZipFileArchive("/home/maciek/Desktop/irrlicht-1.6/media/map-20kdm2.pk3"); + +} + +extern "C" int SceneAddOctTreeSceneNode(int pMesh)//, int i, int j, int k) +{ + + if (irrSceneManager == 0) + { + setError("SceneAddOctTreeSceneNode: Irrlicht library not initialized (use irrCreateDevice)"); + return -1; + } + else + { + IAnimatedMesh *qMesh = ((HelperMesh *) pMesh)->getAnimatedMesh(); //not sure!! + if (qMesh != NULL) + return (int) new HelperSceneNode((IAnimatedMeshSceneNode* ) irrSceneManager->addOctTreeSceneNode(qMesh->getMesh(0), 0, -1, 1024)); + else + { + setError("SceneAddOctTreeSceneNode: provided mesh pointer is of wrong type"); + return -1; + } + } + +//q3node = smgr->addOctTreeSceneNode(q3levelmesh->getMesh(0), 0, -1, 1024); +} + + +extern "C" int SceneNodeSetPosition (int posx, int posy, int posz, int pNode) +{ + + ISceneNode* sceneNode = ((HelperSceneNode *) pNode)->getSceneNode(); + + if (sceneNode == NULL) { + + setError("NodeSetMaterialFlag: node parameter is of wrong type"); + + return -1; + } else { + + sceneNode->setPosition( vector3df(posx,posy,posz) ); + return 0; + } + +} + +extern "C" int SceneAddCameraSceneNodeFPS () +{ + + irrSceneManager->addCameraSceneNodeFPS(); + return 0; +} + +/* TIMER */ + +extern "C" int GetVirtualTime () { + int time = irrDevice->getTimer()->getTime(); + //cout << time << "\n"; + return time; +} + + + + + + + + + diff --git a/irrlicht_interface.h b/irrlicht_interface.h new file mode 100644 --- /dev/null +++ b/irrlicht_interface.h @@ -0,0 +1,41 @@ +#ifdef __cplusplus +extern "C" { +#endif + +char* getError(); + +int GetEvent(); +char GetCharEvent(); + +int DeviceSetEventReceiver(int control); +int DeviceSetWindowCaption(char* caption); +int DeviceRun(); +int DeviceDrop(); +int IrrCreateDevice (int dtype, int sizex, int sizey, int fullscreen, int stencilbuffer, int vsync); + +int GuiAddStaticText(char* text, int topleftx, int toplefty, int lowrightx, int lowrighty); +int GuiDrawAll(); + +int VideoBeginScene(int a, int b, int colr, int colg, int colb, int colt); +int VideoEndScene(); +int VideoGetTexture(char* texture); + +int SceneDrawAll(); +int SceneGetMesh(char* mesh); +int SceneAddAnimatedMeshSceneNode(int pMesh); +int SceneAddCameraSceneNode(int posx, int posy, int posz, int tox, int toy, int toz); + +int NodeSetMaterialTexture(int pNode, int pTexture); +int NodeSetMaterialFlag(int pNode, int mflag, int value); +int NodeSetMd2Animation(int pNode, int atype); + +int FileSystemAddZipFileArchive(char *file); +int SceneAddOctTreeSceneNode(int pMesh);//, int i, int j, int k); - args not needed +int SceneNodeSetPosition( int posx, int posy, int posz, int pNode); +int SceneAddCameraSceneNodeFPS (); + +int GetVirtualTime (); + +#ifdef __cplusplus +} +#endif diff --git a/irrlicht_interface.hs b/irrlicht_interface.hs new file mode 100644 --- /dev/null +++ b/irrlicht_interface.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Irrlicht where + +import Foreign.GreenCard + +data MeshPtr = MeshPtr Int +data NodePtr = NodePtr Int +data TexturePtr = TexturePtr Int + +%#include "irrlicht_interface.h" + + +%C enum drivertype {EDT_NULL, EDT_SOFTWARE, EDT_BURNINGSVIDEO, EDT_DIRECT3D8, EDT_DIRECT3D9, EDT_OPENGL}; + +%C enum materialflag {EMF_WIREFRAME = 0x1, EMF_POINTCLOUD = 0x2, EMF_GOURARD_SHADING = 0x4, EMF_LIGHTING = 0x8, EMF_ZBUFFER = 0x10, EMF_ZWRITE_ENABLE = 0x20, EMF_BACK_FACE_CULLING = 0x40, EMF_FRONT_FACE_CULLING = 0x80, EMF_BILINEAR_FILTER = 0x100, EMF_TRILINEAR_FILTER = 0x200, EMF_ANISOTROPIC_FILTER = 0x400, EMF_FOG_ENABLE = 0x800, EMF_NORMALIZE_NORMALS = 0x1000, EMF_TEXTURE_WRAP = 0x2000, EMF_ANTI_ALIASING = 0x4000, EMF_COLOR_MASK = 0x8000, EMF_COLOR_MATERIAL = 0x100000}; + +%C enum md2animationtype {EMAT_STAND, EMAT_RUN, EMAT_ATTACK, EMAT_PAIN_A, EMAT_PAIN_B, EMAT_PAIN_C, EMAT_JUMP, EMAT_FLIP, EMAT_SALUTE, EMAT_FALLBACK, EMAT_WAVE, EMAT_POINT, EMAT_CROUCH_STAND, EMAT_CROUCH_WALK, EMAT_CROUCH_ATTACK, EMAT_CROUCH_PAIN, EMAT_CROUCH_DEATH, EMAT_DEATH_FALLBACK, EMAT_DEATH_FALLFORWARD, EMAT_DEATH_FALLBACKSLOW, EMAT_BOOM, EMAT_COUNT}; + +%enum VideoDriverType Int [EDT_NULL, EDT_SOFTWARE, EDT_BURNINGSVIDEO, EDT_DIRECT3D8, EDT_DIRECT3D9, EDT_OPENGL] + +%enum VideoMaterialFlag Int [EMF_WIREFRAME, EMF_POINTCLOUD, EMF_GOURARD_SHADING, EMF_LIGHTING, EMF_ZBUFFER, EMF_ZWRITE_ENABLE, EMF_BACK_FACE_CULLING, EMF_FRONT_FACE_CULLING, EMF_BILINEAR_FILTER, EMF_TRILINEAR_FILTER, EMF_ANISOTROPIC_FILTER, EMF_FOG_ENABLE, EMF_NORMALIZE_NORMALS, EMF_TEXTURE_WRAP, EMF_ANTI_ALIASING, EMF_COLOR_MASK, EMF_COLOR_MATERIAL] + +%enum SceneMd2AnimationType Int [EMAT_STAND, EMAT_RUN, EMAT_ATTACK, EMAT_PAIN_A, EMAT_PAIN_B, EMAT_PAIN_C, EMAT_JUMP, EMAT_FLIP, EMAT_SALUTE, EMAT_FALLBACK, EMAT_WAVE, EMAT_POINT, EMAT_CROUCH_STAND, EMAT_CROUCH_WALK, EMAT_CROUCH_ATTACK, EMAT_CROUCH_PAIN, EMAT_CROUCH_DEATH, EMAT_DEATH_FALLBACK, EMAT_DEATH_FALLFORWARD, EMAT_DEATH_FALLBACKSLOW, EMAT_BOOM, EMAT_COUNT] + +{- Device -} + +%fun GetEvent :: IO Int +%call +%code int result = GetEvent(); +%result (int result) + +%fun GetCharEvent :: IO Char +%call +%code char result = GetCharEvent(); +%result (char result) + +%fun DeviceSetEventReceiver :: Int -> IO () +%call (int control) +%code int result = DeviceSetEventReceiver(control); +%fail {result < 0} {getError();} + +%fun DeviceSetWindowCaption :: String -> IO () +%call (string caption) +%code int result = DeviceSetWindowCaption(caption); +%fail {result < 0} {getError();} + +%fun DeviceRun :: IO Int +%call +%code int result = DeviceRun(); +%fail {result < 0} {getError();} +%result (int result) + +%fun DeviceDrop :: IO () +%call +%code int result = DeviceDrop(); +%fail {result < 0} {getError();} + +%fun IrrCreateDevice :: VideoDriverType -> Int -> Int -> Bool -> Bool -> Bool -> IO () +%call (videoDriverType dtype) (int sizex) (int sizey) (bool fullscreen) (bool stencilbuffer) (bool vsync) +%code int result = IrrCreateDevice(dtype, sizex, sizey, fullscreen, stencilbuffer, vsync); +%fail {result < 0} {getError();} + +{- Gui -} + +%fun GuiAddStaticText :: String -> Int -> Int -> Int -> Int -> IO () +%call (string text) (int topleftx) (int toplefty) (int lowrightx) (int lowrighty) +%code int result = GuiAddStaticText(text, topleftx, toplefty, lowrightx, lowrighty); +%fail {result < 0} {getError();} + +%fun GuiDrawAll :: IO () +%call +%code int result = GuiDrawAll(); +%fail {result < 0} {getError();} + + +{- VideoDriver -} + +%fun VideoBeginScene :: Bool -> Bool -> Int -> Int -> Int -> Int -> IO () +%call (bool a) (bool b) (int colr) (int colg) (int colb) (int colt) +%code int result = VideoBeginScene(a, b, colr, colg, colb, colt); +%fail {result < 0} {getError();} + +%fun VideoEndScene :: IO () +%call +%code int result = VideoEndScene(); +%fail {result < 0} {getError();} + +%fun VideoGetTexture :: String -> IO TexturePtr +%call (string texture) +%code int pTexture = VideoGetTexture(texture); +%fail {pTexture == 0} {getError();} +%result (TexturePtr (int pTexture)) + +{- Scene -} + +%fun SceneDrawAll :: IO () +%call +%code int result = SceneDrawAll(); +%fail {result < 0} {getError();} + +%fun SceneGetMesh :: String -> IO MeshPtr +%call (string mesh) +%code int pMesh = SceneGetMesh(mesh); +%fail {pMesh == 0} {getError();} +%result (MeshPtr (int pMesh)) + +%fun SceneAddAnimatedMeshSceneNode :: MeshPtr -> IO NodePtr +%call (MeshPtr (int pMesh)) +%code int pNode = SceneAddAnimatedMeshSceneNode(pMesh); +%fail {pNode == 0} {getError();} +%result (NodePtr (int pNode)) + +%fun SceneAddCameraSceneNode :: (Int, Int, Int) -> (Int, Int, Int) -> IO () +%call (int posx, int posy, int posz) (int tox, int toy, int toz) +%code int result = SceneAddCameraSceneNode(posx, posy, posz, tox, toy, toz); +%fail {result < 0} {getError();} + +%fun SceneAddOctTreeSceneNode :: MeshPtr -> IO NodePtr +%call (MeshPtr (int pMesh)) +%code int pNode = SceneAddOctTreeSceneNode(pMesh); +%fail {pNode == 0} {getError();} +%result (NodePtr (int pNode)) + +%fun SceneNodeSetPosition :: (Int, Int, Int) -> NodePtr -> IO () +%call (int posx, int posy, int posz) (NodePtr (int pNode)) +%code int result = SceneNodeSetPosition( posx, posy,posz, pNode); +%fail {result <0}{getError();} + +%fun SceneAddCameraSceneNodeFPS :: IO () +%code int result = SceneAddCameraSceneNodeFPS(); +%fail {result <0}{getError();} + +{- Node -} + +%fun NodeSetMaterialTexture :: NodePtr -> TexturePtr -> IO () +%call (NodePtr (int pNode)) (TexturePtr (int pTexture)) +%code int result = NodeSetMaterialTexture(pNode, pTexture); +%fail {result < 0} {getError();} + +%fun NodeSetMaterialFlag :: NodePtr -> VideoMaterialFlag -> Bool -> IO () +%call (NodePtr (int pNode)) (videoMaterialFlag mflag) (bool value) +%code int result = NodeSetMaterialFlag(pNode, mflag, value); +%fail {result < 0} {getError();} + +%fun NodeSetMd2Animation :: NodePtr -> SceneMd2AnimationType -> IO () +%call (NodePtr (int pNode)) (sceneMd2AnimationType atype) +%code int result = NodeSetMd2Animation(pNode, atype); +%fail {result < 0} {getError();} + +{- Files -} +%fun FileSystemAddZipFileArchive :: String -> IO () +%call (string file) +%code int result = FileSystemAddZipFileArchive(file); +%fail {result < 0} {getError();} + +{- Timer -} +%fun GetVirtualTime :: Int +%call +%code int result = GetVirtualTime(); + + diff --git a/irrlicht_interface_ffi.c b/irrlicht_interface_ffi.c new file mode 100644 --- /dev/null +++ b/irrlicht_interface_ffi.c @@ -0,0 +1,597 @@ +#include "irrlicht_interface.h" +#include "irrlicht_interface_ffi.h" + enum drivertype {EDT_NULL, EDT_SOFTWARE, EDT_BURNINGSVIDEO, EDT_DIRECT3D8, EDT_DIRECT3D9, EDT_OPENGL}; + enum materialflag {EMF_WIREFRAME = 0x1, EMF_POINTCLOUD = 0x2, EMF_GOURARD_SHADING = 0x4, EMF_LIGHTING = 0x8, EMF_ZBUFFER = 0x10, EMF_ZWRITE_ENABLE = 0x20, EMF_BACK_FACE_CULLING = 0x40, EMF_FRONT_FACE_CULLING = 0x80, EMF_BILINEAR_FILTER = 0x100, EMF_TRILINEAR_FILTER = 0x200, EMF_ANISOTROPIC_FILTER = 0x400, EMF_FOG_ENABLE = 0x800, EMF_NORMALIZE_NORMALS = 0x1000, EMF_TEXTURE_WRAP = 0x2000, EMF_ANTI_ALIASING = 0x4000, EMF_COLOR_MASK = 0x8000, EMF_COLOR_MATERIAL = 0x100000}; + enum md2animationtype {EMAT_STAND, EMAT_RUN, EMAT_ATTACK, EMAT_PAIN_A, EMAT_PAIN_B, EMAT_PAIN_C, EMAT_JUMP, EMAT_FLIP, EMAT_SALUTE, EMAT_FALLBACK, EMAT_WAVE, EMAT_POINT, EMAT_CROUCH_STAND, EMAT_CROUCH_WALK, EMAT_CROUCH_ATTACK, EMAT_CROUCH_PAIN, EMAT_CROUCH_DEATH, EMAT_DEATH_FALLBACK, EMAT_DEATH_FALLFORWARD, EMAT_DEATH_FALLBACKSLOW, EMAT_BOOM, EMAT_COUNT}; +HsInt prim_eDT_NULL() +{ HsInt res1; + do {res1=EDT_NULL; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eDT_SOFTWARE() +{ HsInt res1; + do {res1=EDT_SOFTWARE; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eDT_BURNINGSVIDEO() +{ HsInt res1; + do {res1=EDT_BURNINGSVIDEO; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eDT_DIRECT3D8() +{ HsInt res1; + do {res1=EDT_DIRECT3D8; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eDT_DIRECT3D9() +{ HsInt res1; + do {res1=EDT_DIRECT3D9; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eDT_OPENGL() +{ HsInt res1; + do {res1=EDT_OPENGL; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_WIREFRAME() +{ HsInt res1; + do {res1=EMF_WIREFRAME; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_POINTCLOUD() +{ HsInt res1; + do {res1=EMF_POINTCLOUD; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_GOURARD_SHADING() +{ HsInt res1; + do {res1=EMF_GOURARD_SHADING; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_LIGHTING() +{ HsInt res1; + do {res1=EMF_LIGHTING; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_ZBUFFER() +{ HsInt res1; + do {res1=EMF_ZBUFFER; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_ZWRITE_ENABLE() +{ HsInt res1; + do {res1=EMF_ZWRITE_ENABLE; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_BACK_FACE_CULLING() +{ HsInt res1; + do {res1=EMF_BACK_FACE_CULLING; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_FRONT_FACE_CULLING() +{ HsInt res1; + do {res1=EMF_FRONT_FACE_CULLING; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_BILINEAR_FILTER() +{ HsInt res1; + do {res1=EMF_BILINEAR_FILTER; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_TRILINEAR_FILTER() +{ HsInt res1; + do {res1=EMF_TRILINEAR_FILTER; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_ANISOTROPIC_FILTER() +{ HsInt res1; + do {res1=EMF_ANISOTROPIC_FILTER; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_FOG_ENABLE() +{ HsInt res1; + do {res1=EMF_FOG_ENABLE; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_NORMALIZE_NORMALS() +{ HsInt res1; + do {res1=EMF_NORMALIZE_NORMALS; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_TEXTURE_WRAP() +{ HsInt res1; + do {res1=EMF_TEXTURE_WRAP; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_ANTI_ALIASING() +{ HsInt res1; + do {res1=EMF_ANTI_ALIASING; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_COLOR_MASK() +{ HsInt res1; + do {res1=EMF_COLOR_MASK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMF_COLOR_MATERIAL() +{ HsInt res1; + do {res1=EMF_COLOR_MATERIAL; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_STAND() +{ HsInt res1; + do {res1=EMAT_STAND; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_RUN() +{ HsInt res1; + do {res1=EMAT_RUN; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_ATTACK() +{ HsInt res1; + do {res1=EMAT_ATTACK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_PAIN_A() +{ HsInt res1; + do {res1=EMAT_PAIN_A; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_PAIN_B() +{ HsInt res1; + do {res1=EMAT_PAIN_B; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_PAIN_C() +{ HsInt res1; + do {res1=EMAT_PAIN_C; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_JUMP() +{ HsInt res1; + do {res1=EMAT_JUMP; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_FLIP() +{ HsInt res1; + do {res1=EMAT_FLIP; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_SALUTE() +{ HsInt res1; + do {res1=EMAT_SALUTE; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_FALLBACK() +{ HsInt res1; + do {res1=EMAT_FALLBACK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_WAVE() +{ HsInt res1; + do {res1=EMAT_WAVE; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_POINT() +{ HsInt res1; + do {res1=EMAT_POINT; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_CROUCH_STAND() +{ HsInt res1; + do {res1=EMAT_CROUCH_STAND; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_CROUCH_WALK() +{ HsInt res1; + do {res1=EMAT_CROUCH_WALK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_CROUCH_ATTACK() +{ HsInt res1; + do {res1=EMAT_CROUCH_ATTACK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_CROUCH_PAIN() +{ HsInt res1; + do {res1=EMAT_CROUCH_PAIN; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_CROUCH_DEATH() +{ HsInt res1; + do {res1=EMAT_CROUCH_DEATH; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_DEATH_FALLBACK() +{ HsInt res1; + do {res1=EMAT_DEATH_FALLBACK; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_DEATH_FALLFORWARD() +{ HsInt res1; + do {res1=EMAT_DEATH_FALLFORWARD; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_DEATH_FALLBACKSLOW() +{ HsInt res1; + do {res1=EMAT_DEATH_FALLBACKSLOW; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_BOOM() +{ HsInt res1; + do {res1=EMAT_BOOM; + + return((HsInt)(res1));} while(0); +} +HsInt prim_eMAT_COUNT() +{ HsInt res1; + do {res1=EMAT_COUNT; + + return((HsInt)(res1));} while(0); +} +HsInt prim_getEvent() +{ HsInt result; + do { int result = GetEvent(); + + return((HsInt)(result));} while(0); +} +HsChar prim_getCharEvent() +{ HsChar result; + do { char result = GetCharEvent(); + + return((HsChar)(result));} while(0); +} +void* prim_deviceSetEventReceiver(HsInt control) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = DeviceSetEventReceiver(control); + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_deviceSetEventReceiver_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_deviceSetEventReceiver_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_deviceSetWindowCaption(char * caption) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = DeviceSetWindowCaption(caption); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_deviceSetWindowCaption_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_deviceSetWindowCaption_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_deviceRun() +{ static struct {HsInt result;HsInt gc_failed;HsPtr gc_failstring;} gc_result; + HsInt result;int gc_failed; + char* gc_failstring; + do { int result = DeviceRun(); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.result = (HsInt)(result); + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +HsInt access_prim_deviceRun_result(void *ptr){ return(((struct {HsInt result;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->result);} +int access_prim_deviceRun_gc_failed(void *ptr){ return(((struct {HsInt result;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_deviceRun_gc_failstring(void *ptr){ return(((struct {HsInt result;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_deviceDrop() +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = DeviceDrop(); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_deviceDrop_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_deviceDrop_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_irrCreateDevice(HsInt dtype,HsInt sizex,HsInt sizey,HsInt fullscreen,HsInt stencilbuffer,HsInt vsync) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = IrrCreateDevice(dtype, sizex, sizey, fullscreen, stencilbuffer, vsync); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_irrCreateDevice_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_irrCreateDevice_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_guiAddStaticText(char * text,HsInt topleftx,HsInt toplefty,HsInt lowrightx,HsInt lowrighty) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = GuiAddStaticText(text, topleftx, toplefty, lowrightx, lowrighty); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_guiAddStaticText_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_guiAddStaticText_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_guiDrawAll() +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = GuiDrawAll(); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_guiDrawAll_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_guiDrawAll_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_videoBeginScene(HsInt a,HsInt b,HsInt colr,HsInt colg,HsInt colb,HsInt colt) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = VideoBeginScene(a, b, colr, colg, colb, colt); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_videoBeginScene_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_videoBeginScene_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_videoEndScene() +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = VideoEndScene(); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_videoEndScene_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_videoEndScene_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_videoGetTexture(char * texture) +{ static struct {HsInt pTexture;HsInt gc_failed;HsPtr gc_failstring;} gc_result; + HsInt pTexture;int gc_failed; + char* gc_failstring; + do { int pTexture = VideoGetTexture(texture); ; + if ((gc_failed = ( pTexture == 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.pTexture = (HsInt)(pTexture); + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +HsInt access_prim_videoGetTexture_pTexture(void *ptr){ return(((struct {HsInt pTexture;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->pTexture);} +int access_prim_videoGetTexture_gc_failed(void *ptr){ return(((struct {HsInt pTexture;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_videoGetTexture_gc_failstring(void *ptr){ return(((struct {HsInt pTexture;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneDrawAll() +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = SceneDrawAll(); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_sceneDrawAll_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneDrawAll_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneGetMesh(char * mesh) +{ static struct {HsInt pMesh;HsInt gc_failed;HsPtr gc_failstring;} gc_result; + HsInt pMesh;int gc_failed; + char* gc_failstring; + do { int pMesh = SceneGetMesh(mesh); ; + if ((gc_failed = ( pMesh == 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.pMesh = (HsInt)(pMesh); + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +HsInt access_prim_sceneGetMesh_pMesh(void *ptr){ return(((struct {HsInt pMesh;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->pMesh);} +int access_prim_sceneGetMesh_gc_failed(void *ptr){ return(((struct {HsInt pMesh;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneGetMesh_gc_failstring(void *ptr){ return(((struct {HsInt pMesh;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneAddAnimatedMeshSceneNode(HsInt pMesh) +{ static struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;} gc_result; + HsInt pNode;int gc_failed; + char* gc_failstring; + do { int pNode = SceneAddAnimatedMeshSceneNode(pMesh); ; + if ((gc_failed = ( pNode == 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.pNode = (HsInt)(pNode); + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +HsInt access_prim_sceneAddAnimatedMeshSceneNode_pNode(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->pNode);} +int access_prim_sceneAddAnimatedMeshSceneNode_gc_failed(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneAddAnimatedMeshSceneNode_gc_failstring(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneAddCameraSceneNode(HsInt posx,HsInt posy,HsInt posz,HsInt tox,HsInt toy,HsInt toz) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = SceneAddCameraSceneNode(posx, posy, posz, tox, toy, toz); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_sceneAddCameraSceneNode_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneAddCameraSceneNode_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneAddOctTreeSceneNode(HsInt pMesh) +{ static struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;} gc_result; + HsInt pNode;int gc_failed; + char* gc_failstring; + do { int pNode = SceneAddOctTreeSceneNode(pMesh); + if ((gc_failed = ( pNode == 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.pNode = (HsInt)(pNode); + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +HsInt access_prim_sceneAddOctTreeSceneNode_pNode(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->pNode);} +int access_prim_sceneAddOctTreeSceneNode_gc_failed(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneAddOctTreeSceneNode_gc_failstring(void *ptr){ return(((struct {HsInt pNode;HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneNodeSetPosition(HsInt posx,HsInt posy,HsInt posz,HsInt pNode) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = SceneNodeSetPosition( posx, posy,posz, pNode); + if ((gc_failed = ( result <0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_sceneNodeSetPosition_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneNodeSetPosition_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_sceneAddCameraSceneNodeFPS() +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = SceneAddCameraSceneNodeFPS(); + if ((gc_failed = ( result <0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_sceneAddCameraSceneNodeFPS_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_sceneAddCameraSceneNodeFPS_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_nodeSetMaterialTexture(HsInt pNode,HsInt pTexture) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = NodeSetMaterialTexture(pNode, pTexture); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_nodeSetMaterialTexture_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_nodeSetMaterialTexture_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_nodeSetMaterialFlag(HsInt pNode,HsInt mflag,HsInt value) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = NodeSetMaterialFlag(pNode, mflag, value); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_nodeSetMaterialFlag_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_nodeSetMaterialFlag_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_nodeSetMd2Animation(HsInt pNode,HsInt atype) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = NodeSetMd2Animation(pNode, atype); ; + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_nodeSetMd2Animation_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_nodeSetMd2Animation_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +void* prim_fileSystemAddZipFileArchive(char * file) +{ static struct {HsInt gc_failed;HsPtr gc_failstring;} gc_result; + int gc_failed; + char* gc_failstring; + do { int result = FileSystemAddZipFileArchive(file); + if ((gc_failed = ( result < 0 ))) {gc_failstring = getError(); ;} + else {gc_failed = 0;} + gc_result.gc_failed = gc_failed; + gc_result.gc_failstring = gc_failstring; + + return(&gc_result);} while(0); +} +int access_prim_fileSystemAddZipFileArchive_gc_failed(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failed);} +void* access_prim_fileSystemAddZipFileArchive_gc_failstring(void *ptr){ return(((struct {HsInt gc_failed;HsPtr gc_failstring;}*) ptr)->gc_failstring);} +HsInt prim_getVirtualTime() +{ HsInt res1; + do { int result = GetVirtualTime(); + + return((HsInt)(res1));} while(0); +} diff --git a/irrlicht_interface_ffi.h b/irrlicht_interface_ffi.h new file mode 100644 --- /dev/null +++ b/irrlicht_interface_ffi.h @@ -0,0 +1,121 @@ +#ifndef _irrlicht_interface_ffi_h +#define _irrlicht_interface_ffi_h +#include "irrlicht_interface.h" +#include "HsFFI.h" +extern HsInt prim_eDT_NULL(); +extern HsInt prim_eDT_SOFTWARE(); +extern HsInt prim_eDT_BURNINGSVIDEO(); +extern HsInt prim_eDT_DIRECT3D8(); +extern HsInt prim_eDT_DIRECT3D9(); +extern HsInt prim_eDT_OPENGL(); +extern HsInt prim_eMF_WIREFRAME(); +extern HsInt prim_eMF_POINTCLOUD(); +extern HsInt prim_eMF_GOURARD_SHADING(); +extern HsInt prim_eMF_LIGHTING(); +extern HsInt prim_eMF_ZBUFFER(); +extern HsInt prim_eMF_ZWRITE_ENABLE(); +extern HsInt prim_eMF_BACK_FACE_CULLING(); +extern HsInt prim_eMF_FRONT_FACE_CULLING(); +extern HsInt prim_eMF_BILINEAR_FILTER(); +extern HsInt prim_eMF_TRILINEAR_FILTER(); +extern HsInt prim_eMF_ANISOTROPIC_FILTER(); +extern HsInt prim_eMF_FOG_ENABLE(); +extern HsInt prim_eMF_NORMALIZE_NORMALS(); +extern HsInt prim_eMF_TEXTURE_WRAP(); +extern HsInt prim_eMF_ANTI_ALIASING(); +extern HsInt prim_eMF_COLOR_MASK(); +extern HsInt prim_eMF_COLOR_MATERIAL(); +extern HsInt prim_eMAT_STAND(); +extern HsInt prim_eMAT_RUN(); +extern HsInt prim_eMAT_ATTACK(); +extern HsInt prim_eMAT_PAIN_A(); +extern HsInt prim_eMAT_PAIN_B(); +extern HsInt prim_eMAT_PAIN_C(); +extern HsInt prim_eMAT_JUMP(); +extern HsInt prim_eMAT_FLIP(); +extern HsInt prim_eMAT_SALUTE(); +extern HsInt prim_eMAT_FALLBACK(); +extern HsInt prim_eMAT_WAVE(); +extern HsInt prim_eMAT_POINT(); +extern HsInt prim_eMAT_CROUCH_STAND(); +extern HsInt prim_eMAT_CROUCH_WALK(); +extern HsInt prim_eMAT_CROUCH_ATTACK(); +extern HsInt prim_eMAT_CROUCH_PAIN(); +extern HsInt prim_eMAT_CROUCH_DEATH(); +extern HsInt prim_eMAT_DEATH_FALLBACK(); +extern HsInt prim_eMAT_DEATH_FALLFORWARD(); +extern HsInt prim_eMAT_DEATH_FALLBACKSLOW(); +extern HsInt prim_eMAT_BOOM(); +extern HsInt prim_eMAT_COUNT(); +extern HsInt prim_getEvent(); +extern HsChar prim_getCharEvent(); +extern void* prim_deviceSetEventReceiver(HsInt control); +extern int access_prim_deviceSetEventReceiver_gc_failed(HsPtr); +extern void* access_prim_deviceSetEventReceiver_gc_failstring(HsPtr); +extern void* prim_deviceSetWindowCaption(char * caption); +extern int access_prim_deviceSetWindowCaption_gc_failed(HsPtr); +extern void* access_prim_deviceSetWindowCaption_gc_failstring(HsPtr); +extern void* prim_deviceRun(); +extern HsInt access_prim_deviceRun_result(HsPtr); +extern int access_prim_deviceRun_gc_failed(HsPtr); +extern void* access_prim_deviceRun_gc_failstring(HsPtr); +extern void* prim_deviceDrop(); +extern int access_prim_deviceDrop_gc_failed(HsPtr); +extern void* access_prim_deviceDrop_gc_failstring(HsPtr); +extern void* prim_irrCreateDevice(HsInt dtype,HsInt sizex,HsInt sizey,HsInt fullscreen,HsInt stencilbuffer,HsInt vsync); +extern int access_prim_irrCreateDevice_gc_failed(HsPtr); +extern void* access_prim_irrCreateDevice_gc_failstring(HsPtr); +extern void* prim_guiAddStaticText(char * text,HsInt topleftx,HsInt toplefty,HsInt lowrightx,HsInt lowrighty); +extern int access_prim_guiAddStaticText_gc_failed(HsPtr); +extern void* access_prim_guiAddStaticText_gc_failstring(HsPtr); +extern void* prim_guiDrawAll(); +extern int access_prim_guiDrawAll_gc_failed(HsPtr); +extern void* access_prim_guiDrawAll_gc_failstring(HsPtr); +extern void* prim_videoBeginScene(HsInt a,HsInt b,HsInt colr,HsInt colg,HsInt colb,HsInt colt); +extern int access_prim_videoBeginScene_gc_failed(HsPtr); +extern void* access_prim_videoBeginScene_gc_failstring(HsPtr); +extern void* prim_videoEndScene(); +extern int access_prim_videoEndScene_gc_failed(HsPtr); +extern void* access_prim_videoEndScene_gc_failstring(HsPtr); +extern void* prim_videoGetTexture(char * texture); +extern HsInt access_prim_videoGetTexture_pTexture(HsPtr); +extern int access_prim_videoGetTexture_gc_failed(HsPtr); +extern void* access_prim_videoGetTexture_gc_failstring(HsPtr); +extern void* prim_sceneDrawAll(); +extern int access_prim_sceneDrawAll_gc_failed(HsPtr); +extern void* access_prim_sceneDrawAll_gc_failstring(HsPtr); +extern void* prim_sceneGetMesh(char * mesh); +extern HsInt access_prim_sceneGetMesh_pMesh(HsPtr); +extern int access_prim_sceneGetMesh_gc_failed(HsPtr); +extern void* access_prim_sceneGetMesh_gc_failstring(HsPtr); +extern void* prim_sceneAddAnimatedMeshSceneNode(HsInt pMesh); +extern HsInt access_prim_sceneAddAnimatedMeshSceneNode_pNode(HsPtr); +extern int access_prim_sceneAddAnimatedMeshSceneNode_gc_failed(HsPtr); +extern void* access_prim_sceneAddAnimatedMeshSceneNode_gc_failstring(HsPtr); +extern void* prim_sceneAddCameraSceneNode(HsInt posx,HsInt posy,HsInt posz,HsInt tox,HsInt toy,HsInt toz); +extern int access_prim_sceneAddCameraSceneNode_gc_failed(HsPtr); +extern void* access_prim_sceneAddCameraSceneNode_gc_failstring(HsPtr); +extern void* prim_sceneAddOctTreeSceneNode(HsInt pMesh); +extern HsInt access_prim_sceneAddOctTreeSceneNode_pNode(HsPtr); +extern int access_prim_sceneAddOctTreeSceneNode_gc_failed(HsPtr); +extern void* access_prim_sceneAddOctTreeSceneNode_gc_failstring(HsPtr); +extern void* prim_sceneNodeSetPosition(HsInt posx,HsInt posy,HsInt posz,HsInt pNode); +extern int access_prim_sceneNodeSetPosition_gc_failed(HsPtr); +extern void* access_prim_sceneNodeSetPosition_gc_failstring(HsPtr); +extern void* prim_sceneAddCameraSceneNodeFPS(); +extern int access_prim_sceneAddCameraSceneNodeFPS_gc_failed(HsPtr); +extern void* access_prim_sceneAddCameraSceneNodeFPS_gc_failstring(HsPtr); +extern void* prim_nodeSetMaterialTexture(HsInt pNode,HsInt pTexture); +extern int access_prim_nodeSetMaterialTexture_gc_failed(HsPtr); +extern void* access_prim_nodeSetMaterialTexture_gc_failstring(HsPtr); +extern void* prim_nodeSetMaterialFlag(HsInt pNode,HsInt mflag,HsInt value); +extern int access_prim_nodeSetMaterialFlag_gc_failed(HsPtr); +extern void* access_prim_nodeSetMaterialFlag_gc_failstring(HsPtr); +extern void* prim_nodeSetMd2Animation(HsInt pNode,HsInt atype); +extern int access_prim_nodeSetMd2Animation_gc_failed(HsPtr); +extern void* access_prim_nodeSetMd2Animation_gc_failstring(HsPtr); +extern void* prim_fileSystemAddZipFileArchive(char * file); +extern int access_prim_fileSystemAddZipFileArchive_gc_failed(HsPtr); +extern void* access_prim_fileSystemAddZipFileArchive_gc_failstring(HsPtr); +extern HsInt prim_getVirtualTime(); +#endif diff --git a/sample.hs b/sample.hs new file mode 100644 --- /dev/null +++ b/sample.hs @@ -0,0 +1,316 @@ +module Main where + +import Irrlicht +import Data.Time +import Data.Time.Clock.POSIX +import Memo1 +import Control.Concurrent.Chan + +--import SOE hiding (Region, Event) +--import qualified SOE as G (Region, Event) +import Animation (picToGraphic) +import Shape +import Picture + +import Draw (xWin,yWin,intToFloat) + +infixr 1 =>>, ->> +infixr 1 `untilB`, `switch`, `stepAccum`, `step` +infixr 4 <*, >* +infixl 0 .|. +infixr 3 &&* +infixr 2 ||* + +type Caption = String +type Counter = Int + +caption1, caption2, caption3, caption4 :: Behavior Caption +caption1 = constB "Initial Caption" +caption2 = constB "Any Key Pressed" +caption3 = constB "a Key Pressed" +caption4 = constB "b Key Pressed" + +counter1 :: Behavior Counter +counter1 = constB 999 + +capt1 :: Behavior Caption +capt1 = caption1 `untilB` key ->> caption2 + +capt2 :: Behavior Caption +capt2 = caption1 `switch` (key =>> \c -> + case c of 'a' -> caption3 + 'b' -> caption4 + _ -> caption1 ) + + +countBeh :: Behavior Counter +countBeh = (0 `stepAccum` key ->> (+1)) `untilB` when (time >* 10) ->> counter1 + +type Time = POSIXTime + +data EventStruct = Key { + char :: Char + } + deriving Show + +type UserAction = EventStruct + +data GameChan = GameChan { + eventsChan :: Chan UserAction +} + +initGameChan :: IO GameChan +initGameChan = do + eventsChan <- newChan + return GameChan {eventsChan = eventsChan } + +newtype Behavior a = Behavior (([Maybe UserAction],[Time]) -> [a]) + +newtype Event a = Event (([Maybe UserAction],[Time]) -> [Maybe a]) + +time :: Behavior Time +time = Behavior (\(_,ts) -> ts) + +constB :: a -> Behavior a +constB x = Behavior (\_ -> repeat x) + +($*) :: Behavior (a->b) -> Behavior a -> Behavior b +Behavior ff $* Behavior fb = Behavior (\uts -> zipWith ($) (ff uts) (fb uts)) + +lift0 :: a -> Behavior a +lift0 = constB + +lift1 :: (a -> b) -> (Behavior a -> Behavior b) +lift1 f b1 = lift0 f $* b1 + +lift2 :: (a -> b -> c) -> (Behavior a -> Behavior b -> Behavior c) +lift2 f b1 b2 = lift1 f b1 $* b2 + +lift3 :: (a -> b -> c -> d) -> (Behavior a -> Behavior b -> Behavior c -> Behavior d) +lift3 f b1 b2 b3 = lift2 f b1 b2 $* b3 + +pairB :: Behavior a -> Behavior b -> Behavior (a,b) +pairB = lift2 (,) + +fstB :: Behavior (a,b) -> Behavior a +fstB = lift1 fst +sndB :: Behavior (a,b) -> Behavior b +sndB = lift1 snd + +shape :: Behavior Shape -> Behavior Region +shape = lift1 Shape + +ell, rec :: Behavior Float -> Behavior Float -> Behavior Region +ell x y = shape (lift2 Ellipse x y) +rec x y = shape (lift2 Rectangle x y) + +translate :: (Behavior Float, Behavior Float) -> Behavior Region -> Behavior Region +translate (Behavior fx, Behavior fy) (Behavior fp) = Behavior (\uts -> zipWith3 aux (fx uts) (fy uts) (fp uts)) + where aux x y p = Translate (x,y) p + +(>*),(<*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool +(>*) = lift2 (>) +(<*) = lift2 (<) + +(&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool +(&&*) = lift2 (&&) +(||*) = lift2 (||) + +over :: Behavior Picture -> Behavior Picture -> Behavior Picture +over = lift2 Over + +instance Fractional a => Fractional (Behavior a) where + (/) = lift2 (/) + fromRational = lift0 . fromRational + +instance Num a => Num (Behavior a) where + (+) = lift2 (+) + (*) = lift2 (*) + negate = lift1 negate + abs = lift1 abs + signum = lift1 signum + fromInteger = lift0 . fromInteger + +instance Show (Behavior a) where + showsPrec n a s = "<< Behavior >>" + +instance Eq (Behavior a) where + a1 == a2 = error "Can't compare behaviors." + +Behavior fb `untilB` Event fe = + memoB $ Behavior (\uts@(us,ts) -> loop us ts (fe uts) (fb uts)) + where loop (_:us) (_:ts) ~(e:es) (b:bs) = + b : case e of + Nothing -> loop us ts es bs + Just (Behavior fb') -> fb' (us,ts) + +memoB :: Behavior a -> Behavior a + +memoB (Behavior fb) = Behavior (memo1 fb) + +Behavior fb `switch` Event fe = + memoB $ Behavior (\uts@(us,ts) -> loop us ts (fe uts) (fb uts)) + where loop (_:us) (_:ts) ~(e:es) ~(b:bs) = + b : case e of + Nothing -> loop us ts es bs + Just (Behavior fb') -> loop us ts es (fb' (us,ts)) + +(=>>) :: Event a -> (a->b) -> Event b + +Event fe =>> f = Event (map (fmap f) . fe) + +e ->> v = e =>> \_ -> v + +unique :: (Show a, Eq a) => Event a -> Event a +unique (Event fe) = + Event (\uts -> aux (fe uts)) + where aux xs = zipWith remdup (Nothing:xs) xs + remdup x y | x==y = Nothing + | otherwise = y + +when :: Behavior Bool -> Event () +when = unique . while + +while :: Behavior Bool -> Event () + +while (Behavior fb) + = Event (\uts -> map aux (fb uts)) + where aux True = Just () + aux False = Nothing + +withElem :: Event a -> [b] -> Event (a,b) +withElem (Event fe) bs = Event (\uts -> loop (fe uts) bs) + where loop (Just a : evs) (b:bs) = Just (a,b) : loop evs bs + loop (Nothing : evs) bs = Nothing : loop evs bs + +withElem_ :: Event a -> [b] -> Event b +withElem_ e bs = e `withElem` bs =>> snd + +(.|.) :: Event a -> Event a -> Event a +Event fe1 .|. Event fe2 + = Event (\uts -> zipWith aux (fe1 uts) (fe2 uts)) + where aux Nothing Nothing = Nothing + aux (Just x) _ = Just x + aux _ (Just y) = Just y + +key :: Event Char +key = Event (\(uas,_) -> map getkey uas) + where getkey (Just (Key ch)) = Just ch + getkey _ = Nothing + +snapshot :: Event a -> Behavior b -> Event (a,b) +Event fe `snapshot` Behavior fb + = Event (\uts -> zipWith' aux (fe uts) (fb uts)) + where aux (Just x) y = Just (x, y) + aux Nothing _ = Nothing + +zipWith' f ~(x:xs) ~(y:ys) = f x y : zipWith' f xs ys + +snapshot_ :: Event a -> Behavior b -> Event b +snapshot_ e b = e `snapshot` b =>> snd + +step :: a -> Event a -> Behavior a + +a `step` e = constB a `switch` e =>> constB + +stepAccum :: a -> Event (a->a) -> Behavior a + +a `stepAccum` e = b + where b = a `step` (e `snapshot` b =>> uncurry ($)) + +reactimate :: GameChan -> Behavior Caption -> IO () +reactimate gameCh franProg = do + (user,addEvents) <- windowUser gameCh + addEvents + let drawPic (Just p) = do + running <- deviceRun + videoBeginScene True True 255 200 200 200 + sceneDrawAll + guiDrawAll + deviceSetWindowCaption (show p) + ch <- getCharEvent + writeChan (eventsChan gameCh) (Key { char = ch }) + videoEndScene + addEvents + drawPic Nothing = return () + mapM_ drawPic (runEvent (sample `snapshot_` franProg) user) + +runEvent (Event fe) u = fe u + +sample :: Event () +sample = Event (\(us,_) -> map aux us) + where aux Nothing = Just () + aux (Just _) = Nothing + + +-- have to create an instance of channel, globally accessible or something like that, replace Window type +maybeGetWindowEvent :: GameChan -> IO (Maybe UserAction) +maybeGetWindowEvent gameCh = do + --print "maybeGetWindowEvent" + noEvents <- isEmptyChan (eventsChan gameCh) + if noEvents + then return Nothing + else do + event <- readChan (eventsChan gameCh) + if ((char event) == ' ') + then return Nothing + else return (Just event) + +-- adapt windowUser +windowUser :: GameChan -> IO (([Maybe UserAction], [POSIXTime]), IO ()) +windowUser gameCh = do + (evs, addEv) <- makeStream + t0 <- getPOSIXTime + let loop rt = do + mev <- maybeGetWindowEvent gameCh + --print mev + case mev of + Nothing -> return () + Just e -> do addEv (Just e, rt) + loop rt + let addEvents = do + t <- getPOSIXTime + let rt = t - t0 + loop rt + addEv (Nothing, rt) + return ((map fst evs, map snd evs), addEvents) + +makeStream :: IO ([a], a -> IO ()) +makeStream = do + ch <- newChan + contents <- getChanContents ch + return (contents, writeChan ch) + +gameLoop t0 gameCh= + do + running <- deviceRun + videoBeginScene True True 255 200 200 200 + sceneDrawAll + guiDrawAll + + ch <- getCharEvent + + writeChan (eventsChan gameCh) (Key { char = ch }) + + videoEndScene + if (running > 0) + then gameLoop t0 gameCh + else return () + +main = do + irrCreateDevice EDT_OPENGL 640 480 False False False + fileSystemAddZipFileArchive "/home/maciek/media/map-20kdm2.pk3" + mesh <- sceneGetMesh "20kdm2.bsp" + node <- sceneAddOctTreeSceneNode(mesh) + sceneNodeSetPosition ((-1300), (-144), (-1249)) node + sceneAddCameraSceneNodeFPS + deviceSetEventReceiver 1 + + gameCh <- initGameChan + + t0 <- getPOSIXTime + --gameLoop t0 gameCh + reactimate gameCh capt2 + deviceDrop + +