Scene renders better now
- Enabled BackCulling - Wrote shadow-mapping-functions - temp. changed to flat-shading for better distinction - defined Tiles CCW for BackCulling
This commit is contained in:
parent
e1cad5786e
commit
7110d9404b
@ -10,7 +10,7 @@ executable Pioneers
|
|||||||
build-depends:
|
build-depends:
|
||||||
base >= 4,
|
base >= 4,
|
||||||
gtk,
|
gtk,
|
||||||
OpenGL >=2.8.0 && <2.9,
|
OpenGL >=2.9,
|
||||||
gtkglext >=0.12,
|
gtkglext >=0.12,
|
||||||
containers >=0.5 && <0.6,
|
containers >=0.5 && <0.6,
|
||||||
array >=0.4.0 && <0.5,
|
array >=0.4.0 && <0.5,
|
||||||
@ -19,7 +19,6 @@ executable Pioneers
|
|||||||
text >=0.11.3 && <0.12,
|
text >=0.11.3 && <0.12,
|
||||||
stm >=2.4.2 && <2.5,
|
stm >=2.4.2 && <2.5,
|
||||||
transformers >=0.3.0 && <0.4,
|
transformers >=0.3.0 && <0.4,
|
||||||
List >=0.5.1 && <0.6,
|
|
||||||
List >=0.5.1 && <0.6
|
List >=0.5.1 && <0.6
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
other-modules:
|
other-modules:
|
||||||
|
|||||||
237
src/Main.hs
237
src/Main.hs
@ -1,29 +1,31 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import qualified Graphics.UI.Gtk as Gtk
|
import Graphics.UI.Gtk (AttrOp ((:=)))
|
||||||
import Graphics.UI.Gtk (AttrOp((:=)))
|
import qualified Graphics.UI.Gtk as Gtk
|
||||||
import qualified Graphics.UI.Gtk.OpenGL as GtkGL
|
import qualified Graphics.UI.Gtk.OpenGL as GtkGL
|
||||||
|
|
||||||
import Graphics.Rendering.OpenGL as GL
|
import qualified Data.Array.IArray as A
|
||||||
|
import Graphics.Rendering.OpenGL as GL
|
||||||
import qualified Graphics.UI.Gtk.Gdk.EventM as Event
|
import qualified Graphics.UI.Gtk.Gdk.EventM as Event
|
||||||
import qualified Data.Array.IArray as A
|
|
||||||
|
|
||||||
import Map.Coordinates
|
import Map.Coordinates
|
||||||
import Map.Map
|
import Map.Map
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.IntSet as IS
|
||||||
import Debug.Trace
|
import Data.IORef
|
||||||
import Data.IntSet as IS
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.IORef
|
import Debug.Trace
|
||||||
|
|
||||||
import Prelude as P
|
import Control.Concurrent
|
||||||
import Control.Monad
|
import Control.Concurrent.STM
|
||||||
import Control.Concurrent
|
import Control.Monad
|
||||||
import Control.Concurrent.STM
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import Foreign.Ptr (nullPtr)
|
||||||
import GHC.Conc.Sync (unsafeIOToSTM)
|
import GHC.Conc.Sync (unsafeIOToSTM)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Prelude as P
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
import Foreign.Marshal.Array (allocaArray)
|
||||||
|
|
||||||
data ProgramState = PS { keysPressed :: IntSet
|
data ProgramState = PS { keysPressed :: IntSet
|
||||||
, px :: GLfloat
|
, px :: GLfloat
|
||||||
@ -38,27 +40,47 @@ data ProgramState = PS { keysPressed :: IntSet
|
|||||||
, dpitch :: GLfloat }
|
, dpitch :: GLfloat }
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
type RenderObject = (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
||||||
|
|
||||||
|
(Vertex4 a b c d) .+ (Vertex4 w x y z) = Vertex4 (a+w) (b+x) (c+y) (d+z)
|
||||||
|
(Vertex4 a b c d) .* e = Vertex4 (a*e) (b*e) (c*e) (d*e)
|
||||||
|
|
||||||
animationWaitTime = 3 :: Int
|
animationWaitTime = 3 :: Int
|
||||||
canvasWidth = 1024 :: Int
|
canvasWidth = 1024 :: Int
|
||||||
canvasHeight = 768 :: Int
|
canvasHeight = 768 :: Int
|
||||||
deltaV = 0.10
|
deltaV = 0.10
|
||||||
deltaH = 0.5
|
deltaH = 0.5
|
||||||
deltaP = 0.15
|
deltaP = 0.15
|
||||||
|
black = Color3 0 0 0 :: Color3 GLfloat
|
||||||
|
shadowMapSize :: TextureSize2D
|
||||||
|
shadowMapSize = TextureSize2D 256 256
|
||||||
|
|
||||||
-- TODO: Put render-stuff in render-module
|
up :: Vector3 GLdouble
|
||||||
|
up = Vector3 0 1 0
|
||||||
|
|
||||||
|
origin :: Vertex3 GLdouble
|
||||||
|
origin = Vertex3 0 0 0
|
||||||
|
|
||||||
|
sun = Light 0
|
||||||
|
|
||||||
|
-- TODO: Put render-stuff in render-modul
|
||||||
|
|
||||||
|
--gets Sun position in given format
|
||||||
|
getSunPos :: (GLdouble -> GLdouble -> GLdouble -> a) -> IO a
|
||||||
|
getSunPos f = do
|
||||||
|
Vertex4 x y z _ <- get (position sun)
|
||||||
|
return $ f (realToFrac x) (realToFrac y) (realToFrac z)
|
||||||
|
|
||||||
glTexCoord2f (x,y) = texCoord (TexCoord2 x y :: TexCoord2 GLfloat)
|
glTexCoord2f (x,y) = texCoord (TexCoord2 x y :: TexCoord2 GLfloat)
|
||||||
glVertex3f (x,y,z) = vertex (Vertex3 x y z :: Vertex3 GLfloat)
|
glVertex3f (x,y,z) = vertex (Vertex3 x y z :: Vertex3 GLfloat)
|
||||||
glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
|
glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
|
||||||
|
|
||||||
|
|
||||||
prepareRenderTile :: PlayMap -> ((Int,Int),MapEntry) -> (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
prepareRenderTile :: PlayMap -> ((Int,Int),MapEntry) -> (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
||||||
prepareRenderTile m (c@(cx,cz),(_,t)) =
|
prepareRenderTile m (c@(cx,cz),(_,t)) =
|
||||||
(
|
(
|
||||||
if even cx then
|
Vector3 (1.5 * fromIntegral cx) 0.0
|
||||||
Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz))
|
(if even cx then 2 * fromIntegral cz else
|
||||||
else
|
2 * fromIntegral cz - 1)
|
||||||
Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz)-1)
|
|
||||||
,
|
,
|
||||||
case t of
|
case t of
|
||||||
Water -> Color3 0.5 0.5 1 :: Color3 GLfloat
|
Water -> Color3 0.5 0.5 1 :: Color3 GLfloat
|
||||||
@ -67,28 +89,50 @@ prepareRenderTile m (c@(cx,cz),(_,t)) =
|
|||||||
Mountain -> Color3 0.5 0.5 0.5 :: Color3 GLfloat
|
Mountain -> Color3 0.5 0.5 0.5 :: Color3 GLfloat
|
||||||
,getTileVertices m c)
|
,getTileVertices m c)
|
||||||
|
|
||||||
renderTile :: (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat]) -> IO ()
|
renderTile :: RenderObject -> IO ()
|
||||||
renderTile (coord,c,ts) =
|
renderTile (coord,c,ts) =
|
||||||
preservingMatrix $ do
|
preservingMatrix $ do
|
||||||
color c
|
|
||||||
translate coord
|
translate coord
|
||||||
_ <- renderPrimitive Polygon $ do
|
{-color black
|
||||||
|
lineWidth $= 4.0
|
||||||
|
lineSmooth $= Enabled
|
||||||
|
_ <- renderPrimitive LineLoop $ do
|
||||||
glNormal3f(0.0,0.0,1.0)
|
glNormal3f(0.0,0.0,1.0)
|
||||||
|
mapM vertex ts-}
|
||||||
|
color c
|
||||||
|
_ <- renderPrimitive Polygon $ do
|
||||||
|
glNormal3f(0.0,1.0,0.0)
|
||||||
mapM vertex ts
|
mapM vertex ts
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
drawSphere = do
|
drawSphere :: IO ()
|
||||||
renderQuadric (QuadricStyle
|
drawSphere = renderQuadric
|
||||||
(Just Smooth)
|
(QuadricStyle (Just Smooth) GenerateTextureCoordinates Outside
|
||||||
GenerateTextureCoordinates
|
FillStyle)
|
||||||
Outside
|
(Sphere 2.0 48 48)
|
||||||
FillStyle)
|
|
||||||
(Sphere 1.0 48 48)
|
drawObjects :: [RenderObject] -> [RenderObject] -> Bool -> IO ()
|
||||||
|
drawObjects map ent shadowRender = do
|
||||||
|
textureOn <- get (texture Texture2D) --are textures enabled?
|
||||||
|
|
||||||
|
when shadowRender $
|
||||||
|
texture Texture2D $= Disabled --disable textures if we render shadows.
|
||||||
|
|
||||||
|
--draw objects
|
||||||
|
preservingMatrix $ do
|
||||||
|
translate (Vector3 15.0 15.0 25.0 :: Vector3 GLfloat)
|
||||||
|
drawSphere
|
||||||
|
mapM_ renderTile map
|
||||||
|
|
||||||
|
|
||||||
|
when (shadowRender && textureOn == Enabled) $ --reset texture-rendering
|
||||||
|
texture Texture2D $= Enabled
|
||||||
|
|
||||||
-- OpenGL polygon-function for drawing stuff.
|
-- OpenGL polygon-function for drawing stuff.
|
||||||
display :: MVar ProgramState -> PlayMap -> IO ()
|
display :: MVar ProgramState -> PlayMap -> IO ()
|
||||||
display state t =
|
display state t =
|
||||||
let
|
let
|
||||||
|
-- Todo: have tiles static somewhere .. dont calculate every frame
|
||||||
tiles = P.map (prepareRenderTile t) (A.assocs t)
|
tiles = P.map (prepareRenderTile t) (A.assocs t)
|
||||||
in
|
in
|
||||||
do
|
do
|
||||||
@ -104,11 +148,12 @@ display state t =
|
|||||||
GL.rotate heading (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
|
GL.rotate heading (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
|
||||||
translate (Vector3 (-px) (-py) (-pz)::Vector3 GLfloat)
|
translate (Vector3 (-px) (-py) (-pz)::Vector3 GLfloat)
|
||||||
|
|
||||||
position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
|
generateShadowMap tiles [] True
|
||||||
|
generateTextureMatrix
|
||||||
|
clear [ ColorBuffer, DepthBuffer ]
|
||||||
|
preservingMatrix $ do
|
||||||
|
drawObjects tiles [] False
|
||||||
|
|
||||||
-- Instead of glBegin ... glEnd there is renderPrimitive.
|
|
||||||
--trace (show tiles) $
|
|
||||||
mapM_ renderTile tiles
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
updateCamera :: MVar ProgramState -> IO ()
|
updateCamera :: MVar ProgramState -> IO ()
|
||||||
@ -155,13 +200,81 @@ updateCamera state = do
|
|||||||
, heading = heading'
|
, heading = heading'
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- Note: preservingViewport is not exception safe, but it doesn't matter here
|
||||||
|
preservingViewport :: IO a -> IO a
|
||||||
|
preservingViewport act = do
|
||||||
|
v <- get viewport
|
||||||
|
x <- act
|
||||||
|
viewport $= v
|
||||||
|
return x
|
||||||
|
|
||||||
|
generateTextureMatrix :: IO ()
|
||||||
|
generateTextureMatrix = do
|
||||||
|
-- Set up projective texture matrix. We use the Modelview matrix stack and
|
||||||
|
-- OpenGL matrix commands to make the matrix.
|
||||||
|
m <- preservingMatrix $ do
|
||||||
|
loadIdentity
|
||||||
|
-- resolve overloading, not needed in "real" programs
|
||||||
|
let translatef = translate :: Vector3 GLfloat -> IO ()
|
||||||
|
scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()
|
||||||
|
translatef (Vector3 0.5 0.5 0.0)
|
||||||
|
scalef 0.5 0.5 1.0
|
||||||
|
perspective 60 1 1 1000
|
||||||
|
lightPos' <- getSunPos Vertex3
|
||||||
|
lookAt lightPos' origin up
|
||||||
|
get (matrix (Just (Modelview 0)))
|
||||||
|
|
||||||
|
[ sx, sy, sz, sw,
|
||||||
|
tx, ty, tz, tw,
|
||||||
|
rx, ry, rz, rw,
|
||||||
|
qx, qy, qz, qw ] <- getMatrixComponents RowMajor (m :: GLmatrix GLdouble)
|
||||||
|
|
||||||
|
textureGenMode S $= Just (ObjectLinear (Plane sx sy sz sw))
|
||||||
|
textureGenMode T $= Just (ObjectLinear (Plane tx ty tz tw))
|
||||||
|
textureGenMode R $= Just (ObjectLinear (Plane rx ry rz rw))
|
||||||
|
textureGenMode Q $= Just (ObjectLinear (Plane qx qy qz qw))
|
||||||
|
|
||||||
|
generateShadowMap :: [RenderObject] -> [RenderObject] -> Bool -> IO ()
|
||||||
|
generateShadowMap tiles obj showShadow' = do
|
||||||
|
lightPos' <- getSunPos Vertex3
|
||||||
|
let (TextureSize2D shadowMapWidth shadowMapHeight) = shadowMapSize
|
||||||
|
shadowMapSize' = Size shadowMapWidth shadowMapHeight
|
||||||
|
|
||||||
|
preservingViewport $ do
|
||||||
|
viewport $= (Position 0 0, shadowMapSize')
|
||||||
|
|
||||||
|
clear [ ColorBuffer, DepthBuffer ]
|
||||||
|
|
||||||
|
matrixMode $= Projection
|
||||||
|
preservingMatrix $ do
|
||||||
|
loadIdentity
|
||||||
|
perspective 80 1 10 1000
|
||||||
|
matrixMode $= Modelview 0
|
||||||
|
preservingMatrix $ do
|
||||||
|
loadIdentity
|
||||||
|
lookAt lightPos' origin up
|
||||||
|
drawObjects tiles obj True
|
||||||
|
matrixMode $= Projection
|
||||||
|
matrixMode $= Modelview 0
|
||||||
|
|
||||||
|
copyTexImage2D Texture2D 0 DepthComponent' (Position 0 0) shadowMapSize 0
|
||||||
|
|
||||||
|
when showShadow' $ do
|
||||||
|
let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)
|
||||||
|
allocaArray numShadowMapPixels $ \depthImage -> do
|
||||||
|
let pixelData fmt = PixelData fmt Float depthImage :: PixelData GLfloat
|
||||||
|
readPixels (Position 0 0) shadowMapSize' (pixelData DepthComponent)
|
||||||
|
(_, Size viewPortWidth _) <- get viewport
|
||||||
|
windowPos (Vertex2 (fromIntegral viewPortWidth / 2 :: GLfloat) 0)
|
||||||
|
drawPixels shadowMapSize' (pixelData Luminance)
|
||||||
|
|
||||||
--Adjust size to given dimensions
|
--Adjust size to given dimensions
|
||||||
reconfigure :: Int -> Int -> IO (Int, Int)
|
reconfigure :: Int -> Int -> IO (Int, Int)
|
||||||
reconfigure w h = do
|
reconfigure w h = do
|
||||||
-- maintain aspect ratio
|
-- maintain aspect ratio
|
||||||
let aspectRatio = (fromIntegral canvasWidth) / (fromIntegral canvasHeight)
|
let aspectRatio = fromIntegral canvasWidth / fromIntegral canvasHeight
|
||||||
(w1, h1) = (fromIntegral w, (fromIntegral w) / aspectRatio)
|
(w1, h1) = (fromIntegral w, fromIntegral w / aspectRatio)
|
||||||
(w2, h2) = ((fromIntegral h) * aspectRatio, fromIntegral h)
|
(w2, h2) = (fromIntegral h * aspectRatio, fromIntegral h)
|
||||||
(w', h') = if h1 <= fromIntegral h
|
(w', h') = if h1 <= fromIntegral h
|
||||||
then (floor w1, floor h1)
|
then (floor w1, floor h1)
|
||||||
else (floor w2, floor h2)
|
else (floor w2, floor h2)
|
||||||
@ -210,10 +323,11 @@ keyEvent state press = do
|
|||||||
deny a = return (a, False)
|
deny a = return (a, False)
|
||||||
in do
|
in do
|
||||||
-- keep list of pressed keys up2date
|
-- keep list of pressed keys up2date
|
||||||
ps <- if not press
|
ps <- return (if not press then
|
||||||
then return ps { keysPressed = fromIntegral code `IS.delete` kp }
|
(ps{keysPressed = fromIntegral code `delete` kp})
|
||||||
else return ps { keysPressed = fromIntegral code `IS.insert` kp }
|
else
|
||||||
-- putStrLn $ unwords [name , show val, show code, show ps] -- trace (unwords [name , show val]) -- debugging
|
(ps{keysPressed = fromIntegral code `insert` kp}))
|
||||||
|
putStrLn $ unwords [name , show val, show code, show ps] -- trace (unwords [name , show val]) -- debugging
|
||||||
-- process keys
|
-- process keys
|
||||||
case press of
|
case press of
|
||||||
-- on PRESS only
|
-- on PRESS only
|
||||||
@ -247,7 +361,7 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
! terrain <- testmap
|
! terrain <- testmap
|
||||||
-- create TVar using unsafePerformIO -> currently no other thread -> OK
|
-- create TVar using unsafePerformIO -> currently no other thread -> OK
|
||||||
state <- newMVar $ PS { keysPressed = IS.empty
|
state <- newMVar PS { keysPressed = IS.empty
|
||||||
, px = 7.5
|
, px = 7.5
|
||||||
, py = 20
|
, py = 20
|
||||||
, pz = 15
|
, pz = 15
|
||||||
@ -279,27 +393,48 @@ main = do
|
|||||||
-- we are using wouldn't heve been setup yet)
|
-- we are using wouldn't heve been setup yet)
|
||||||
Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do
|
Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do
|
||||||
reconfigure canvasWidth canvasHeight
|
reconfigure canvasWidth canvasHeight
|
||||||
|
--set up shadow-map
|
||||||
|
texImage2D Texture2D NoProxy 0 DepthComponent' shadowMapSize 0
|
||||||
|
(PixelData DepthComponent UnsignedByte nullPtr)
|
||||||
|
|
||||||
materialAmbient Front $= Color4 0.4 0.4 0.4 1.0
|
materialAmbient Front $= Color4 0.4 0.4 0.4 1.0
|
||||||
materialDiffuse Front $= Color4 0.4 0.4 0.4 1.0
|
materialDiffuse Front $= Color4 0.4 0.4 0.4 1.0
|
||||||
materialSpecular Front $= Color4 0.8 0.8 0.8 1.0
|
materialSpecular Front $= Color4 0.8 0.8 0.8 1.0
|
||||||
materialShininess Front $= 25.0
|
materialShininess Front $= 25.0
|
||||||
|
|
||||||
ambient (Light 0) $= Color4 0.3 0.3 0.3 1.0
|
ambient sun $= Color4 0.3 0.3 0.3 1.0
|
||||||
diffuse (Light 0) $= Color4 1.0 1.0 1.0 1.0
|
diffuse sun $= Color4 1.0 1.0 1.0 1.0
|
||||||
specular (Light 0) $= Color4 0.8 0.8 0.8 1.0
|
specular sun $= Color4 0.8 0.8 0.8 1.0
|
||||||
lightModelAmbient $= Color4 0.2 0.2 0.2 1.0
|
lightModelAmbient $= Color4 0.2 0.2 0.2 1.0
|
||||||
|
position sun $= (Vertex4 2.0 1.0 1.3 1.0 :: Vertex4 GLfloat) .* 5
|
||||||
|
spotDirection sun $= (Normal3 (-2.0) (-1.0) (-1.3) :: Normal3 GLfloat)
|
||||||
|
--spotExponent sun $= 1.0
|
||||||
|
--attenuation sun $= (1.0, 0.0, 0.0)
|
||||||
|
|
||||||
lighting $= Enabled
|
lighting $= Enabled
|
||||||
light (Light 0) $= Enabled
|
light sun $= Enabled
|
||||||
depthFunc $= Just Less
|
depthFunc $= Just Less
|
||||||
|
shadeModel $= Smooth
|
||||||
|
--lightModelLocalViewer $= Enabled
|
||||||
|
--vertexProgramTwoSide $= Enabled
|
||||||
|
|
||||||
clearColor $= Color4 0.0 0.0 0.0 0.0
|
clearColor $= Color4 0.0 0.0 0.0 0.0
|
||||||
drawBuffer $= BackBuffers
|
drawBuffer $= BackBuffers
|
||||||
colorMaterial $= Just (Front, Diffuse)
|
colorMaterial $= Just (Front, Diffuse)
|
||||||
|
|
||||||
|
frontFace $= CCW
|
||||||
|
cullFace $= Just Back
|
||||||
|
|
||||||
texture Texture2D $= Enabled
|
texture Texture2D $= Enabled
|
||||||
|
|
||||||
shadeModel $= Smooth
|
shadeModel $= Flat
|
||||||
|
|
||||||
|
fog $= Enabled
|
||||||
|
fogMode $= Linear 45.0 50.0
|
||||||
|
fogColor $= Color4 0.5 0.5 0.5 1.0
|
||||||
|
fogDistanceMode $= EyeRadial
|
||||||
|
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
{-clearColor $= (Color4 0.0 0.0 0.0 0.0)
|
{-clearColor $= (Color4 0.0 0.0 0.0 0.0)
|
||||||
matrixMode $= Projection
|
matrixMode $= Projection
|
||||||
|
|||||||
@ -63,17 +63,18 @@ data TileVertex =
|
|||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
|
||||||
|
--Culling is done with GL_CCW
|
||||||
getTileVertices :: PlayMap -> Tile -> [Vertex3 GLfloat]
|
getTileVertices :: PlayMap -> Tile -> [Vertex3 GLfloat]
|
||||||
getTileVertices heights t = let p = (listArray (0,5) hexagon)
|
getTileVertices heights t = let p = (listArray (0,5) hexagon)
|
||||||
::Array Int (Float,Float) in
|
::Array Int (Float,Float) in
|
||||||
P.map floatToVertex $
|
P.map floatToVertex $
|
||||||
[
|
[
|
||||||
(fst $ p ! 0, getHeight heights VertexNW t, snd $ p ! 0),
|
(fst $ p ! 5, getHeight heights VertexW t, snd $ p ! 5),
|
||||||
(fst $ p ! 1, getHeight heights VertexNE t, snd $ p ! 1),
|
|
||||||
(fst $ p ! 2, getHeight heights VertexE t, snd $ p ! 2),
|
|
||||||
(fst $ p ! 3, getHeight heights VertexSE t, snd $ p ! 3),
|
|
||||||
(fst $ p ! 4, getHeight heights VertexSW t, snd $ p ! 4),
|
(fst $ p ! 4, getHeight heights VertexSW t, snd $ p ! 4),
|
||||||
(fst $ p ! 5, getHeight heights VertexW t, snd $ p ! 5)
|
(fst $ p ! 3, getHeight heights VertexSE t, snd $ p ! 3),
|
||||||
|
(fst $ p ! 2, getHeight heights VertexE t, snd $ p ! 2),
|
||||||
|
(fst $ p ! 1, getHeight heights VertexNE t, snd $ p ! 1),
|
||||||
|
(fst $ p ! 0, getHeight heights VertexNW t, snd $ p ! 0)
|
||||||
]
|
]
|
||||||
|
|
||||||
getHeight :: PlayMap -> TileVertex -> Tile -> Float
|
getHeight :: PlayMap -> TileVertex -> Tile -> Float
|
||||||
|
|||||||
@ -26,23 +26,33 @@ type PlayMap = Array (Int, Int) MapEntry
|
|||||||
-- row-minor -> row-major
|
-- row-minor -> row-major
|
||||||
testMapTemplate :: [Text]
|
testMapTemplate :: [Text]
|
||||||
testMapTemplate = T.transpose [
|
testMapTemplate = T.transpose [
|
||||||
"~~~~~~~~~~",
|
"~~~~~~~~~~~~~~~~~~~~",
|
||||||
"~~SSSSSS~~",
|
"~~SSSSSSSSSSSSSS~~~~",
|
||||||
"~SSGGGGS~~",
|
"~SSGGGGGGGSGSGGS~~~~",
|
||||||
"~SSGGMMS~~",
|
"~SSGGGGGGMSGSGMS~~~~",
|
||||||
"~SGGMMS~~~",
|
"~SGGGGGGMMMGGGS~~~S~",
|
||||||
"~SGMMMS~~~",
|
"~SGGGMGMMMMMGGS~~~SS",
|
||||||
"~GGGGGGS~~",
|
"~GGGGGGGGGGGGGGS~~~~",
|
||||||
"~SGGGGGS~~",
|
"~SGGGGGGGGGGGGGS~~~~",
|
||||||
"~~SSSS~~~~",
|
"~~SSSSGGGSSSSS~~~~~~",
|
||||||
"~~~~~~~~~~"
|
"~~~~~SGGGGS~~~~~~~~~",
|
||||||
|
"~~~~SSGGGGSS~~~~~~~~",
|
||||||
|
"~~SSSGGGGGGSSSSS~~~~",
|
||||||
|
"~SSGSGSGGGSGSGGS~~~~",
|
||||||
|
"~SSGSGSGGMSGSGMS~~~~",
|
||||||
|
"~SGGMMMMGGGGGGS~~~~~",
|
||||||
|
"~SGMMMMMGGGGSSS~~~~~",
|
||||||
|
"~GGMMMMMGGGSSSSS~~~~",
|
||||||
|
"~SGGGGGGGSSSSSSS~~~~",
|
||||||
|
"~~SSSSSSSSSSSS~~~~~~",
|
||||||
|
"~~~~~~~~~~~~~~~~~~~~"
|
||||||
]
|
]
|
||||||
|
|
||||||
testmap :: IO PlayMap
|
testmap :: IO PlayMap
|
||||||
testmap = do
|
testmap = do
|
||||||
g <- getStdGen
|
g <- getStdGen
|
||||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
||||||
return $ listArray ((0,0),(9,9)) rawMap
|
return $ listArray ((0,0),(19,19)) rawMap
|
||||||
|
|
||||||
|
|
||||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user