IrrHaskell (empty) → 0.1
raw patch · 13 files changed
+2911/−0 lines, 13 filesdep +basesetup-changed
Dependencies added: base
Files
- IrrHaskell.cabal +30/−0
- IrrHaskell.cabal~ +30/−0
- LICENSE +1/−0
- Makefile +57/−0
- Memo1.lhs +61/−0
- Setup.hs +3/−0
- irrlicht.hs +883/−0
- irrlicht_interface.cpp +609/−0
- irrlicht_interface.h +41/−0
- irrlicht_interface.hs +162/−0
- irrlicht_interface_ffi.c +597/−0
- irrlicht_interface_ffi.h +121/−0
- sample.hs +316/−0
+ IrrHaskell.cabal view
@@ -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+++
+ IrrHaskell.cabal~ view
@@ -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: +++
+ LICENSE view
@@ -0,0 +1,1 @@+
+ Makefile view
@@ -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
+ Memo1.lhs view
@@ -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)
+ Setup.hs view
@@ -0,0 +1,3 @@+-- Simple setup+import Distribution.Simple+main = defaultMain
+ irrlicht.hs view
@@ -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)++
+ irrlicht_interface.cpp view
@@ -0,0 +1,609 @@+#include "irrlicht.h" + +#include <stdlib.h>+#include <iostream> + +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<u32>(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<s32>(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;+}+++++++++
+ irrlicht_interface.h view
@@ -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
+ irrlicht_interface.hs view
@@ -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();++
+ irrlicht_interface_ffi.c view
@@ -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);+}
+ irrlicht_interface_ffi.h view
@@ -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
+ sample.hs view
@@ -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 + +