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:
parent
2ff7534ede
commit
306381c4ed
@ -26,6 +26,7 @@ import GHC.Conc.Sync (unsafeIOToSTM)
|
||||
import Prelude as P
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Foreign.Marshal.Array (allocaArray)
|
||||
import Render.Misc (dumpInfo)
|
||||
|
||||
data ProgramState = PS { keysPressed :: IntSet
|
||||
, px :: GLfloat
|
||||
@ -365,6 +366,7 @@ keyEvent state press = do
|
||||
| code == 25 -> accept $ ps { dheading = dheading - deltaH }
|
||||
| code == 27 -> accept $ ps { dheading = dheading + deltaH }
|
||||
| code == 42 -> accept $ ps { showShadowMap = not showShadowMap }
|
||||
| code == 31 -> dumpInfo >> accept ps
|
||||
| otherwise -> deny ps
|
||||
-- on RELEASE only
|
||||
False
|
||||
@ -522,7 +524,6 @@ main = do
|
||||
(w', h') <- liftIO $ reconfigure w h
|
||||
liftIO $ Gtk.labelSetText label $ unwords ["Width:",show w',"Height:",show h']
|
||||
|
||||
|
||||
Gtk.widgetShowAll window
|
||||
Gtk.mainGUI
|
||||
|
||||
|
@ -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)
|
||||
|
||||
coordLookup :: (Int,Int) -> GLfloat -> (GLfloat, GLfloat, GLfloat)
|
||||
coordLookup (x,y) h =
|
||||
coordLookup (x,z) y =
|
||||
if even x then
|
||||
(fromIntegral $ x `div` 2, fromIntegral (2 * y) * lineHeight, h)
|
||||
(fromIntegral $ x `div` 2, y, fromIntegral (2 * z) * lineHeight)
|
||||
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
|
||||
|
@ -1,24 +1,24 @@
|
||||
module Render.Misc where
|
||||
|
||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Graphics.Rendering.OpenGL.GLU.Errors
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Control.Monad
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import qualified Data.ByteString as B (ByteString)
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as B (ByteString)
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||||
import Graphics.Rendering.OpenGL.GLU.Errors
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
|
||||
|
||||
checkError :: String -> IO ()
|
||||
checkError functionName = get errors >>= mapM_ reportError
|
||||
where reportError e =
|
||||
where reportError e =
|
||||
hPutStrLn stderr (showError e ++ " detected in " ++ functionName)
|
||||
showError (Error category message) =
|
||||
"GL error " ++ show category ++ " (" ++ message ++ ")"
|
||||
|
||||
dumpInfo :: IO ()
|
||||
dumpInfo = do
|
||||
let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var
|
||||
let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var
|
||||
dump "Vendor" vendor
|
||||
dump "Renderer" renderer
|
||||
dump "Version" glVersion
|
||||
@ -50,4 +50,4 @@ createProgramUsing shaders = do
|
||||
program <- createProgram
|
||||
attachedShaders program $= shaders
|
||||
linkAndCheck program
|
||||
return program
|
||||
return program
|
||||
|
@ -1,17 +1,19 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Render.Render where
|
||||
|
||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
||||
import Graphics.Rendering.OpenGL.GL.ObjectName
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Render.Misc
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
|
||||
import Foreign.Storable (sizeOf)
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability(..), vertexAttribArray)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString as B
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Storable (sizeOf)
|
||||
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
||||
import Graphics.Rendering.OpenGL.GL.Framebuffer (clearColor)
|
||||
import Graphics.Rendering.OpenGL.GL.ObjectName
|
||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||
import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability (..),
|
||||
vertexAttribArray)
|
||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
||||
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
|
||||
import Render.Misc
|
||||
|
||||
vertexShaderFile :: String
|
||||
vertexShaderFile = "shaders/vertex.shader"
|
||||
@ -19,7 +21,7 @@ fragmentShaderFile :: String
|
||||
fragmentShaderFile = "shaders/fragment.shader"
|
||||
|
||||
initBuffer :: [GLfloat] -> IO BufferObject
|
||||
initBuffer varray =
|
||||
initBuffer varray =
|
||||
let
|
||||
sizeOfVarray = length varray * sizeOfComponent
|
||||
sizeOfComponent = sizeOf (head varray)
|
||||
@ -49,4 +51,9 @@ initShader = do
|
||||
vertexAttribArray vertexIndex $= Enabled
|
||||
|
||||
checkError "initShader"
|
||||
return (projectionMatrixIndex, colorIndex, vertexIndex)
|
||||
return (projectionMatrixIndex, colorIndex, vertexIndex)
|
||||
|
||||
initRendering :: IO ()
|
||||
initRendering = do
|
||||
clearColor $= Color4 0 0 0 0
|
||||
checkError "initRendering"
|
||||
|
Loading…
Reference in New Issue
Block a user