diff options
| -rw-r--r-- | Final.hs | 14 | ||||
| -rw-r--r-- | Resources.hs | 6 | ||||
| -rw-r--r-- | package.yaml | 1 |
3 files changed, 11 insertions, 10 deletions
@@ -11,6 +11,7 @@ import SDL import Graphics.SDL.SDLHelp import Graphics.Glyph.Util import Control.Monad +import Control.Monad.Writer import Graphics.Glyph.BufferBuilder @@ -20,6 +21,7 @@ import Data.Array import Data.Array.IO import Data.Sequence as Seq +import Data.Sequence (Seq) import Prelude as P import Data.Bits @@ -269,14 +271,13 @@ createBuilder arr = do - A MonadPlusBuilder is a Monad used to build monad pluses; in this - case a Sequence. -} -createLocations :: Array (Int,Int) Tile -> StdGen -> Int -> TileType -> MonadPlusBuilder (Seq.Seq GLfloat) () +createLocations :: Array (Int,Int) Tile -> StdGen -> Int -> TileType -> Writer (Seq GLfloat) () createLocations arr gen density typ = do let (_,(w,h)) = bounds arr let getElev x y = if x >= w || y >= h || x < 0 || y < 0 then 0 else fromIntegral (elevation $ arr ! (x,y)) /10.0 {- Adds a random number of trees between 0 and density for the location -} - let run :: [Int] -> (Int,Int) -> MonadPlusBuilder ( Seq.Seq GLfloat ) [Int] - run rs (x',y') = do + let run rs (x',y') = do let (_:ntrees, t) = P.splitAt (head rs `mod` density + 1) rs when (isType x' y' typ) $ @@ -299,7 +300,7 @@ createLocations arr gen density typ = do {- Add to the sequence of elements. This - will be turned into a per-instance VAO -} - plusM $ Seq.fromList [ + tell $ Seq.fromList [ -- translation x,newh-0.2,y, -- scale @@ -316,7 +317,6 @@ createLocations arr gen density typ = do foldM_ run (randoms gen) [(x,y) | x <- [1..w], y <- [1..h]] - return () where isType x y t = tileType (arr ! (x,y)) == t f x = (fromIntegral x - 128) / 128 * (sqrt 2 / 2) toTup x = ( x .&. 0xFF , @@ -347,8 +347,8 @@ main = do {- Create the tree locations. Desity of 7 for the forest, 2 for the jungle - since the jungle model is bigger -} - let !forestLocations = runMonadPlusBuilder $ createLocations arr stgen 7 Forest - let !jungleLocations = runMonadPlusBuilder $ createLocations arr stgen2 2 Jungle + let !forestLocations = execWriter $ createLocations arr stgen 7 Forest + let !jungleLocations = execWriter $ createLocations arr stgen2 2 Jungle (mapping,water) <- getWaterQuads arr coloredArr coloredArr2 <- mapArray (\idx -> if idx == 0 then -1 else Map.findWithDefault (-1) idx mapping) coloredArr diff --git a/Resources.hs b/Resources.hs index d446796..ce38b21 100644 --- a/Resources.hs +++ b/Resources.hs @@ -746,13 +746,13 @@ makeResources window builder forestB jungleB water arr waterarr = do depthFunc $= Just Less), buildTerrainObject builder, (return $ \_-> do - blend $= Enabled + blend $= Disabled cullFace $= Just Back blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha)), buildWaterObject water, buildForestObject forestB "tree.obj" "textures/wood_low.png", - buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png", - buildSnowObject arr stdgen + buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png" + -- buildSnowObject arr stdgen -- cloudProgram ] Resources diff --git a/package.yaml b/package.yaml index e82ad36..1315c0a 100644 --- a/package.yaml +++ b/package.yaml @@ -27,4 +27,5 @@ dependencies: - StateVar - split - time + - mtl |