diff options
author | Joshua Rahm <jrahm@Scipio.(none)> | 2014-04-19 03:59:39 -0600 |
---|---|---|
committer | Joshua Rahm <jrahm@Scipio.(none)> | 2014-04-19 03:59:39 -0600 |
commit | a2224be33baae7ae07473e74fe94414cdb8f41d2 (patch) | |
tree | 2842a2e20c99acb4f24c4ad3bc287ade5ff09027 | |
parent | e380f8f31246afc2a14eccc51d40aa78dbd12cb1 (diff) | |
download | terralloc-a2224be33baae7ae07473e74fe94414cdb8f41d2.tar.gz terralloc-a2224be33baae7ae07473e74fe94414cdb8f41d2.tar.bz2 terralloc-a2224be33baae7ae07473e74fe94414cdb8f41d2.zip |
fixed cpu hemorraging when there are no trees. Added svalbard map.
-rw-r--r-- | Final.hs | 1 | ||||
-rw-r--r-- | Resources.hs | 55 | ||||
-rw-r--r-- | maps/spain_terrain.png | bin | 4870 -> 4464 bytes | |||
-rw-r--r-- | maps/svalbard_height.png | bin | 0 -> 2908 bytes | |||
-rw-r--r-- | maps/svalbard_terrain.png | bin | 0 -> 1862 bytes |
5 files changed, 34 insertions, 22 deletions
@@ -288,6 +288,7 @@ main = do let !forestLocations = runMonadPlusBuilder $ createLocations arr stgen 7 Forest let !jungleLocations = runMonadPlusBuilder $ createLocations arr stgen2 2 Jungle + putStrLn $ "Jungle locations: " ++! jungleLocations water <- getWaterQuads arr coloredArr -- putStrLn $ "ForestLocations :" ++! forestLocations makeResources surface (createBuilder arr) forestLocations jungleLocations water diff --git a/Resources.hs b/Resources.hs index f06d8fa..68b622f 100644 --- a/Resources.hs +++ b/Resources.hs @@ -62,8 +62,8 @@ data Resources = Resources { mvMatrix :: Mat4 GLfloat, object :: GlyphObject (), - forest :: GlyphObject (), - jungle :: GlyphObject (), + forest :: Maybe (GlyphObject ()), + jungle :: Maybe (GlyphObject ()), waterObj :: GlyphObject (), speed :: Int, @@ -122,11 +122,17 @@ eventHandle event res = do KeyUp (Keysym SDLK_s _ _) -> return $ setSpeed (speed res + 1) res + KeyUp (Keysym SDLK_g _ _) -> do + SDL.showCursor False + SDL.grabInput True + return res KeyUp (Keysym SDLK_f _ _) -> do ret <- reshape 1920 1080 res SDL.toggleFullscreen $ rSurface ret SDL.showCursor False + SDL.grabInput True return ret + _ -> return res displayHandle :: Resources -> IO Resources @@ -176,25 +182,28 @@ displayHandle resources = do blend $= Enabled cullFace $= Just Back blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha) - draw $ prepare (forest resources) $ \_ -> do - uniform (UniformLocation 5) $= l_mvMatrix - uniform (UniformLocation 4) $= pMatrix resources - uniform (UniformLocation 7) $= l_mvMatrix `glslMatMul` lightPos - uniform (UniformLocation 8) $= Index1 (fromIntegral $ time resources::GLfloat) - uniform (UniformLocation 9) $= normalMatrix - - uniform (UniformLocation 10) $= Vec4 (r,g,b,a::GLfloat) - return () - draw $ prepare (jungle resources) $ \_ -> do - uniform (UniformLocation 5) $= l_mvMatrix - uniform (UniformLocation 4) $= pMatrix resources - uniform (UniformLocation 7) $= l_mvMatrix `glslMatMul` lightPos - uniform (UniformLocation 8) $= Index1 (fromIntegral $ time resources::GLfloat) - uniform (UniformLocation 9) $= normalMatrix - - uniform (UniformLocation 10) $= Vec4 (r,g,b,a::GLfloat) - return () + when (isJust $ forest resources) $ + draw $ prepare (fromJust $ forest resources) $ \_ -> do + uniform (UniformLocation 5) $= l_mvMatrix + uniform (UniformLocation 4) $= pMatrix resources + uniform (UniformLocation 7) $= l_mvMatrix `glslMatMul` lightPos + uniform (UniformLocation 8) $= Index1 (fromIntegral $ time resources::GLfloat) + uniform (UniformLocation 9) $= normalMatrix + + uniform (UniformLocation 10) $= Vec4 (r,g,b,a::GLfloat) + return () + + when (isJust $ jungle resources) $ do + draw $ prepare (fromJust $ jungle resources) $ \_ -> do + uniform (UniformLocation 5) $= l_mvMatrix + uniform (UniformLocation 4) $= pMatrix resources + uniform (UniformLocation 7) $= l_mvMatrix `glslMatMul` lightPos + uniform (UniformLocation 8) $= Index1 (fromIntegral $ time resources::GLfloat) + uniform (UniformLocation 9) $= normalMatrix + + uniform (UniformLocation 10) $= Vec4 (r,g,b,a::GLfloat) + return () cullFace $= Nothing draw $ prepare (waterObj resources) $ \_ -> do @@ -269,8 +278,10 @@ buildTerrainObject builder = do uniform dYlocation $= Index1 (dy::GLfloat) printErrors "terrainObjectClosure" -buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (GlyphObject ()) -buildForestObject seq obj tex = do +buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (Maybe (GlyphObject ())) +buildForestObject seq obj tex = + if Seq.null seq then return Nothing else liftM Just $ + do let bufferIO :: IO BufferObject bufferIO = (newArray . Fold.toList) seq >>= ptrToBuffer ArrayBuffer (Seq.length seq * 4) diff --git a/maps/spain_terrain.png b/maps/spain_terrain.png Binary files differindex 22b1165..1983d16 100644 --- a/maps/spain_terrain.png +++ b/maps/spain_terrain.png diff --git a/maps/svalbard_height.png b/maps/svalbard_height.png Binary files differnew file mode 100644 index 0000000..7670da1 --- /dev/null +++ b/maps/svalbard_height.png diff --git a/maps/svalbard_terrain.png b/maps/svalbard_terrain.png Binary files differnew file mode 100644 index 0000000..5afd0b4 --- /dev/null +++ b/maps/svalbard_terrain.png |