diff options
Diffstat (limited to 'Final.hs')
| -rw-r--r-- | Final.hs | 31 |
1 files changed, 16 insertions, 15 deletions
@@ -5,8 +5,8 @@ module Main where import Graphics.Rendering.OpenGL as GL -import Graphics.UI.SDL.Image as SDLImg -import Graphics.UI.SDL as SDL +import SDL.Image as SDLImg +import SDL import Graphics.SDL.SDLHelp import Graphics.Glyph.Util import Control.Monad @@ -27,6 +27,8 @@ import Resources import System.Random import System.Environment +import qualified SDL +import qualified SDL {- @@ -37,14 +39,12 @@ import System.Environment - w is the minimum width of the two images and h is the minimum - height. -} -buildArray :: SDL.Surface -> SDL.Surface -> Array (Int,Int) Tile -buildArray terrain height = +buildArray :: SDL.Surface -> SDL.Surface -> IO (Array (Int,Int) Tile) +buildArray terrain height = do + (V2 (fromIntegral -> w) (fromIntegral -> h)) <- SDL.surfaceDimensions terrain {- Pick the minimum width and height between the two images -} - let w = min (SDL.surfaceGetWidth terrain) $ SDL.surfaceGetWidth height - h = min (SDL.surfaceGetHeight terrain) $ SDL.surfaceGetHeight height - - {- Function that returns a Tile for an x y coordinate -} - conv (x,y) = + let {- Function that returns a Tile for an x y coordinate -} + conv x y = let terrainVal = fromIntegral $ getPixelUnsafe x y terrain {- The height is encoded as the sum of the color channels, to make life a litte - easier on the heightmap reader. -} @@ -62,8 +62,8 @@ buildArray terrain height = Tile terrainVal' heightVal {- build the list of Tiles to jam into the array -} - list = map conv [(x,y) | x <- [0..w-1], y <- [0..h-1]] - in listArray ((0,0),(w-1,h-1)) list + list = [conv x y | x <- [0..w-1], y <- [0..h-1]] + in return $ listArray ((0,0),(w-1,h-1)) list {- This function takes the array generated in the function from above and - creates a new array that colors in the array with locations of bodies @@ -202,7 +202,7 @@ printShowArray arr = do forM_ [0..h] $ \y -> do forM_ [0..w] $ \x -> do lNext <- readArray arr (x,y) - putStr $ show lNext + putStr $ show lNext ++ " " putStrLn "" {- The colors each tile type is mapped to @@ -332,10 +332,10 @@ main = do (m:_) -> doload m _ -> sequence [SDLImg.load "maps/wonderland_terrain.png", SDLImg.load "maps/wonderland_height.png"] - let arr = buildArray terrain height + arr <- buildArray terrain height coloredArr <- colorArray arr - surface <- simpleStartup "Terralloc" (1280,1024) + window <- simpleStartup "Terralloc" (1280,1024) stgen <- newStdGen stgen2 <- newStdGen @@ -347,7 +347,8 @@ main = do (mapping,water) <- getWaterQuads arr coloredArr coloredArr2 <- mapArray (\idx -> if idx == 0 then -1 else Map.findWithDefault (-1) idx mapping) coloredArr printShowArray coloredArr2 + printArray arr {- Kick off SDL with the callbacks defined in Resources -} - makeResources surface (createBuilder arr) forestLocations jungleLocations water arr coloredArr2 + makeResources window (createBuilder arr) forestLocations jungleLocations water arr coloredArr2 >>= startPipeline reshape eventHandle displayHandle updateHandle; |