diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2009 Antti Salonen + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. + diff --git a/Media/Example.material b/Media/Example.material new file mode 100644 --- /dev/null +++ b/Media/Example.material @@ -0,0 +1,122 @@ + +material Examples/CloudyNoonSkyBox +{ + technique + { + pass + { + lighting off + depth_write off + + texture_unit + { + cubic_texture cloudy_noon.jpg separateUV + tex_address_mode clamp + } + } + } +} + +material Examples/StormySkyBox +{ + technique + { + pass + { + lighting off + depth_write off + + texture_unit + { + cubic_texture stormy.jpg separateUV + tex_address_mode clamp + } + } + } +} + +material Examples/EveningSkyBox +{ + technique + { + pass + { + lighting off + depth_write off + + texture_unit + { + cubic_texture evening.jpg separateUV + tex_address_mode clamp + } + } + } +} + +material Examples/CloudySky +{ + technique + { + pass + { + lighting off + depth_write off + + texture_unit + { + texture clouds.jpg + scroll_anim 0.15 0 + } + } + } +} + +material Examples/Robot +{ + // Hardware skinning techniique + technique + { + pass + { +/* + vertex_program_ref Ogre/HardwareSkinningOneWeight + { + param_named_auto worldMatrix3x4Array world_matrix_array_3x4 + param_named_auto viewProjectionMatrix viewproj_matrix + param_named_auto lightPos[0] light_position 0 + param_named_auto lightPos[1] light_position 1 + param_named_auto lightDiffuseColour[0] light_diffuse_colour 0 + param_named_auto lightDiffuseColour[1] light_diffuse_colour 1 + param_named_auto ambient ambient_light_colour + + } + // alternate shadow caster program + shadow_caster_vertex_program_ref Ogre/HardwareSkinningOneWeightShadowCaster + { + param_named_auto worldMatrix3x4Array world_matrix_array_3x4 + param_named_auto viewProjectionMatrix viewproj_matrix + param_named_auto ambient ambient_light_colour + + } +*/ + texture_unit + { + texture r2skin.jpg + } + } + } + + // Software blending technique + technique + { + pass + { + + texture_unit + { + texture r2skin.jpg + } + } + } +} + diff --git a/Media/HornetUV_Cylinder.tga b/Media/HornetUV_Cylinder.tga new file mode 100644 Binary files /dev/null and b/Media/HornetUV_Cylinder.tga differ diff --git a/Media/IMG_0436.JPG b/Media/IMG_0436.JPG new file mode 100644 Binary files /dev/null and b/Media/IMG_0436.JPG differ diff --git a/Media/TailWings.JPG b/Media/TailWings.JPG new file mode 100644 Binary files /dev/null and b/Media/TailWings.JPG differ diff --git a/Media/WingFlap.jpg b/Media/WingFlap.jpg new file mode 100644 Binary files /dev/null and b/Media/WingFlap.jpg differ diff --git a/Media/WingFlapBump.jpg b/Media/WingFlapBump.jpg new file mode 100644 Binary files /dev/null and b/Media/WingFlapBump.jpg differ diff --git a/Media/Wings.jpg b/Media/Wings.jpg new file mode 100644 Binary files /dev/null and b/Media/Wings.jpg differ diff --git a/Media/WingsBump.jpg b/Media/WingsBump.jpg new file mode 100644 Binary files /dev/null and b/Media/WingsBump.jpg differ diff --git a/Media/blackhawk.material b/Media/blackhawk.material new file mode 100644 --- /dev/null +++ b/Media/blackhawk.material @@ -0,0 +1,37 @@ +material Windows +{ + receive_shadows on + technique + { + pass + { + ambient 0.500000 0.500000 0.500000 0.168000 + diffuse 0.640000 0.640000 0.711253 0.168000 + specular 0.490442 0.490442 0.490442 0.168000 4.000000 + emissive 0.000000 0.000000 0.000000 0.168000 + scene_blend alpha_blend + depth_write off + } + } +} +material HelicopterBody +{ + receive_shadows on + technique + { + pass + { + // ambient 0.300000 0.300000 0.000000 1.000000 + // diffuse 0.786168 0.795673 0.786204 1.000000 + // specular 0.630000 0.630000 0.630000 1.000000 12.500000 + // emissive 0.000000 0.000000 0.000000 1.000000 + texture_unit + { + texture lava.tga + // tex_address_mode wrap + // filtering trilinear + // colour_op alpha_blend + } + } + } +} diff --git a/Media/clouds.jpg b/Media/clouds.jpg new file mode 100644 Binary files /dev/null and b/Media/clouds.jpg differ diff --git a/Media/lagoon.tga b/Media/lagoon.tga new file mode 100644 Binary files /dev/null and b/Media/lagoon.tga differ diff --git a/Media/lava.tga b/Media/lava.tga new file mode 100644 Binary files /dev/null and b/Media/lava.tga differ diff --git a/Media/mix.tga b/Media/mix.tga new file mode 100644 Binary files /dev/null and b/Media/mix.tga differ diff --git a/Media/terrain.cfg b/Media/terrain.cfg new file mode 100644 --- /dev/null +++ b/Media/terrain.cfg @@ -0,0 +1,71 @@ +# The main world texture (if you wish the terrain manager to create a material for you) +WorldTexture=terrain_texture.jpg + +# The detail texture (if you wish the terrain manager to create a material for you) +DetailTexture=terrain_detail.jpg + +#number of times the detail texture will tile in a terrain tile +DetailTile=3 + +# Heightmap source +PageSource=Heightmap + +# Heightmap-source specific settings +Heightmap.image=terrain.png + +# If you use RAW, fill in the below too +# RAW-specific setting - size (horizontal/vertical) +#Heightmap.raw.size=513 +# RAW-specific setting - bytes per pixel (1 = 8bit, 2=16bit) +#Heightmap.raw.bpp=2 + +# How large is a page of tiles (in vertices)? Must be (2^n)+1 +PageSize=513 + +# How large is each tile? Must be (2^n)+1 and be smaller than PageSize +TileSize=65 + +# The maximum error allowed when determining which LOD to use +MaxPixelError=3 + +# The size of a terrain page, in world units +PageWorldX=1500 +PageWorldZ=1500 +# Maximum height of the terrain +MaxHeight=100 + +# Upper LOD limit +MaxMipMapLevel=5 + +#VertexNormals=yes +#VertexColors=yes +#UseTriStrips=yes + +# Use vertex program to morph LODs, if available +VertexProgramMorph=yes + +# The proportional distance range at which the LOD morph starts to take effect +# This is as a proportion of the distance between the current LODs effective range, +# and the effective range of the next lower LOD +LODMorphStart=0.2 + +# This following section is for if you want to provide your own terrain shading routine +# Note that since you define your textures within the material this makes the +# WorldTexture and DetailTexture settings redundant + +# The name of the vertex program parameter you wish to bind the morph LOD factor to +# this is 0 when there is no adjustment (highest) to 1 when the morph takes it completely +# to the same position as the next lower LOD +# USE THIS IF YOU USE HIGH-LEVEL VERTEX PROGRAMS WITH LOD MORPHING +#MorphLODFactorParamName=morphFactor + +# The index of the vertex program parameter you wish to bind the morph LOD factor to +# this is 0 when there is no adjustment (highest) to 1 when the morph takes it completely +# to the same position as the next lower LOD +# USE THIS IF YOU USE ASSEMBLER VERTEX PROGRAMS WITH LOD MORPHING +#MorphLODFactorParamIndex=4 + +# The name of the material you will define to shade the terrain +#CustomMaterialName=TestTerrainMaterial + + diff --git a/Media/terrain.png b/Media/terrain.png new file mode 100644 Binary files /dev/null and b/Media/terrain.png differ diff --git a/Media/terrain_detail.jpg b/Media/terrain_detail.jpg new file mode 100644 Binary files /dev/null and b/Media/terrain_detail.jpg differ diff --git a/Media/terrain_texture.jpg b/Media/terrain_texture.jpg new file mode 100644 Binary files /dev/null and b/Media/terrain_texture.jpg differ diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ +Models available at http://www.blendermodels.org/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/hogre-examples.cabal b/hogre-examples.cabal new file mode 100644 --- /dev/null +++ b/hogre-examples.cabal @@ -0,0 +1,66 @@ +Name: hogre-examples +Version: 0.0.1 +Cabal-Version: >= 1.6 +License: OtherLicense +License-File: LICENSE +Author: Antti Salonen +Maintainer: Antti Salonen +Copyright: Antti Salonen 2009 +Stability: Unstable +Category: Graphics +Synopsis: Examples for using Hogre. +Description: Examples for using Hogre, Haskell bindings to OGRE + (Object-Oriented Graphics Rendering Engine) + (). + example_01 creates a simple scene with a moving entity. + example_02 demonstrates use of SDL for input and window + creation. + example_03 demonstrates ray scene queries and loading + a world configuration from a file. +Build-type: Simple +extra-source-files: src/Common.hs, + resources.cfg, plugins.cfg, README, + Media/blackhawk.material, + Media/clouds.jpg, + Media/Example.material, + Media/HornetUV_Cylinder.tga, + Media/IMG_0436.JPG, + Media/lagoon.tga, + Media/lava.tga, + Media/mix.tga, + Media/TailWings.JPG, + Media/terrain.cfg, + Media/terrain_detail.jpg, + Media/terrain.png, + Media/terrain_texture.jpg, + Media/WingFlapBump.jpg, + Media/WingFlap.jpg, + Media/WingsBump.jpg, + Media/Wings.jpg + +source-repository head + type: git + location: http://github.com/anttisalonen/hogre-examples + +Executable example_01 + Build-Depends: base >= 3 && < 5, haskell98, hogre>=0.0.1 + Main-is: Example_01.hs + Hs-Source-Dirs: src + Ghc-options: -Wall + extra-libraries: CEGUIOgreRenderer, OgreMain, CEGUIBase + +Executable example_02 + Build-Depends: base >= 3 && < 5, haskell98, hogre>=0.0.1, SDL>=0.4.0 + Main-is: Example_02.hs + Hs-Source-Dirs: src + Ghc-options: -Wall + extra-libraries: CEGUIOgreRenderer, OgreMain, CEGUIBase + +Executable example_03 + Build-Depends: base >= 3 && < 5, haskell98, hogre>=0.0.1, SDL>=0.4.0, + stm>=2.1.1.2 + Main-is: Example_03.hs + Hs-Source-Dirs: src + Ghc-options: -Wall + extra-libraries: CEGUIOgreRenderer, OgreMain, CEGUIBase + diff --git a/plugins.cfg b/plugins.cfg new file mode 100644 --- /dev/null +++ b/plugins.cfg @@ -0,0 +1,12 @@ +# Defines plugins to load + +# Define plugin folder +PluginFolder=/usr/lib/OGRE + +# Define D3D rendering implementation plugin +Plugin=RenderSystem_GL.so +Plugin=Plugin_ParticleFX.so +Plugin=Plugin_BSPSceneManager.so +Plugin=Plugin_OctreeSceneManager.so +Plugin=Plugin_CgProgramManager.so + diff --git a/resources.cfg b/resources.cfg new file mode 100644 --- /dev/null +++ b/resources.cfg @@ -0,0 +1,3 @@ +# Resource locations to be added to the default path +[General] +FileSystem=./Media diff --git a/src/Common.hs b/src/Common.hs new file mode 100644 --- /dev/null +++ b/src/Common.hs @@ -0,0 +1,115 @@ +module Common(runWithSDL, FrameCallback(..), EventCallback(..)) +where + +import System.IO +import Control.Concurrent +import Control.Concurrent.STM + +import qualified Graphics.UI.SDL as SDL + +import Graphics.Ogre.Ogre + +data FrameCallback a = FrameCallback { framecallback :: (a -> IO a) } +data EventCallback a = EventCallback { eventcallback :: (a -> [SDL.Event] -> IO a) } + +pollAllSDLEvents :: IO [SDL.Event] +pollAllSDLEvents = go [] + where go l = do + e <- SDL.pollEvent + if e == SDL.NoEvent + then return l + else do + es <- pollAllSDLEvents + return (e:es) + +type Action = (Bool, -- right mouse button pressed + (Float, Float), -- rotation (yaw, pitch) + (Float, Float, Float), -- translation (x, y, z) + Bool) -- quit flag + +eventToAction :: Action -> SDL.Event -> Action +eventToAction (bt, ro, t, _) SDL.Quit = (bt, ro, t, True) +eventToAction (bt, ro, t, _) (SDL.KeyDown (SDL.Keysym SDL.SDLK_ESCAPE _ _)) = (bt, ro, t, True) +eventToAction (bt, ro, t, _) (SDL.KeyDown (SDL.Keysym SDL.SDLK_q _ _)) = (bt, ro, t, True) +eventToAction (bt, ro, t@(x_, y_, z_), q) (SDL.KeyDown (SDL.Keysym k _ _)) = case k of + SDL.SDLK_UP -> (bt, ro, (x_, y_, z_ - 1.0), q) + SDL.SDLK_DOWN -> (bt, ro, (x_, y_, z_ + 1.0), q) + SDL.SDLK_RIGHT -> (bt, ro, (x_ + 1.0, y_, z_), q) + SDL.SDLK_LEFT -> (bt, ro, (x_ - 1.0, y_, z_), q) + SDL.SDLK_PAGEDOWN -> (bt, ro, (x_, y_ - 1.0, z_), q) + SDL.SDLK_PAGEUP -> (bt, ro, (x_, y_ + 1.0, z_), q) + _ -> (bt, ro, t, q) +eventToAction (bt, ro, t@(x_, y_, z_), q) (SDL.KeyUp (SDL.Keysym k _ _)) = case k of + SDL.SDLK_UP -> (bt, ro, (x_, y_, z_ + 1.0), q) + SDL.SDLK_DOWN -> (bt, ro, (x_, y_, z_ - 1.0), q) + SDL.SDLK_RIGHT -> (bt, ro, (x_ - 1.0, y_, z_), q) + SDL.SDLK_LEFT -> (bt, ro, (x_ + 1.0, y_, z_), q) + SDL.SDLK_PAGEDOWN -> (bt, ro, (x_, y_ + 1.0, z_), q) + SDL.SDLK_PAGEUP -> (bt, ro, (x_, y_ - 1.0, z_), q) + _ -> (bt, ro, t, q) +eventToAction (False, ro, t, q) (SDL.MouseMotion _ _ _ _) = (False, ro, t, q) +eventToAction (True, (ya, pit), t, q) (SDL.MouseMotion _ _ abs_x abs_y) = (True, (ya - (0.005 * fromIntegral abs_x), pit - (0.005 * fromIntegral abs_y)), t, q) +eventToAction (_, ro, t, q) (SDL.MouseButtonUp _ _ SDL.ButtonRight) = (False, ro, t, q) +eventToAction (_, ro, t, q) (SDL.MouseButtonDown _ _ SDL.ButtonRight) = (True, ro, t, q) +eventToAction (bt, ro, t, q) _ = (bt, ro, t, q) + +resetRotation :: Action -> Action +resetRotation (bt, _, t, q) = (bt, (0, 0), t, q) + +doAction :: (Float, Float) -> (Float, Float, Float) -> IO () +doAction (ya, pit) (x_, y_, z_) = do + rotateCamera (YPR ya 0 0) World + rotateCamera (YPR 0 pit 0) Local + translateCamera (Vector3 x_ y_ z_) + +shutdown :: IO () +shutdown = do + putStrLn "Shutting down..." + cleanupOgre + +runWithSDL :: IO () -> (a, EventCallback a, FrameCallback a) -> IO () +runWithSDL initGame action = SDL.withInit [SDL.InitEverything] $ runThreadedNonblocking initGame action 20 20 >> return () + +nullAction :: Action +nullAction = (False, (0, 0), (0, 0, 0), False) + +runThreadedNonblocking :: IO () -> (a, EventCallback a, FrameCallback a) -> Int -> Int -> IO () +runThreadedNonblocking initGame (ival, ecb, fcb) renderinterval handleinterval = do + initGame + let ri = renderinterval * 1000 + let si = handleinterval * 1000 + box <- atomically $ newTMVar ival + rtid <- forkIO (renderLoop box fcb ri) + inputLoop si box ecb [rtid] nullAction + +renderLoop :: TMVar a -> FrameCallback a -> Int -> IO () +renderLoop box action ri = do + renderOgre + val <- atomically $ takeTMVar box + nval <- (framecallback action) val + atomically $ putTMVar box nval + threadDelay ri + renderLoop box action ri + +fullCleanup :: [ThreadId] -> IO () -> IO () +fullCleanup tids cf = mapM_ killThread tids >> cf + +inputLoop :: Int -> TMVar a -> EventCallback a -> [ThreadId] -> Action -> IO () +inputLoop si box action tids ac = do + i <- input ac box action + case i of + Nothing -> fullCleanup tids shutdown + Just nac -> threadDelay si >> inputLoop si box action tids (resetRotation nac) + +input :: Action -> TMVar a -> EventCallback a -> IO (Maybe Action) +input ac box action = do + events <- pollAllSDLEvents + -- when (not (null events)) (print events >> (getCameraPosition >>= print)) + let nac@(_, ro, t, q) = foldl eventToAction ac events + if q then return Nothing else do + val <- atomically $ takeTMVar box + nval <- (eventcallback action) val events + atomically $ putTMVar box nval + doAction ro t + return (Just nac) + diff --git a/src/Example_01.hs b/src/Example_01.hs new file mode 100644 --- /dev/null +++ b/src/Example_01.hs @@ -0,0 +1,48 @@ +module Main +where + +import Graphics.Ogre.Ogre +import Control.Exception +import Control.Concurrent (threadDelay) + +renderLoop :: Float -> IO () +renderLoop f = do + renderOgre + setEntityPosition "obj1" (ogreloc f) + setLightPosition "light2" (Vector3 30 20 50) + threadDelay 10000 + renderLoop (f + 0.008) + +ogreloc :: Float -> Vector3 +ogreloc f = Vector3 (30 + 20 * sin f) (8 + 2 * sin (0.2 * f)) (50 + 20 * cos f) + +plloc :: Float -> Vector3 +plloc f = Vector3 (30 + 40 * sin (4.0 * f)) 20 (50 + 40 * cos (4.0 * f)) + +main :: IO () +main = do + let set = OgreSettings "resources.cfg" True "Hogre Example 01" (Color 0.2 0.2 0.2) StencilAdditive [Generic] + let cam = Camera (Vector3 30.0 8.0 50.0) 0 (Vector3 135.0 40.0 50.0) + let yelcol = Color 1.0 1.0 0.0 + let dircol = Color 0.25 0.25 0 + let whitecol = Color 1 1 1 + let spotrange = (0.0, degToRad 80.0) + let l1 = Light "light1" yelcol yelcol (SpotLight (Vector3 30 50.0 50) (Vector3 0.0 (-1.0) 0.0) spotrange) + let l2 = Light "light2" whitecol whitecol (PointLight (plloc 0)) + let l3 = Light "light3" dircol dircol (DirectionalLight (Vector3 0 0 1)) + let plane = Plane unitY 0.0 70.0 100.0 20 20 5.0 5.0 unitZ "DarkBlue" + let pl = Entity "ground" (Vector3 35.0 0.0 50.0) plane False (Vector3 1.0 1.0 1.0) + let lig = [l1, l2, l3] + let ents = [pl] + let sce = OgreScene cam ents lig + initOgre set + addScene sce + addEntity (Entity "obj1" (ogreloc 0) (StdMesh "robot.mesh" (YPR 0 0 0)) True (Vector3 0.20 0.20 0.20)) + handle shutdown (renderLoop 0) + +shutdown :: (Show a) => a -> IO () +shutdown e = do + print e + putStrLn "Shutting down..." + cleanupOgre + diff --git a/src/Example_02.hs b/src/Example_02.hs new file mode 100644 --- /dev/null +++ b/src/Example_02.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FunctionalDependencies #-} +module Main +where + +import System.IO + +import qualified Graphics.UI.SDL as SDL + +import Graphics.Ogre.Ogre +import Common + +initGame :: IO () +initGame = do + let set = OgreSettings "resources.cfg" False "Hogre Example 02" (Color 0.2 0.2 0.2) StencilModulative [Generic] + let cam = Camera (Vector3 100.0 10.0 40) 0 (Vector3 101 10 40) + let lightdiffuse = Color 0.9 0.9 0.9 + let lightspecular = Color 0.8 0.8 0.8 + let spotrange = (0.0, degToRad 80.0) + let l1 = Light "light1" lightdiffuse lightspecular (SpotLight (Vector3 0 15.0 0) (Vector3 1.0 (-1.0) 1.0) spotrange) + let l2 = Light "light2" lightdiffuse lightspecular (SpotLight (Vector3 70 15.0 0) (Vector3 (-1.0) (-1.0) 1.0) spotrange) + let l3 = Light "light3" lightdiffuse lightspecular (SpotLight (Vector3 0 15.0 100) (Vector3 1.0 (-1.0) (-1.0)) spotrange) + let l4 = Light "light4" lightdiffuse lightspecular (SpotLight (Vector3 70 15.0 100) (Vector3 (-1.0) (-1.0) (-1.0)) spotrange) + let plane = Plane unitY 0.0 70.0 100.0 20 20 5.0 5.0 unitZ "HelicopterBody" + let pl = Entity "ground" (Vector3 35.0 0.0 50.0) plane False (Vector3 1.0 1.0 1.0) + let robotmesh = "robot.mesh" + let robotscale = Vector3 0.36 0.24 0.3 + let robot1 = Entity "robot1" (Vector3 35.0 3.0 4.2) (StdMesh robotmesh (YPR halfPI 0.0 0.0)) True robotscale + let robot2 = Entity "robot2" (Vector3 35.0 3.0 84.5) (StdMesh robotmesh (YPR halfPI 0.0 0.0)) True robotscale + let lig = [l1, l2, l3, l4] + let ents = [pl, robot1, robot2] + let sce = OgreScene cam ents lig + let (wid, hei) = (1024, 768) + _ <- SDL.setVideoMode wid hei 16 [SDL.OpenGL, SDL.HWAccel] + SDL.wasInit [SDL.InitEverything] >>= print + initOgre set + addScene sce + addEntity (Entity "obj1" (Vector3 5.0 20.0 10.0) (StdMesh robotmesh (YPR 0.0 0.0 0.0)) True (Vector3 0.2 0.2 0.2)) + +main :: IO () +main = runWithSDL initGame ((), EventCallback (\_ _ -> return ()), FrameCallback (\_ -> return ())) + diff --git a/src/Example_03.hs b/src/Example_03.hs new file mode 100644 --- /dev/null +++ b/src/Example_03.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FunctionalDependencies #-} +module Main +where + +import Data.Maybe +import System.IO +import Control.Monad (when) + +import qualified Graphics.UI.SDL as SDL + +import Graphics.Ogre.Ogre +import Common + +robotTemplate :: String -> Vector3 -> Entity +robotTemplate swname pos = Entity swname pos (StdMesh "robot.mesh" (YPR halfPI 0.0 0.0)) True (Vector3 0.2 0.2 0.2) + +initGame :: IO () +initGame = do + let set = OgreSettings "resources.cfg" False "Hogre Example 03" (Color 0.9 0.9 0.9) StencilModulative [ExteriorClose] + let cam = Camera (Vector3 242.0 120.0 580) 0 (Vector3 241 120 580) + let (wid, hei) = (1024, 768) + let sce = OgreScene cam [] [] + _ <- SDL.setVideoMode wid hei 16 [SDL.OpenGL, SDL.HWAccel] + SDL.wasInit [SDL.InitEverything] >>= print + initOgre set + addScene sce + setSkyDome (Just ("Examples/CloudySky", 5)) + setWorldGeometry "terrain.cfg" + +main :: IO () +main = runWithSDL initGame (0, EventCallback query, FrameCallback (\v -> return v)) + +getLMB :: IO (Maybe (Int, Int)) +getLMB = do + (xpos, ypos, btns) <- SDL.getMouseState + return $ case SDL.ButtonLeft `elem` btns of + True -> Just (xpos, ypos) + False -> Nothing + +getLMBPressed :: [SDL.Event] -> Maybe (Int, Int) +getLMBPressed [] = Nothing +getLMBPressed (e:es) = case e of + (SDL.MouseButtonDown xp yp SDL.ButtonLeft) -> Just ((fromIntegral xp), (fromIntegral yp)) + _ -> getLMBPressed es + +query :: Int -> [SDL.Event] -> IO Int +query counter events = do + cameraAboveGround + putObject counter events + +cameraAboveGround :: IO () +cameraAboveGround = do + (Vector3 camx camy camz) <- getCameraPosition + mres <- raySceneQuerySimple (Vector3 camx 5000 camz) negUnitY + case mres of + Nothing -> return () + Just res -> when ((y res) + 10 > camy) $ setCameraPosition (Vector3 camx ((y res) + 10) camz) + +putObject :: Int -> [SDL.Event] -> IO Int +putObject counter events = do + let mp = getLMBPressed events + case mp of + Nothing -> return counter + Just (xpos, ypos) -> do + scr <- SDL.getVideoSurface + let wid = SDL.surfaceGetWidth scr + let hei = SDL.surfaceGetHeight scr + print (xpos, ypos, wid, hei) + let wabs = (fromIntegral xpos) / (fromIntegral wid) + let habs = (fromIntegral ypos) / (fromIntegral hei) + pres <- raySceneQueryMouseSimple wabs habs + case pres of + Nothing -> return counter + Just (Vector3 resx resy resz) -> do + let swname = "robot" ++ (show counter) + let pos = Vector3 resx (resy + 10) resz + addEntity (robotTemplate swname pos) + print swname + return (counter + 1) +