fixed map
- map is now displayed correctly - camera is adjusted - created ProgramState as TVar for concurrent reading/writing
This commit is contained in:
parent
14ce8c5986
commit
55a873022b
@ -15,7 +15,9 @@ executable Pioneers
|
||||
containers >=0.5 && <0.6,
|
||||
array >=0.4.0 && <0.5,
|
||||
random >=1.0.1 && <1.1,
|
||||
random >=1.0.1 && <1.1
|
||||
random >=1.0.1 && <1.1,
|
||||
text >=0.11.3 && <0.12,
|
||||
stm >=2.4.2 && <2.5
|
||||
ghc-options: -Wall
|
||||
other-modules:
|
||||
Map.Coordinates,
|
||||
|
||||
73
src/Main.hs
73
src/Main.hs
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Main where
|
||||
|
||||
import qualified Graphics.UI.Gtk as Gtk
|
||||
@ -13,12 +14,32 @@ import Map.Map
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Debug.Trace
|
||||
import Data.IntSet as IS
|
||||
import Data.IORef
|
||||
|
||||
import Prelude as P
|
||||
import Control.Monad
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.STM
|
||||
|
||||
data ProgramState = PS { keysPressed :: IntSet
|
||||
, px :: GLfloat
|
||||
, py :: GLfloat
|
||||
, pz :: GLfloat
|
||||
, heading :: GLfloat
|
||||
, pitch :: GLfloat
|
||||
, dx :: GLfloat
|
||||
, dz :: GLfloat
|
||||
, dheading :: GLfloat
|
||||
, dpitch :: GLfloat }
|
||||
|
||||
animationWaitTime = 3 :: Int
|
||||
canvasWidth = 640 :: Int
|
||||
canvasHeight = 480 :: Int
|
||||
|
||||
|
||||
-- TODO: Put render-stuff in render-module
|
||||
|
||||
glTexCoord2f (x,y) = texCoord (TexCoord2 x y :: TexCoord2 GLfloat)
|
||||
glVertex3f (x,y,z) = vertex (Vertex3 x y z :: Vertex3 GLfloat)
|
||||
glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
|
||||
@ -27,10 +48,10 @@ glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
|
||||
prepareRenderTile :: PlayMap -> ((Int,Int),MapEntry) -> (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
||||
prepareRenderTile m (c@(cx,cz),(_,t)) =
|
||||
(
|
||||
if even cz then
|
||||
Vector3 (3*(fromIntegral cx)) 0.0 ((fromIntegral cz))
|
||||
if even cx then
|
||||
Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz))
|
||||
else
|
||||
Vector3 (3*(fromIntegral cx)+1.5) 0.0 ((fromIntegral cz))
|
||||
Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz)-1)
|
||||
,
|
||||
case t of
|
||||
Water -> Color3 0.5 0.5 1 :: Color3 GLfloat
|
||||
@ -58,28 +79,30 @@ drawSphere = do
|
||||
(Sphere 1.0 48 48)
|
||||
|
||||
-- OpenGL polygon-function for drawing stuff.
|
||||
display :: PlayMap -> IO ()
|
||||
display t =
|
||||
display :: TVar ProgramState -> PlayMap -> IO ()
|
||||
display state t =
|
||||
let
|
||||
tiles = map (prepareRenderTile t) (A.assocs t)
|
||||
tiles = P.map (prepareRenderTile t) (A.assocs t)
|
||||
in
|
||||
do
|
||||
ps@PS {
|
||||
px = px
|
||||
, py = py
|
||||
, pz = pz
|
||||
, pitch = pitch
|
||||
, heading = heading }
|
||||
<- readTVarIO state
|
||||
loadIdentity
|
||||
GL.rotate (60) (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
|
||||
--GL.rotate (-20) (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
|
||||
translate (Vector3 (-15) (-10) (-15)::Vector3 GLfloat)
|
||||
GL.rotate pitch (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
|
||||
GL.rotate heading (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
|
||||
translate (Vector3 (-px) (-py) (-pz)::Vector3 GLfloat)
|
||||
|
||||
position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
|
||||
|
||||
-- Instead of glBegin ... glEnd there is renderPrimitive.
|
||||
--trace (show tiles) $
|
||||
mapM_ renderTile tiles
|
||||
return ()
|
||||
{- color (Color3 1 1 1 :: Color3 GLfloat)
|
||||
renderPrimitive LineLoop $ do
|
||||
vertex (Vertex3 0.25 0.25 0.0 :: Vertex3 GLfloat)
|
||||
vertex (Vertex3 0.75 0.25 0.0 :: Vertex3 GLfloat)
|
||||
vertex (Vertex3 0.75 0.75 0.0 :: Vertex3 GLfloat)
|
||||
vertex (Vertex3 0.25 0.75 0.0 :: Vertex3 GLfloat) -}
|
||||
|
||||
--Adjust size to given dimensions
|
||||
reconfigure :: Int -> Int -> IO (Int, Int)
|
||||
@ -105,14 +128,26 @@ reshape dims = do
|
||||
let (w, h) = if width <= height
|
||||
then (fromIntegral height, fromIntegral width )
|
||||
else (fromIntegral width, fromIntegral height)
|
||||
perspective 60.0 (fromIntegral canvasWidth / fromIntegral canvasHeight) 1.0 20.0
|
||||
-- open, aspect-ratio, near-plane, far-plane
|
||||
perspective 60.0 (fromIntegral canvasWidth / fromIntegral canvasHeight) 1.0 100.0
|
||||
matrixMode $= Modelview 0
|
||||
loadIdentity
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
terrain <- testmap
|
||||
Gtk.initGUI
|
||||
! terrain <- testmap
|
||||
-- create TVar using unsafePerformIO -> currently no other thread -> OK
|
||||
state <- newTVarIO $ PS { keysPressed = IS.empty
|
||||
, px = 7.5
|
||||
, py = 20
|
||||
, pz = 15
|
||||
, heading = 0
|
||||
, pitch = 60
|
||||
, dx = 0
|
||||
, dz = 0
|
||||
, dheading = 0
|
||||
, dpitch = 0}
|
||||
trace (show terrain) Gtk.initGUI
|
||||
-- Initialise the Gtk+ OpenGL extension
|
||||
-- (including reading various command line parameters)
|
||||
GtkGL.initGL
|
||||
@ -166,7 +201,7 @@ main = do
|
||||
Gtk.onExpose canvas $ \_ -> do
|
||||
GtkGL.withGLDrawingArea canvas $ \glwindow -> do
|
||||
GL.clear [GL.DepthBuffer, GL.ColorBuffer]
|
||||
display terrain
|
||||
display state terrain
|
||||
GtkGL.glDrawableSwapBuffers glwindow
|
||||
return True
|
||||
|
||||
|
||||
@ -77,11 +77,11 @@ getTileVertices heights t = let p = (listArray (0,5) hexagon)
|
||||
]
|
||||
|
||||
getHeight :: PlayMap -> TileVertex -> Tile -> Float
|
||||
getHeight pm v t@(_,ty) =
|
||||
getHeight pm v t@(tx,_) =
|
||||
let
|
||||
h = heightLookup pm
|
||||
! tileheight = h t
|
||||
! y = if even ty then 1 else 0
|
||||
! y = if even tx then 0 else -1
|
||||
in
|
||||
case v of
|
||||
VertexNW -> let
|
||||
@ -110,7 +110,7 @@ getHeight pm v t@(_,ty) =
|
||||
in (sw + nw + tileheight) / 3.0
|
||||
|
||||
heightLookup :: PlayMap -> Tile -> Float
|
||||
heightLookup hs t@(x,y) = if inRange (bounds hs) t then h else 0
|
||||
heightLookup hs t = if inRange (bounds hs) t then h else 0
|
||||
where
|
||||
(h,_) = hs ! t
|
||||
|
||||
|
||||
@ -1,9 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Map.Map
|
||||
|
||||
where
|
||||
|
||||
import System.Random
|
||||
import Data.Array.IArray
|
||||
import Data.Text as T
|
||||
import Prelude as P
|
||||
|
||||
data TileType =
|
||||
Grass
|
||||
@ -19,33 +22,36 @@ type MapEntry = (
|
||||
|
||||
type PlayMap = Array (Int, Int) MapEntry
|
||||
|
||||
testMapTemplate :: [[String]]
|
||||
testMapTemplate = [
|
||||
["~~~~~~~~~~"],
|
||||
["~~SSSSSS~~"],
|
||||
["~SSGGGGS~~"],
|
||||
["~SSGGMMS~~"],
|
||||
["~SGGMMS~~~"],
|
||||
["~SGMMMS~~~"],
|
||||
["~GGGGGGS~~"],
|
||||
["~SGGGGGS~~"],
|
||||
["~~SSSS~~~~"],
|
||||
["~~~~~~~~~~"]
|
||||
-- if writing in ASCII-Format transpose so i,j -> y,x
|
||||
-- row-minor -> row-major
|
||||
testMapTemplate :: [Text]
|
||||
testMapTemplate = T.transpose [
|
||||
"~~~~~~~~~~",
|
||||
"~~SSSSSS~~",
|
||||
"~SSGGGGS~~",
|
||||
"~SSGGMMS~~",
|
||||
"~SGGMMS~~~",
|
||||
"~SGMMMS~~~",
|
||||
"~GGGGGGS~~",
|
||||
"~SGGGGGS~~",
|
||||
"~~SSSS~~~~",
|
||||
"~~~~~~~~~~"
|
||||
]
|
||||
|
||||
testmap :: IO PlayMap
|
||||
testmap = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ map (parseTemplate (randoms g)) (concat $ concat testMapTemplate)
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
||||
return $ listArray ((0,0),(9,9)) rawMap
|
||||
|
||||
|
||||
parseTemplate :: [Int] -> Char -> MapEntry
|
||||
parseTemplate (r:_) t =
|
||||
case t of
|
||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||
parseTemplate (r:rs) t =
|
||||
(case T.head t of
|
||||
'~' -> (0, Water)
|
||||
'S' -> (0, Sand)
|
||||
'G' -> ((fromIntegral $ r `mod` 3)/3,Grass)
|
||||
'M' -> ((fromIntegral $ r `mod` 3 + 2)/3, Mountain)
|
||||
'G' -> (fromIntegral (r `mod` 3) / 3,Grass)
|
||||
'M' -> (fromIntegral (r `mod` 3 + 2) / 3, Mountain)
|
||||
_ -> error "invalid template format for map"
|
||||
parseTemplate [] _ = error "out of randoms..."
|
||||
):parseTemplate rs (T.tail t)
|
||||
parseTemplate [] _ = error "out of randoms.."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user