little cleanup

- some formatting
- changed y/z-Coords on Map (y is height now, map is in x/z-plane)
This commit is contained in:
Nicole Dresselhaus 2014-01-02 13:02:01 +01:00
parent 2ff7534ede
commit 306381c4ed
4 changed files with 35 additions and 27 deletions

View File

@ -26,6 +26,7 @@ import GHC.Conc.Sync (unsafeIOToSTM)
import Prelude as P import Prelude as P
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import Foreign.Marshal.Array (allocaArray) import Foreign.Marshal.Array (allocaArray)
import Render.Misc (dumpInfo)
data ProgramState = PS { keysPressed :: IntSet data ProgramState = PS { keysPressed :: IntSet
, px :: GLfloat , px :: GLfloat
@ -365,6 +366,7 @@ keyEvent state press = do
| code == 25 -> accept $ ps { dheading = dheading - deltaH } | code == 25 -> accept $ ps { dheading = dheading - deltaH }
| code == 27 -> accept $ ps { dheading = dheading + deltaH } | code == 27 -> accept $ ps { dheading = dheading + deltaH }
| code == 42 -> accept $ ps { showShadowMap = not showShadowMap } | code == 42 -> accept $ ps { showShadowMap = not showShadowMap }
| code == 31 -> dumpInfo >> accept ps
| otherwise -> deny ps | otherwise -> deny ps
-- on RELEASE only -- on RELEASE only
False False
@ -522,7 +524,6 @@ main = do
(w', h') <- liftIO $ reconfigure w h (w', h') <- liftIO $ reconfigure w h
liftIO $ Gtk.labelSetText label $ unwords ["Width:",show w',"Height:",show h'] liftIO $ Gtk.labelSetText label $ unwords ["Width:",show w',"Height:",show h']
Gtk.widgetShowAll window Gtk.widgetShowAll window
Gtk.mainGUI Gtk.mainGUI

View File

@ -105,11 +105,11 @@ colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0)
Mountain -> (0.5, 0.5, 0.5) Mountain -> (0.5, 0.5, 0.5)
coordLookup :: (Int,Int) -> GLfloat -> (GLfloat, GLfloat, GLfloat) coordLookup :: (Int,Int) -> GLfloat -> (GLfloat, GLfloat, GLfloat)
coordLookup (x,y) h = coordLookup (x,z) y =
if even x then if even x then
(fromIntegral $ x `div` 2, fromIntegral (2 * y) * lineHeight, h) (fromIntegral $ x `div` 2, y, fromIntegral (2 * z) * lineHeight)
else else
(fromIntegral (x `div` 2) / 2.0, fromIntegral (2 * y + 1) * lineHeight, h) (fromIntegral (x `div` 2) / 2.0, y, fromIntegral (2 * z + 1) * lineHeight)
-- if writing in ASCII-Format transpose so i,j -> y,x -- if writing in ASCII-Format transpose so i,j -> y,x

View File

@ -1,24 +1,24 @@
module Render.Misc where module Render.Misc where
import Graphics.Rendering.OpenGL.GL.StringQueries import Control.Monad
import Graphics.Rendering.OpenGL.GL.StateVar import qualified Data.ByteString as B (ByteString)
import Graphics.Rendering.OpenGL.GLU.Errors import Graphics.Rendering.OpenGL.GL.Shaders
import System.IO (hPutStrLn, stderr) import Graphics.Rendering.OpenGL.GL.StateVar
import Control.Monad import Graphics.Rendering.OpenGL.GL.StringQueries
import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GLU.Errors
import qualified Data.ByteString as B (ByteString) import System.IO (hPutStrLn, stderr)
checkError :: String -> IO () checkError :: String -> IO ()
checkError functionName = get errors >>= mapM_ reportError checkError functionName = get errors >>= mapM_ reportError
where reportError e = where reportError e =
hPutStrLn stderr (showError e ++ " detected in " ++ functionName) hPutStrLn stderr (showError e ++ " detected in " ++ functionName)
showError (Error category message) = showError (Error category message) =
"GL error " ++ show category ++ " (" ++ message ++ ")" "GL error " ++ show category ++ " (" ++ message ++ ")"
dumpInfo :: IO () dumpInfo :: IO ()
dumpInfo = do dumpInfo = do
let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var
dump "Vendor" vendor dump "Vendor" vendor
dump "Renderer" renderer dump "Renderer" renderer
dump "Version" glVersion dump "Version" glVersion
@ -50,4 +50,4 @@ createProgramUsing shaders = do
program <- createProgram program <- createProgram
attachedShaders program $= shaders attachedShaders program $= shaders
linkAndCheck program linkAndCheck program
return program return program

View File

@ -1,17 +1,19 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Render.Render where module Render.Render where
import Graphics.Rendering.OpenGL.GL.BufferObjects import qualified Data.ByteString as B
import Graphics.Rendering.OpenGL.GL.ObjectName import Foreign.Marshal.Array (withArray)
import Graphics.Rendering.OpenGL.GL.StateVar import Foreign.Storable (sizeOf)
import Render.Misc import Graphics.Rendering.OpenGL.GL.BufferObjects
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat) import Graphics.Rendering.OpenGL.GL.Framebuffer (clearColor)
import Foreign.Storable (sizeOf) import Graphics.Rendering.OpenGL.GL.ObjectName
import Foreign.Marshal.Array (withArray) import Graphics.Rendering.OpenGL.GL.Shaders
import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability (..),
import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability(..), vertexAttribArray) vertexAttribArray)
import qualified Data.ByteString as B import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
import Render.Misc
vertexShaderFile :: String vertexShaderFile :: String
vertexShaderFile = "shaders/vertex.shader" vertexShaderFile = "shaders/vertex.shader"
@ -19,7 +21,7 @@ fragmentShaderFile :: String
fragmentShaderFile = "shaders/fragment.shader" fragmentShaderFile = "shaders/fragment.shader"
initBuffer :: [GLfloat] -> IO BufferObject initBuffer :: [GLfloat] -> IO BufferObject
initBuffer varray = initBuffer varray =
let let
sizeOfVarray = length varray * sizeOfComponent sizeOfVarray = length varray * sizeOfComponent
sizeOfComponent = sizeOf (head varray) sizeOfComponent = sizeOf (head varray)
@ -49,4 +51,9 @@ initShader = do
vertexAttribArray vertexIndex $= Enabled vertexAttribArray vertexIndex $= Enabled
checkError "initShader" checkError "initShader"
return (projectionMatrixIndex, colorIndex, vertexIndex) return (projectionMatrixIndex, colorIndex, vertexIndex)
initRendering :: IO ()
initRendering = do
clearColor $= Color4 0 0 0 0
checkError "initRendering"