added more documentation. No more floating trees. added tree color variation

6 files changed, 152 insertions, 136 deletions

diff --git a/Final.hs b/Final.hs
index 3756908..4fd50e0 100644
--- a/Final.hs
+++ b/Final.hs
@@ -147,7 +147,7 @@ getWaterQuads marr arr = do
                              (tileType tile == Water) ? 1000000000000 $ elevation tile
                         let elev = minimum $ map toelev (neighbors (x,y))
                         let newmap =
-                             Map.insertWith (zipWithT5 (P.$) . (zipWithT5 (P.$) tup))
+                             Map.insertWith (zipWithT5 (P.$) . zipWithT5 (P.$) tup)
                                 bodyID (elev,x,y,x,y) themap
                         return newmap
                 ) (Map.empty::Map.Map Int (Int,Int,Int,Int,Int)) [(x,y) | x <- [0..w], y <- [0..h]]
@@ -230,6 +230,8 @@ tileMap =
     Map.insert    (c 255 255 255) Beach  $
     Map.singleton (c 0 0 255) Water
 
+{- The function that generates the builder that will
+ - generate the VAO for the terrain based on the heightmap -}
 createBuilder :: Array (Int,Int) Tile -> BuilderM GLfloat ()
 createBuilder arr = do
     let (_,(w,h)) = bounds arr
@@ -247,46 +249,63 @@ createBuilder arr = do
     inferingNormals $
         forM_ (trianglesFromQuads lst) $ \(x,y,z,_) -> do
             let f = fromIntegral
+
+            {- Store the texture to use in the color -}
             let bUseTexture a = bColor4 (0,0,0,f a)
-            -- TODO un hardcode these
+
             bUseTexture $ fromEnum (tileType $ arr ! (x,z))
             bTexture2 (f x / 10.0, f z / 10.0)
             bVertex3 (f x, y,f z)
             
+{- Generates random locations for the trees inside of the terrain
+ - spots where trees may exist 
+ -
+ - 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 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 (_:he, t) = P.splitAt (head rs `mod` density + 1) rs
-            let signum' = floor.signum
+        run rs (x',y') = do
+            let (_:ntrees, t) = P.splitAt (head rs `mod` density + 1) rs
 
-            when (isType x y typ) $
-                forM_ he $ \rand ->
+            when (isType x' y' typ) $
+                {- Iterate and place n trees -}
+                forM_ ntrees $ \rand ->
                     let (a',b',c) = toTup rand
-                        (a,b) = (f a', f b')
-                        [sx,sy,sz,rot,noise] = (P.take 5 $ randomRs (0.0,1.0) $ mkStdGen c)
-
-                        elev = getElev x y
-                        elev_dx = getElev (x + signum' a) y
-                        elev_dy = getElev x (y + signum' b)
-                        realelev =
-                         ((elev * (1-abs a) + elev_dx * abs a) +
-                          (elev * (1-abs b) + elev_dy * abs b)) / 2.0 in
-
-                    when (elev_dx > 0 && elev_dy > 0) $
-                            plusM $ Seq.fromList [
+                        (x,y) = (int x' + f a', int y' + f b') :: (GLfloat,GLfloat)
+                        [sx,sy,sz,rot,noise,shade] = (P.take 6 $ randomRs (0.0,1.0) $ mkStdGen c)
+
+                        {- Boiler for finding the correct elevation between vertices -}
+                        h1 = getElev (floor x) (floor y)
+                        h2 = getElev (floor x) (floor (y+1))
+                        h3 = getElev (floor (x+1)) (floor y)
+                        h4 = getElev (floor (x+1)) (floor (y+1))
+                        u = fpart x
+                        v = fpart y
+                        mixu1 = mix h3 h1 u
+                        mixu2 = mix h4 h2 u
+                        newh = mix mixu2 mixu1 v in
+
+                        {- Add to the sequence of elements. This
+                         - will be turned into a per-instance VAO -}
+                        plusM $ Seq.fromList [
                                     -- translation
-                                    fromIntegral x+a,realelev,fromIntegral y+b,
+                                    x,newh-0.2,y,
                                     -- scale
                                     sx+0.5,sy+0.5,sz+0.5,
                                     -- rotation
                                     sin (rot*6.4), cos(rot*6.4),
                                     -- noise
-                                    noise*6.4
+                                    noise*6.4,
+                                    shade / 2 + 0.75
                                 ]
+
+            {- Return the tail of the randomly generated numbers -}
             return t
 
     foldM_ run (randoms gen) [(x,y) | x <- [1..w], y <- [1..h]]
@@ -305,34 +324,30 @@ main = do
          [ SDLImg.load $ "maps/"++str++"_terrain.png",
            SDLImg.load $ "maps/"++str++"_height.png" ]
     args <- getArgs
-    putStrLn "Loading..."
+
+    {- Load the terrain and heightmaps from SDL. -}
     [terrain,height] <- 
         case args of 
             (ter:hei:_) -> sequence [SDLImg.load ter, SDLImg.load hei]
             (m:_) -> doload m
             _ -> sequence [SDLImg.load "maps/wonderland_terrain.png", SDLImg.load "maps/wonderland_height.png"]
-    putStrLn "Done Loading ..."
 
     let arr = buildArray terrain height
-    putStrLn "Array Built"
-    printArray arr
     coloredArr <- colorArray arr
-    printShowArray coloredArr
 
-    surface <- simpleStartup "Spectical" (640,480)
+    surface <- simpleStartup "Terralloc" (1280,1024)
     stgen <- newStdGen
     stgen2 <- newStdGen
 
---    (log',file) <- loadObjFile "tree.obj"
---    mapM_ putStrLn log'
-
+    {- 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
 
-    putStrLn $ "Jungle locations: " ++! jungleLocations
     (mapping,water) <- getWaterQuads arr coloredArr
     coloredArr2 <- mapArray (\idx -> if idx == 0 then -1 else Map.findWithDefault (-1) idx mapping) coloredArr
     printShowArray coloredArr2
---  putStrLn $ "ForestLocations :" ++! forestLocations
+
+    {- Kick off SDL with the callbacks defined in Resources -}
     makeResources surface (createBuilder arr) forestLocations jungleLocations water arr coloredArr2
         >>= startPipeline reshape eventHandle displayHandle updateHandle;
diff --git a/Graphics/Glyph/Util.hs b/Graphics/Glyph/Util.hs
index 790b9f6..e8a5974 100644
--- a/Graphics/Glyph/Util.hs
+++ b/Graphics/Glyph/Util.hs
@@ -230,18 +230,18 @@ whileM bool routine' start' =
 untilM_ :: (Monad m) => (a -> Bool) -> m a -> m a
 untilM_ func routine = do
     start <- routine
-    case func start of
-        True -> untilM_ func routine
-        False -> return start
+    if' (func start)
+        (untilM_ func routine)
+        (return start)
 
 untilM :: (Monad m) => (a -> Bool) -> m a -> m [a]
 untilM func' routine' =
     untilM' func' routine' []
     where untilM' func routine lst = do
             start <- routine
-            case func start of
-                True -> untilM' func routine (lst ++ [start])
-                False -> return lst
+            if' (func start)
+                (untilM' func routine (lst ++ [start]))
+                (return lst)
 
 dFold :: [a] -> b -> (a -> a -> b -> b) -> b
 dFold (x1:x2:xs) next func = dFold (x2:xs) (func x1 x2 next) func
@@ -251,7 +251,7 @@ dFold _ next _ = next
 (!>>) a f = a `seq` f a
 
 (!>>=) :: Monad m => m a -> (a -> m b) -> m b
-(!>>=) a f = a !>> (flip (>>=) f)
+(!>>=) a f = a !>> flip (>>=) f
 
 {- Objective function composition. Useful to say
  - (drawArrays <..> numInstances) obj
@@ -263,13 +263,13 @@ toHex :: (Integral a,Show a) => a -> String
 toHex n | n == 0 = ""
         | otherwise = 
             let (quot',rem') = n `divMod` 16 in
-            toHex quot' ++ [(index' !! fromIntegral rem')]
+            toHex quot' ++ [index' !! fromIntegral rem']
         where index' = "0123456789ABCDEFGHIJKlMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
 
 average :: (Fold.Foldable a, Real c, Fractional b) => a c -> b
 average lst =
     let (sum',count) = Fold.foldl' (\(sum_,count_) x -> (sum_ + x, count_ + 1)) (0,0) lst in
-        (realToFrac sum') / count
+        realToFrac sum' / count
 
 maybeDefault :: a -> Maybe a -> a
 maybeDefault a b = fromJust $ b >||> Just a
@@ -287,7 +287,7 @@ runMonadPlusBuilder :: MonadPlusBuilder a b -> a
 runMonadPlusBuilder (MonadPlusBuilder !a _) = a
 
 instance (MonadPlus a) => Monad (MonadPlusBuilder (a b)) where
-    return x = MonadPlusBuilder mzero x
+    return = MonadPlusBuilder mzero
     MonadPlusBuilder a1 _ >> MonadPlusBuilder a2 b = MonadPlusBuilder (a1 `mplus` a2) b
     builder@(MonadPlusBuilder _ b) >>= f = builder >> f b
     fail = undefined
@@ -313,3 +313,10 @@ distribMaybe (Just (a,b)) = (Just a, Just b)
 
 whenM :: IO Bool -> IO () -> IO ()
 whenM b = (>>=) b . flip when
+
+mix :: (Floating a) => a -> a -> a -> a
+mix a b c = a * c + b * (1 - c)
+
+fpart :: (RealFrac a) => a -> a
+fpart x = x - (fromIntegral (floor x::Int))
+
diff --git a/Resources.hs b/Resources.hs
index d7fcaac..30d129b 100644
--- a/Resources.hs
+++ b/Resources.hs
@@ -12,7 +12,6 @@ import Foreign.Marshal.Array
 import Graphics.Glyph.GLMath as V
 import Graphics.Glyph.GlyphObject
 import Graphics.Glyph.ObjLoader
-import Graphics.Glyph.GeometryBuilder as GB
 import Graphics.Glyph.Shaders
 import Graphics.SDL.SDLHelp
 import Graphics.Glyph.BufferBuilder
@@ -28,46 +27,42 @@ import Control.Monad
 import Data.Angle
 import Data.Function
 import Data.Setters
-import Data.Word
-import qualified Data.Array.Storable as SA
 import qualified Data.Sequence as Seq
-import Data.Sequence ((><),(|>),(<|))
 import qualified Data.Foldable as Fold
 import Data.Maybe
 import Debug.Trace
 
-import Foreign.Marshal.Array
-import Foreign.Marshal.Alloc
-
 import System.Exit
-import System.FilePath
-import System.Random
 import qualified Data.Array.IO as ArrIO
 
-import Models
-import Debug.Trace
 import TileShow
 
 import Data.Array
 import qualified Data.StateVar as SV
 
+{- Types of terrain which are possible -}
 data TileType = Forest | Beach | Water | Grass | Jungle | Mountains | 
                 Tundra | Unknown deriving (Enum,Eq)
 $(makeShow ''TileType)
 
+{- A tile has 2 things, a type and
+ - elevation, however, the term tile is
+ - a litte misleading, it is really a point. -}
 data Tile = Tile {
     tileType :: TileType,
     elevation :: Int
 } deriving Show
 
+{- Position of the camera as described by
+ - polar coordinates -}
 data CameraPosition = CameraPosition {
     pEye :: Vec3 GLfloat,
     pTh :: GLfloat,
     pPh :: GLfloat
 } deriving Show
 
-data ObjectData = ObjectData Program
-
+{- The central data type for rendering
+ - the scene. Contains the 'global' information -}
 data Resources = Resources {
     rSurface :: SDL.Surface,
 
@@ -78,10 +73,6 @@ data Resources = Resources {
     mvMatrix :: Mat4 GLfloat,
 
     routines :: [ResourcesClosure -> IO ()],
-    -- object :: GlyphObject (),
-    -- forest :: GlyphObject (),
-    -- jungle :: GlyphObject (),
-    -- waterObj  :: GlyphObject (),
 
     speed :: GLfloat,
     timeSpeed :: Int,
@@ -94,6 +85,7 @@ data Resources = Resources {
     waterArray :: ArrIO.IOArray (Int,Int) GLfloat
 }
 
+{- Central data type for rendering each frame -}
 data ResourcesClosure = ResourcesClosure {
       rcMVMatrix :: Mat4 GLfloat
     , rcPMatrix  :: Mat4 GLfloat
@@ -108,10 +100,11 @@ data ResourcesClosure = ResourcesClosure {
 
 $(declareSetters ''Resources)
 
+{- A function that makes the resources data first
+ - person -}
 firstPerson :: Resources -> IO Resources
 firstPerson res =
     let (CameraPosition (Vec3 (x,curh,y)) th ph) = rPosition res
-        mix a b c = a * c + b * (1 - c)
         (_,(w,h)) = bounds $ heightMap res
         (!!!) arr (x',y') = if x' < 0 || y' < 0 || x' > w || y' > h then -1000 else elevation (arr ! (x',y'))
         h1 = ((/10.0).fromIntegral) (heightMap res !!! (floor x, floor y) )
@@ -125,33 +118,32 @@ firstPerson res =
         newh = mix mixu2 mixu1 v + 0.2
         droph = curh - dDown res
         in do
-    -- putStrLn $ "---------------"
-    -- putStrLn $ "(x,y)=" ++! (x,y)
-    -- putStrLn $ "(h1,h2,h3,h4)=" ++! (h1,h2,h3,h4)
-    -- putStrLn $ "(u,v)=" ++! (u,v) 
-    -- putStrLn $ "mixu1=" ++! mixu1 
-    -- putStrLn $ "mixu2=" ++! mixu2 
-    -- putStrLn $ "Newheight=" ++! newh
-    if newh+0.2 > droph then
-        return $ setRPosition (CameraPosition (Vec3 (x,newh,y)) th ph) $
-                 setDDown 0 $
-                    if speed res > speedFactor res then
-                        (setSpeed <..> speedFactor) res
-                        else res
-        else
-            return $ setRPosition (CameraPosition (Vec3 (x, droph, y)) th ph) $
-                     setDDown (dDown res + 0.05) res
-
+    return $ 
+        if (newh+0.2 > droph) then
+            setRPosition (CameraPosition (Vec3 (x,newh,y)) th ph) $
+                    setDDown 0 $
+                        if speed res > speedFactor res then
+                            (setSpeed <..> speedFactor) res
+                            else res
+            else
+                setRPosition (CameraPosition (Vec3 (x, droph, y)) th ph) $
+                        setDDown (dDown res + 0.05) res
+
+{- A function which will explode if a uniform
+ - does not exist for the shader given, otherwis,
+ - it will return a list of uniform locations -}
 getUniformsSafe :: Program -> [String] -> IO [UniformLocation]
 getUniformsSafe prog uniforms =
-    forM uniforms $ \uniform -> do
-        tmp <- get $ uniformLocation prog uniform
+    forM uniforms $ \a_uniform -> do
+        tmp <- get $ uniformLocation prog a_uniform
         case tmp of
             UniformLocation (-1) -> do
-                putStrLn $ "No uniform with name: "++uniform
+                putStrLn $ "No uniform with name: "++a_uniform
                 exitWith (ExitFailure 112)
             _ ->  return tmp
 
+{- Builds an model view matrix given the
+ - camera position of the scene -}
 buildMVMatrix :: CameraPosition -> Mat4 GLfloat
 buildMVMatrix (CameraPosition eye th ph) =
     let up = if ph' >= 90 && ph' < 270 then Vec3 (0,-1,0) else Vec3 (0,1,0)
@@ -159,6 +151,8 @@ buildMVMatrix (CameraPosition eye th ph) =
     let lookat = eye <+> (Vec3 $ toEuclidian (1,th,ph)) in
         lookAtMatrix eye lookat up
 
+{- Called after each frame to crunch throught the
+ - events -}
 eventHandle :: SDL.Event -> Resources -> IO Resources
 eventHandle event res = do
     let (CameraPosition eye th ph) = rDPosition res
@@ -234,14 +228,15 @@ eventHandle event res = do
 
         _ -> return res
 
+{- Callback for the display -}
 displayHandle :: Resources -> IO Resources
 displayHandle resources = do
-    let cameraPos@(CameraPosition r th ph) = rPosition resources
+    let cameraPos@(CameraPosition loc _ _) = rPosition resources
     let lighty = ((/10) . fromIntegral . time) resources
     let logist c =  (1 / (1 + 2.71828**(-c*x))) * 0.9 + 0.1
             where x = sine $ Degrees (lighty)
     let globalAmbient::(GLfloat,GLfloat,GLfloat,GLfloat)
-        globalAmbient@(r,g,b,a)= ( logist 2+0.1, logist 10, (logist 15) + 0.1,(sine.Degrees) lighty)
+        globalAmbient = ( logist 2+0.1, logist 10, (logist 15) + 0.1,(sine.Degrees) lighty)
     let lightPos = Vec4( 50,
                          1000000 * (sine.Degrees $ lighty),
                          -1000000 * (cosine.Degrees . (/10) . fromIntegral . time) resources,
@@ -262,7 +257,7 @@ displayHandle resources = do
                 (normalMatrix)
                 (Vec4 globalAmbient)
                 cameraPos
-                (Vec3 $ toEuclidian (r,th,ph))
+                loc
                 resources
 
                 in mapM_ (Prelude.$rc) $ routines resources
@@ -357,45 +352,39 @@ buildTerrainObject builder = do
                 uniform fogU $= Index1 (0.9::GLfloat) else
                 uniform fogU $= Index1 (0.0::GLfloat)
 
-cloudProgram :: IO (ResourcesClosure -> IO ())
-cloudProgram = do
-    let randarray ptr n stgen =
-            if n == 0 then return () else do
-                let (tmp,stgen') = next stgen
-                putStrLn $ "TMP: " ++! (tmp `mod` 256)
-                poke ptr (fromIntegral $ tmp `mod` 256)
-                randarray (advancePtr ptr 1) (n - 1) stgen'
-    let builder =
-            forM_ simpleCube $ \(x,y,z) -> do
-                bColor4 (x,y,z,0)
-                bVertex3 (x,y+20,z)
-    program <- loadProgramSafe' "shaders/clouds.vert" "shaders/clouds.frag" noShader
-
-    stgen <- newStdGen
-    array3D <- SA.newListArray ((0,0,0,0),(3,64,64,64)) (map (fromIntegral . (`mod`256)) $ (randoms stgen::[Int]))
-
-    SA.withStorableArray array3D $ \ptr3D -> do
-        density <- makeTexture3D >>= textureFromPointer3D ptr3D (64,64,64)
-
-        obj' <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
-                    currentProgram $= Just program
-        [mvMatU, pMatU, densityU, globalAmbientU,lightposU] <- mapM (get . uniformLocation program)
-            ["mvMatrix","pMatrix","density","globalAmbient","lightpos"]
-        return $ \rc -> do
-            draw $ prepare obj' $ \_ -> do
-                cullFace $= Nothing
-                uniform mvMatU $= rcMVMatrix rc
-                uniform pMatU $= rcPMatrix rc
-                uniform globalAmbientU $= rcGlobalAmbient rc
-                uniform lightposU $= rcLightPos rc
-                setupTexturing3D density densityU 0
+-- cloudProgram :: IO (ResourcesClosure -> IO ())
+-- cloudProgram = do
+--     let builder =
+--             forM_ simpleCube $ \(x,y,z) -> do
+--                 bColor4 (x,y,z,0)
+--                 bVertex3 (x,y+20,z)
+--     program <- loadProgramSafe' "shaders/clouds.vert" "shaders/clouds.frag" noShader
+-- 
+--     stgen <- newStdGen
+--     array3D <- SA.newListArray ((0,0,0,0),(3,64,64,64)) (map (fromIntegral . (`mod`256)) $ (randoms stgen::[Int]))
+-- 
+--     SA.withStorableArray array3D $ \ptr3D -> do
+--         density <- makeTexture3D >>= textureFromPointer3D ptr3D (64,64,64)
+-- 
+--         obj' <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
+--                     currentProgram $= Just program
+--         [mvMatU, pMatU, densityU, globalAmbientU,lightposU] <- mapM (get . uniformLocation program)
+--             ["mvMatrix","pMatrix","density","globalAmbient","lightpos"]
+--         return $ \rc -> do
+--             draw $ prepare obj' $ \_ -> do
+--                 cullFace $= Nothing
+--                 uniform mvMatU $= rcMVMatrix rc
+--                 uniform pMatU $= rcPMatrix rc
+--                 uniform globalAmbientU $= rcGlobalAmbient rc
+--                 uniform lightposU $= rcLightPos rc
+--                 setupTexturing3D density densityU 0
             
 
 buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (ResourcesClosure -> IO ())
-buildForestObject seq obj tex =
-    if Seq.null seq then return ((const.return) ()) else do
+buildForestObject a_seq obj tex =
+    if Seq.null a_seq then return ((const.return) ()) else do
     let bufferIO :: IO BufferObject
-        bufferIO = (newArray . Fold.toList) seq >>= ptrToBuffer ArrayBuffer (Seq.length seq * 4)
+        bufferIO = (newArray . Fold.toList) a_seq >>= ptrToBuffer ArrayBuffer (Seq.length a_seq * 4)
     
     !buffer <- bufferIO
     (log',file) <- loadObjFile obj :: IO ([String],ObjectFile GLfloat)
@@ -421,10 +410,10 @@ buildForestObject seq obj tex =
 
                 bindBuffer ArrayBuffer $= Just buffer
 
-                let declareAttr location nelem offset = do
+                let declareAttr location nelem' offset = do
                             vertexAttribPointer location $=
                                 (ToFloat, VertexArrayDescriptor
-                                    nelem Float (fromIntegral $ (3+3+2+1)*sizeOf (0::GLfloat))
+                                    nelem' Float (fromIntegral $ (3+3+2+1+1)*sizeOf (0::GLfloat))
                                     (wordPtrToPtr offset))
                             vertexAttribArray location $= Enabled
                             vertexAttributeDivisor location SV.$= 1
@@ -433,10 +422,11 @@ buildForestObject seq obj tex =
                 declareAttr (AttribLocation 11) 3 (3*4)
                 declareAttr (AttribLocation 12) 2 (6*4)
                 declareAttr (AttribLocation 13) 1 (8*4)
+                declareAttr (AttribLocation 14) 1 (9*4)
 
                 printErrors "forestClosure"
-    putStrLn $ "N trees = " ++! (Seq.length seq `div` 3)
-    let obj'' = setNumInstances (Seq.length seq `div` 3) obj'
+    putStrLn $ "N trees = " ++! (Seq.length a_seq `div` 3)
+    let obj'' = setNumInstances (Seq.length a_seq `div` 3) obj'
 
     return $ \rc -> do
         draw $ (prepare obj'') $ \_ -> do
@@ -468,7 +458,7 @@ buildWaterObject builder = do
     return $ \rc -> do
         draw $ prepare obj $ \_ -> do
             cullFace $= Nothing
-            patchVertices SV.$= 4
+            patchVertices SV.$= (4::Int)
             uniform (UniformLocation 4) $= rcPMatrix rc 
             uniform (UniformLocation 5) $= rcMVMatrix rc
             uniform (UniformLocation 7) $= rcNormalMatrix rc
@@ -577,27 +567,27 @@ skyboxObject = do
 
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S $ fromIntegral gl_CLAMP_TO_EDGE
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral gl_CLAMP_TO_EDGE
-    texture <- load "textures/skybox_sides.png" >>= textureFromSurface
+    l_texture <- load "textures/skybox_sides.png" >>= textureFromSurface
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S $ fromIntegral gl_CLAMP_TO_EDGE
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral gl_CLAMP_TO_EDGE
-    texture2 <- load "textures/skybox_sides_night.png" >>= textureFromSurface
+    l_texture2 <- load "textures/skybox_sides_night.png" >>= textureFromSurface
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S $ fromIntegral gl_CLAMP_TO_EDGE
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral gl_CLAMP_TO_EDGE
-    textureTop <- load "textures/skybox_top.png" >>= textureFromSurface
+    l_textureTop <- load "textures/skybox_top.png" >>= textureFromSurface
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S $ fromIntegral gl_CLAMP_TO_EDGE
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral gl_CLAMP_TO_EDGE
-    textureTopNight <- load "textures/skybox_top_night.png" >>= textureFromSurface
+    l_textureTopNight <- load "textures/skybox_top_night.png" >>= textureFromSurface
 
     [lightposU,multU] <- mapM (get . uniformLocation prog) 
                     ["lightpos","mult"]
     topObj <- newDefaultGlyphObjectWithClosure (skyboxTop 1) () $ \_ -> do
-        setupTexturing textureTop texLoc 2
-        setupTexturing textureTopNight texLocNight 3
+        setupTexturing l_textureTop texLoc 2
+        setupTexturing l_textureTopNight texLocNight 3
 
     obj <- newDefaultGlyphObjectWithClosure (skyboxSides 1) (matLoc,pmatLoc) $ \_ -> do
         currentProgram $= Just prog
-        setupTexturing texture texLoc 0
-        setupTexturing texture2 texLocNight 1
+        setupTexturing l_texture texLoc 0
+        setupTexturing l_texture2 texLocNight 1
         printErrors "Skybox"
 
     let obj' = teardown obj $ \_ -> do
@@ -606,11 +596,11 @@ skyboxObject = do
         depthFunc $= Nothing
         cullFace $= Nothing
         draw $ prepare obj' $ \this -> do
-            let (matLoc,pmatLoc) = getResources this
+            let (l_matLoc,l_pmatLoc) = getResources this
             let (CameraPosition _ th ph) = rcCameraPos rc
             uniform lightposU $= rcLightPos rc
-            uniform pmatLoc $= rcPMatrix rc
-            uniform matLoc $= buildMVMatrix (CameraPosition (Vec3 (0,0,0)) th ph)
+            uniform l_pmatLoc $= rcPMatrix rc
+            uniform l_matLoc $= buildMVMatrix (CameraPosition (Vec3 (0,0,0)) th ph)
             uniform (UniformLocation 1) $= rcGlobalAmbient rc
             bool <- (resourcesUnderWater $ rcResources rc)
             if bool then
diff --git a/shaders/forest.frag b/shaders/forest.frag
index 7392a00..f2d7643 100644
--- a/shaders/forest.frag
+++ b/shaders/forest.frag
@@ -16,6 +16,7 @@ uniform float dY ;
 in vec2 texposition ;
 in vec3 normal ;
 in vec4 frag_position ;
+in float shade ;
 
 vec4 sample(float xc,float yc) {
    return texture2D(texture,texposition + vec2(xc,yc));
@@ -49,5 +50,5 @@ void main() {
     vec4 col = texture2D(texture,texposition) ;
     float coef = max(dot( normalize(newNorm),
                           normalize(vec3(frag_position - light)) ),0) + (globalAmbient.a/4.0) ;
-    frag_color = vec4( col.xyz * coef * globalAmbient.xyz, col.a);
+    frag_color = vec4( shade * col.xyz * coef * globalAmbient.xyz, col.a);
 }
diff --git a/shaders/forest.vert b/shaders/forest.vert
index ba2cfc4..c52174c 100644
--- a/shaders/forest.vert
+++ b/shaders/forest.vert
@@ -16,15 +16,18 @@ layout(location = 10) in vec3 in_translation ;
 layout(location = 11) in vec3 in_scale ;
 layout(location = 12) in vec2 in_sincos_rot ;
 layout(location = 13) in float noise ;
+layout(location = 14) in float in_shade ;
 
 out vec2 texposition ;
 out vec3 normal ;
 out vec4 frag_position ;
+out float shade ;
 
 void main() {
     float s = in_sincos_rot.x ;
     float c = in_sincos_rot.y ;
 
+    shade = in_shade ;
     mat3 rot = mat3( c,0,s,
                      0,1,0,
                     -s,0,c ) ;
diff --git a/terralloc b/terralloc
index 386e9fc..3280cbe 100755
--- a/terralloc
+++ b/terralloc
@@ -1,3 +1,3 @@
 #!/bin/bash
 
-dist/build/final/final +RTS -K3000000000 -RTS $@
+PATH="$PATH:dist/build/terralloc.bin/" terralloc.bin +RTS -K3000000000 -RTS $@