minor stuff .. STILL NO TRIANGLE -.-
This commit is contained in:
parent
2fc28adfd1
commit
a2214082ca
49
src/Main.hs
49
src/Main.hs
@ -10,8 +10,8 @@ import Data.List (intercalate)
|
|||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL.GL as GL
|
||||||
import qualified Graphics.UI.GLFW as GLFW
|
import qualified Graphics.UI.GLFW as GLFW
|
||||||
|
|
||||||
import Map.Map
|
import Map.Map
|
||||||
import Render.Render (initShader)
|
import Render.Render (initShader)
|
||||||
@ -101,16 +101,6 @@ main = do
|
|||||||
|
|
||||||
GLFW.swapInterval 1
|
GLFW.swapInterval 1
|
||||||
|
|
||||||
GL.position (GL.Light 0) GL.$= GL.Vertex4 5 5 10 0
|
|
||||||
GL.light (GL.Light 0) GL.$= GL.Enabled
|
|
||||||
GL.lighting GL.$= GL.Enabled
|
|
||||||
GL.cullFace GL.$= Just GL.FrontAndBack -- Back
|
|
||||||
GL.depthFunc GL.$= Just GL.Always -- Less
|
|
||||||
GL.clearColor GL.$= GL.Color4 0.05 0.05 0.05 1
|
|
||||||
GL.normalize GL.$= GL.Enabled
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(fbWidth, fbHeight) <- GLFW.getFramebufferSize win
|
(fbWidth, fbHeight) <- GLFW.getFramebufferSize win
|
||||||
|
|
||||||
--generate map vertices
|
--generate map vertices
|
||||||
@ -231,6 +221,7 @@ run = do
|
|||||||
GLFW.swapBuffers win
|
GLFW.swapBuffers win
|
||||||
GL.flush -- not necessary, but someone recommended it
|
GL.flush -- not necessary, but someone recommended it
|
||||||
GLFW.pollEvents
|
GLFW.pollEvents
|
||||||
|
GL.finish
|
||||||
-- getEvents & process
|
-- getEvents & process
|
||||||
processEvents
|
processEvents
|
||||||
|
|
||||||
@ -368,29 +359,16 @@ processEvent ev =
|
|||||||
adjustWindow :: Pioneer ()
|
adjustWindow :: Pioneer ()
|
||||||
adjustWindow = do
|
adjustWindow = do
|
||||||
state <- get
|
state <- get
|
||||||
let width = stateWindowWidth state
|
let fbWidth = stateWindowWidth state
|
||||||
height = stateWindowHeight state
|
fbHeight = stateWindowHeight state
|
||||||
zDist = stateZDist state
|
fov = 90 --field of view
|
||||||
|
near = 1 --near plane
|
||||||
let pos = GL.Position 0 0
|
far = 100 --far plane
|
||||||
size = GL.Size (fromIntegral width) (fromIntegral height)
|
ratio = fromIntegral fbWidth / fromIntegral fbHeight
|
||||||
h = fromIntegral height / fromIntegral width :: Double
|
frust = createFrustum fov near far ratio
|
||||||
znear = 1 :: Double
|
put $ state {
|
||||||
zfar = 40 :: Double
|
stateFrustum = frust
|
||||||
xmax = znear * 0.5 :: Double
|
}
|
||||||
liftIO $ do
|
|
||||||
GL.viewport GL.$= (pos, size)
|
|
||||||
GL.matrixMode GL.$= GL.Projection
|
|
||||||
GL.loadIdentity
|
|
||||||
GL.frustum (realToFrac $ -xmax)
|
|
||||||
(realToFrac xmax)
|
|
||||||
(realToFrac $ -xmax * realToFrac h)
|
|
||||||
(realToFrac $ xmax * realToFrac h)
|
|
||||||
(realToFrac znear)
|
|
||||||
(realToFrac zfar)
|
|
||||||
GL.matrixMode GL.$= GL.Modelview 0
|
|
||||||
GL.loadIdentity
|
|
||||||
GL.translate (GL.Vector3 0 0 (negate $ realToFrac zDist) :: GL.Vector3 GL.GLfloat)
|
|
||||||
|
|
||||||
draw :: Pioneer ()
|
draw :: Pioneer ()
|
||||||
draw = do
|
draw = do
|
||||||
@ -407,7 +385,6 @@ draw = do
|
|||||||
map' = stateMap state
|
map' = stateMap state
|
||||||
frust = stateFrustum state
|
frust = stateFrustum state
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
|
|
||||||
lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
|
lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
|
||||||
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
|
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
|
||||||
GL.vertexAttribPointer ci GL.$= fgColorIndex
|
GL.vertexAttribPointer ci GL.$= fgColorIndex
|
||||||
|
@ -2,13 +2,14 @@ module Render.Misc where
|
|||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import qualified Data.ByteString as B (ByteString)
|
import qualified Data.ByteString as B (ByteString)
|
||||||
|
import Foreign.Marshal.Array (allocaArray,
|
||||||
|
pokeArray)
|
||||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||||||
import Graphics.Rendering.OpenGL.GLU.Errors
|
import Graphics.Rendering.OpenGL.GLU.Errors
|
||||||
|
import Graphics.Rendering.OpenGL.Raw.Core31
|
||||||
import System.IO (hPutStrLn, stderr)
|
import System.IO (hPutStrLn, stderr)
|
||||||
import Graphics.Rendering.OpenGL.Raw.Core31
|
|
||||||
import Foreign.Marshal.Array (allocaArray, pokeArray)
|
|
||||||
|
|
||||||
|
|
||||||
up :: (Double, Double, Double)
|
up :: (Double, Double, Double)
|
||||||
@ -77,7 +78,7 @@ lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat ->
|
|||||||
do
|
do
|
||||||
pokeArray projMat $
|
pokeArray projMat $
|
||||||
[1, 0, 0, 0,
|
[1, 0, 0, 0,
|
||||||
0, 0, 1, 0.1,
|
0, 0, 1, 0,
|
||||||
0, 1, 0, 0,
|
0, 1, 0, 0,
|
||||||
0, 0, 0, 1
|
0, 0, 0, 1
|
||||||
]
|
]
|
||||||
@ -92,7 +93,7 @@ infixl 5 ><
|
|||||||
ba, bb, bc, bd,
|
ba, bb, bc, bd,
|
||||||
ca, cb, cc, cd,
|
ca, cb, cc, cd,
|
||||||
da, db, dc, dd
|
da, db, dc, dd
|
||||||
] ><
|
] ><
|
||||||
[
|
[
|
||||||
xx, xy, xz, xw,
|
xx, xy, xz, xw,
|
||||||
yx, yy, yz, yw,
|
yx, yy, yz, yw,
|
||||||
@ -127,7 +128,7 @@ _ >< _ = error "non-conformat matrix-multiplication"
|
|||||||
|
|
||||||
-- generates 4x4-Projection-Matrix
|
-- generates 4x4-Projection-Matrix
|
||||||
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
|
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
|
||||||
lookAt at eye up =
|
lookAt at eye up =
|
||||||
map (fromRational . toRational) [
|
map (fromRational . toRational) [
|
||||||
xx, yx, zx, 0,
|
xx, yx, zx, 0,
|
||||||
xy, yy, zy, 0,
|
xy, yy, zy, 0,
|
||||||
|
Loading…
Reference in New Issue
Block a user