module Graphics.Ogre.Ogre(Vector3(..),
Angle, Rotation(..), Color(..),
TransformSpace(..),
ShadowTechnique(..),
Light(..),
LightType(..),
EntityType(..),
Camera(..),
Entity(..),
OgreSettings(..),
OgreScene(..),
SceneManagerType(..),
halfPI,
degToRad,
unitX, unitY, unitZ,
negUnitX, negUnitY, negUnitZ,
initOgre,
addScene,
setupCamera,
clearScene,
addLight,
addEntity,
setLightPosition,
setEntityPosition,
rotateEntity,
rotateCamera,
translateEntity,
translateCamera,
setLightVisible,
setAmbientLight,
setSkyDome,
setWorldGeometry,
setCameraPosition,
getCameraPosition,
raySceneQuerySimple,
raySceneQueryMouseSimple,
renderOgre,
cleanupOgre)
where
import CTypes
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal
import CString
foreign import ccall "ogre.h init" c_init :: CInt -> CString -> CInt -> CString -> CFloat -> CFloat -> CFloat -> CInt -> IO ()
foreign import ccall "ogre.h setAmbientLight" c_set_ambient_light :: CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h setLightPosition" c_set_light_position :: CString -> CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h setEntityPosition" c_set_entity_position :: CString -> CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h cleanup" c_cleanup :: IO ()
foreign import ccall "ogre.h render" c_render :: IO ()
foreign import ccall "ogre.h addEntity" c_add_entity :: CString -> CString -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h setupCamera" c_setup_camera :: CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h addPlane" c_add_plane :: CFloat -> CFloat -> CFloat -> CFloat -> CString -> CFloat -> CFloat -> CInt -> CInt -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CString -> CInt -> IO ()
foreign import ccall "ogre.h addLight" c_add_light :: CString -> CInt -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h rotateEntity" c_rotate_entity :: CString -> CFloat -> CFloat -> CFloat -> CInt -> IO ()
foreign import ccall "ogre.h rotateCamera" c_rotate_camera :: CFloat -> CFloat -> CFloat -> CInt -> IO ()
foreign import ccall "ogre.h translateEntity" c_translate_entity :: CString -> CFloat -> CFloat -> CFloat -> CInt -> IO ()
foreign import ccall "ogre.h translateCamera" c_translate_camera :: CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h setLightVisible" c_set_light_visible :: CString -> CInt -> IO ()
foreign import ccall "ogre.h setSkyDome" c_set_sky_dome :: CInt -> CString -> CFloat -> IO ()
foreign import ccall "ogre.h setWorldGeometry" c_set_world_geometry :: CString -> IO ()
foreign import ccall "ogre.h setCameraPosition" c_set_camera_position :: CFloat -> CFloat -> CFloat -> IO ()
foreign import ccall "ogre.h getCameraPosition" c_get_camera_position :: Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
foreign import ccall "ogre.h raySceneQuerySimple" c_ray_scene_query_simple ::
CFloat -> CFloat -> CFloat ->
CFloat -> CFloat -> CFloat ->
Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO Int
foreign import ccall "ogre.h raySceneQueryMouseSimple" c_ray_scene_query_mouse_simple ::
CFloat -> CFloat ->
Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO Int
foreign import ccall "ogre.h clearScene" c_clear_scene :: IO ()
data Vector3 = Vector3 { x :: Float, y :: Float, z :: Float }
deriving (Eq, Show, Read)
type Angle = Float
data TransformSpace = Local
| Parent
| World
deriving (Eq, Show, Read, Enum)
data Rotation = YPR { yaw :: Angle
, pitch :: Angle
, roll :: Angle
}
deriving (Eq, Show, Read)
data Color = Color { r :: Float, g :: Float, b :: Float }
deriving (Eq, Show, Read)
data ShadowTechnique = None
| StencilModulative
| StencilAdditive
| TextureModulative
| TextureAdditive
| TextureAdditiveIntegrated
| TextureModulativeIntegrated
deriving (Eq, Show, Read, Enum)
data Light = Light { lightname :: String
, diffuse :: Color
, specular :: Color
, lighttype :: LightType
}
deriving (Eq, Show, Read)
data LightType = PointLight { plposition :: Vector3 }
| DirectionalLight { dldirection :: Vector3 }
| SpotLight { slposition :: Vector3
, sldirection :: Vector3
, range :: (Angle, Angle)
}
deriving (Eq, Show, Read)
data EntityType = StdMesh { mesh :: String
, rotation :: Rotation
}
| Plane { normal :: Vector3
, shift :: Float
, width :: Float
, height :: Float
, xsegments :: Int
, ysegments :: Int
, utile :: Float
, vtile :: Float
, upvector :: Vector3
, material :: String
}
deriving (Eq, Show, Read)
data Camera = Camera { lookat :: Vector3
, camroll :: Angle
, camposition :: Vector3
}
deriving (Eq, Show, Read)
defaultCamera :: Camera
defaultCamera = Camera (Vector3 1.0 0.0 0.0) 0 (Vector3 0.0 0.0 0.0)
data Entity = Entity { name :: String
, position :: Vector3
, entitytype :: EntityType
, castshadows :: Bool
, scale :: Vector3
}
deriving (Eq, Show, Read)
data SceneManagerType = Generic
| ExteriorClose
| ExteriorFar
| ExteriorRealFar
| Interior
deriving (Eq, Show, Read)
data OgreSettings = OgreSettings { resourcefile :: FilePath
, autocreatewindow :: Bool
, caption :: String
, ambientlight :: Color
, shadowtechnique :: ShadowTechnique
, scenemanagertype :: [SceneManagerType]
}
deriving (Eq, Show, Read)
data OgreScene = OgreScene { camera :: Camera
, entities :: [Entity]
, lights :: [Light]
}
deriving (Eq, Show, Read)
halfPI :: Float
halfPI = pi * 0.5
degToRad :: Float -> Float
degToRad d = d * pi / 180.0
unitX :: Vector3
unitX = Vector3 1.0 0.0 0.0
unitY :: Vector3
unitY = Vector3 0.0 1.0 0.0
unitZ :: Vector3
unitZ = Vector3 0.0 0.0 1.0
nullVector :: Vector3
nullVector = Vector3 0.0 0.0 0.0
negUnitX :: Vector3
negUnitX = Vector3 (1.0) 0.0 0.0
negUnitY :: Vector3
negUnitY = Vector3 0.0 (1.0) 0.0
negUnitZ :: Vector3
negUnitZ = Vector3 0.0 0.0 (1.0)
managerMaskFromEnum :: [SceneManagerType] -> CInt
managerMaskFromEnum = foldl go 0
where go acc s = acc + go' s
go' Generic = 1
go' ExteriorClose = 2
go' ExteriorFar = 4
go' ExteriorRealFar = 8
go' Interior = 16
initOgre :: OgreSettings -> IO ()
initOgre sett = do
let mgr_type = max 1 (managerMaskFromEnum (scenemanagertype sett))
withCString (resourcefile sett) $ \c_res -> do
withCString (caption sett) $ \c_caption -> do
c_init ((fromIntegral . fromEnum) (shadowtechnique sett)) c_res ((fromIntegral . fromEnum) (autocreatewindow sett)) c_caption 0.0 0.0 0.0 mgr_type
setAmbientLight (ambientlight sett)
setupCamera defaultCamera
setAmbientLight :: Color -> IO ()
setAmbientLight (Color r_ g_ b_) = c_set_ambient_light (realToFrac r_) (realToFrac g_) (realToFrac b_)
clearScene :: IO ()
clearScene = c_clear_scene
addScene :: OgreScene -> IO ()
addScene scen = do
setupCamera (camera scen)
mapM_ addLight (lights scen)
mapM_ addEntity (entities scen)
setupCamera :: Camera -> IO ()
setupCamera (Camera look rol pos) = do
c_setup_camera
(realToFrac (x pos))
(realToFrac (y pos))
(realToFrac (z pos))
(realToFrac (x look))
(realToFrac (y look))
(realToFrac (z look))
(realToFrac rol)
addLight :: Light -> IO ()
addLight (Light nam dif spec ltype) = do
let (t, pos, dir, rmin, rmax) = case ltype of
PointLight lp -> (0, lp, nullVector, 0, 0)
DirectionalLight ld -> (1, nullVector, ld, 0, 0)
SpotLight lp ld (lrmi, lrma) -> (2, lp, ld, lrmi, lrma)
withCString nam $ \c_name -> do
c_add_light c_name t
(realToFrac (r dif))
(realToFrac (g dif))
(realToFrac (b dif))
(realToFrac (r spec))
(realToFrac (g spec))
(realToFrac (b spec))
(realToFrac (x dir))
(realToFrac (y dir))
(realToFrac (z dir))
(realToFrac (x pos))
(realToFrac (y pos))
(realToFrac (z pos))
(realToFrac rmin)
(realToFrac rmax)
addEntity :: Entity -> IO ()
addEntity (Entity n pos t sh sc) = do
withCString n $ \c_name -> do
case t of
StdMesh m (YPR ya pit ro) -> do
withCString m $ \c_meshname -> do
c_add_entity c_name c_meshname
(realToFrac (x pos))
(realToFrac (y pos))
(realToFrac (z pos))
(realToFrac (x sc))
(realToFrac (y sc))
(realToFrac (z sc))
(realToFrac pit) (realToFrac ya) (realToFrac ro)
Plane norm shif wid hei xseg yseg ut vt upv mat -> do
withCString mat $ \c_material -> do
c_add_plane (realToFrac (x norm)) (realToFrac (y norm)) (realToFrac (z norm)) (realToFrac (shif)) c_name (realToFrac (wid)) (realToFrac (hei)) (fromIntegral xseg) (fromIntegral (yseg)) (realToFrac (ut)) (realToFrac (vt)) (realToFrac (x upv)) (realToFrac (y upv)) (realToFrac (z upv)) (realToFrac (x pos)) (realToFrac (y pos)) (realToFrac (z pos)) c_material ((fromIntegral . fromEnum) sh)
setLightPosition :: String
-> Vector3
-> IO ()
setLightPosition n (Vector3 x_ y_ z_) = withCString n $ \cn -> c_set_light_position cn (realToFrac x_) (realToFrac y_) (realToFrac z_)
setEntityPosition :: String
-> Vector3
-> IO ()
setEntityPosition n (Vector3 x_ y_ z_) = withCString n $ \cn -> c_set_entity_position cn (realToFrac x_) (realToFrac y_) (realToFrac z_)
rotateEntity :: String -> Rotation -> TransformSpace -> IO ()
rotateEntity n (YPR ya pit ro) ts = withCString n $ \cn -> c_rotate_entity cn (realToFrac ya) (realToFrac pit) (realToFrac ro) ((fromIntegral . fromEnum) ts)
rotateCamera :: Rotation -> TransformSpace -> IO ()
rotateCamera (YPR ya pit ro) ts = c_rotate_camera (realToFrac ya) (realToFrac pit) (realToFrac ro) ((fromIntegral . fromEnum) ts)
translateEntity :: String -> Vector3 -> TransformSpace -> IO ()
translateEntity n (Vector3 x_ y_ z_) ts = withCString n $ \cn -> c_translate_entity cn (realToFrac x_) (realToFrac y_) (realToFrac z_) ((fromIntegral . fromEnum) ts)
translateCamera :: Vector3 -> IO ()
translateCamera (Vector3 x_ y_ z_) = c_translate_camera (realToFrac x_) (realToFrac y_) (realToFrac z_)
setLightVisible :: String -> Bool -> IO ()
setLightVisible n v = withCString n $ \cn -> c_set_light_visible cn ((fromIntegral . fromEnum) v)
setSkyDome :: Maybe (String, Float)
-> IO ()
setSkyDome Nothing = withCString "" $ \cs -> c_set_sky_dome 0 cs 5
setSkyDome (Just (n, curv)) = withCString n $ \cs -> c_set_sky_dome 1 cs (realToFrac curv)
setWorldGeometry :: String -> IO ()
setWorldGeometry s = withCString s $ \cs -> c_set_world_geometry cs
setCameraPosition :: Vector3 -> IO ()
setCameraPosition v = withCVector v c_set_camera_position
getCameraPosition :: IO Vector3
getCameraPosition = alloca $ \x_ -> do
alloca $ \y_ -> do
alloca $ \z_ -> do
c_get_camera_position x_ y_ z_
xx <- peek x_
yy <- peek y_
zz <- peek z_
return (Vector3 (realToFrac xx) (realToFrac yy) (realToFrac zz))
withCVector :: Vector3 -> (CFloat -> CFloat -> CFloat -> IO a) -> IO a
withCVector (Vector3 xx yy zz) f = do
let x_ = realToFrac xx
let y_ = realToFrac yy
let z_ = realToFrac zz
f x_ y_ z_
fromCVector :: CFloat -> CFloat -> CFloat -> Vector3
fromCVector x_ y_ z_ = Vector3 (realToFrac x_) (realToFrac y_) (realToFrac z_)
raySceneQuerySimple :: Vector3
-> Vector3
-> IO (Maybe Vector3)
raySceneQuerySimple orig dir =
alloca $ \resx -> do
alloca $ \resy -> do
alloca $ \resz -> do
withCVector orig $ \ox oy oz -> do
withCVector dir $ \dx dy dz -> do
found <- c_ray_scene_query_simple ox oy oz dx dy dz resx resy resz
if found == 0
then return Nothing
else do
xx <- peek resx
yy <- peek resy
zz <- peek resz
return (Just (fromCVector xx yy zz))
raySceneQueryMouseSimple :: Float
-> Float
-> IO (Maybe Vector3)
raySceneQueryMouseSimple xpos ypos =
alloca $ \resx -> do
alloca $ \resy -> do
alloca $ \resz -> do
found <- c_ray_scene_query_mouse_simple (realToFrac xpos) (realToFrac ypos) resx resy resz
if found == 0
then return Nothing
else do
xx <- peek resx
yy <- peek resy
zz <- peek resz
return (Just (fromCVector xx yy zz))
renderOgre :: IO ()
renderOgre = c_render
cleanupOgre :: IO ()
cleanupOgre = c_cleanup