aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoshua Rahm <jrahm@Scipio.(none)>2014-04-19 03:59:39 -0600
committerJoshua Rahm <jrahm@Scipio.(none)>2014-04-19 03:59:39 -0600
commita2224be33baae7ae07473e74fe94414cdb8f41d2 (patch)
tree2842a2e20c99acb4f24c4ad3bc287ade5ff09027
parente380f8f31246afc2a14eccc51d40aa78dbd12cb1 (diff)
downloadterralloc-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.hs1
-rw-r--r--Resources.hs55
-rw-r--r--maps/spain_terrain.pngbin4870 -> 4464 bytes
-rw-r--r--maps/svalbard_height.pngbin0 -> 2908 bytes
-rw-r--r--maps/svalbard_terrain.pngbin0 -> 1862 bytes
5 files changed, 34 insertions, 22 deletions
diff --git a/Final.hs b/Final.hs
index facc916..edea8ff 100644
--- a/Final.hs
+++ b/Final.hs
@@ -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
index 22b1165..1983d16 100644
--- a/maps/spain_terrain.png
+++ b/maps/spain_terrain.png
Binary files differ
diff --git a/maps/svalbard_height.png b/maps/svalbard_height.png
new file mode 100644
index 0000000..7670da1
--- /dev/null
+++ b/maps/svalbard_height.png
Binary files differ
diff --git a/maps/svalbard_terrain.png b/maps/svalbard_terrain.png
new file mode 100644
index 0000000..5afd0b4
--- /dev/null
+++ b/maps/svalbard_terrain.png
Binary files differ