diff --git a/Pioneers.cabal b/Pioneers.cabal index 4207527..2107bee 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -13,7 +13,11 @@ executable Pioneers OpenGL >=2.8.0 && <2.9, gtkglext >=0.12, containers >=0.5 && <0.6, - array >=0.4.0 && <0.5 + array >=0.4.0 && <0.5, + random >=1.0.1 && <1.1, + random >=1.0.1 && <1.1 ghc-options: -Wall - other-modules: Map.Coordinates + other-modules: + Map.Coordinates, + Map.Map diff --git a/src/Main.hs b/src/Main.hs index 2f6546b..6a0d6e6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,26 +6,80 @@ import qualified Graphics.UI.Gtk.OpenGL as GtkGL import Graphics.Rendering.OpenGL as GL import qualified Graphics.UI.Gtk.Gdk.Events as Event +import qualified Data.Array.IArray as A import Map.Coordinates +import Map.Map import Data.Maybe (fromMaybe) +import Debug.Trace -animationWaitTime = 3 -canvasWidth = 640 -canvasHeight = 480 +animationWaitTime = 3 :: Int +canvasWidth = 640 :: Int +canvasHeight = 480 :: Int + +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) + + +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)) + else + Vector3 (3*(fromIntegral cx)+1.5) 0.0 ((fromIntegral cz)) + , + case t of + Water -> Color3 0.5 0.5 1 :: Color3 GLfloat + Grass -> Color3 0.3 0.9 0.1 :: Color3 GLfloat + Sand -> Color3 0.9 0.85 0.7 :: Color3 GLfloat + Mountain -> Color3 0.5 0.5 0.5 :: Color3 GLfloat + ,getTileVertices m c) + +renderTile :: (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat]) -> IO () +renderTile (coord,c,ts) = + preservingMatrix $ do + color c + translate coord + _ <- renderPrimitive Polygon $ do + glNormal3f(0.0,0.0,1.0) + mapM vertex ts + return () + +drawSphere = do + renderQuadric (QuadricStyle + (Just Smooth) + GenerateTextureCoordinates + Outside + FillStyle) + (Sphere 1.0 48 48) + -- OpenGL polygon-function for drawing stuff. -display :: IO () -display = do - loadIdentity - -- Instead of glBegin ... glEnd there is renderPrimitive. - color (Color3 1 1 1 :: Color3 GLfloat) - renderPrimitive Polygon $ 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) +display :: PlayMap -> IO () +display t = + let + tiles = map (prepareRenderTile t) (A.assocs t) + in + do + 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) + position (Light 0) $= Vertex4 0.0 0.0 (2.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) @@ -57,6 +111,7 @@ reshape dims = do main :: IO () main = do + terrain <- testmap Gtk.initGUI -- Initialise the Gtk+ OpenGL extension -- (including reading various command line parameters) @@ -77,18 +132,20 @@ main = do -- (We can't initialise these things earlier since the GL resources that -- we are using wouldn't heve been setup yet) Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do - clearColor $= (Color4 0.0 0.0 0.0 0.0) + reconfigure canvasWidth canvasHeight + return () + {-clearColor $= (Color4 0.0 0.0 0.0 0.0) matrixMode $= Projection loadIdentity ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0 depthFunc $= Just Less - drawBuffer $= BackBuffers + drawBuffer $= BackBuffers-} -- Set the repaint handler Gtk.onExpose canvas $ \_ -> do GtkGL.withGLDrawingArea canvas $ \glwindow -> do GL.clear [GL.DepthBuffer, GL.ColorBuffer] - display + display terrain GtkGL.glDrawableSwapBuffers glwindow return True diff --git a/src/Map/Coordinates.hs b/src/Map/Coordinates.hs index 224d001..c5d5bf7 100644 --- a/src/Map/Coordinates.hs +++ b/src/Map/Coordinates.hs @@ -2,7 +2,10 @@ module Map.Coordinates --exports.. -(getTileVertices) +( +getTileVertices, +Tile +) where @@ -12,16 +15,15 @@ import qualified Data.Map as M ((!)) import Data.Maybe import Prelude as P import Data.Array.IArray as A +import Map.Map as PMap +import Debug.Trace - -type Coordinates = (Integer, Integer) +type Coordinates = (Int, Int) type Pos = (Float, Float) -- | a Tile is 1 unit in size. Due to hexagonality the real rendered Area is less. type Tile = Coordinates --- | The heights of a Map in a random accessible way. -type MapHeights = Map Coordinates Int instance Num Tile where (i,j) + (x,y) = (i+x, j+y) @@ -30,7 +32,7 @@ instance Num Tile where negate (x,y) = (negate x, negate y) abs (x,y) = (abs x, abs y) signum (_,_) = undefined - fromInteger a = (a,a) + fromInteger a = (fromIntegral a,fromIntegral a) instance Num Pos where (i,j) + (x,y) = (i+x, j+y) @@ -41,9 +43,6 @@ instance Num Pos where signum (_,_) = undefined fromInteger a = (fromIntegral a, fromIntegral a) -tileToPos :: Tile -> Pos -tileToPos (x,y) = (fromIntegral x, fromIntegral y) - data Neighbours = North | South @@ -63,67 +62,66 @@ data TileVertex = | VertexW deriving (Show, Eq, Ord) ---getGrid :: Coordinates -> Coordinates -> [] -getTileVertices :: MapHeights -> Tile -> [Vertex3 GLfloat] -getTileVertices heights t = let p = (listArray (0,5) $ P.map (+ tileToPos t) hexagon)::Array Int (Float,Float) in - P.map floatToVertex $ +getTileVertices :: PlayMap -> Tile -> [Vertex3 GLfloat] +getTileVertices heights t = let p = (listArray (0,5) hexagon) + ::Array Int (Float,Float) in + P.map floatToVertex $ [ - (fst $ p ! 0, snd $ p ! 0,fromMaybe 0.0 $ getHeight heights VertexNW t), - (fst $ p ! 1, snd $ p ! 1,fromMaybe 0.0 $ getHeight heights VertexNW t), - (fst $ p ! 2, snd $ p ! 2,fromMaybe 0.0 $ getHeight heights VertexNW t), - (fst $ p ! 3, snd $ p ! 3,fromMaybe 0.0 $ getHeight heights VertexNW t), - (fst $ p ! 4, snd $ p ! 4,fromMaybe 0.0 $ getHeight heights VertexNW t), - (fst $ p ! 5, snd $ p ! 5,fromMaybe 0.0 $ getHeight heights VertexNW t) + (fst $ p ! 0, getHeight heights VertexNW t, snd $ p ! 0), + (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 ! 5, getHeight heights VertexW t, snd $ p ! 5) ] -getHeight :: MapHeights -> TileVertex -> Tile -> Maybe Float -getHeight h v t@(_,ty) = +getHeight :: PlayMap -> TileVertex -> Tile -> Float +getHeight pm v t@(_,ty) = let - ! tileheight = fmap fromIntegral $ M.lookup t h - ! y = if even ty then -1 else 0 + h = heightLookup pm + ! tileheight = h t + ! y = if even ty then 1 else 0 in case v of - VertexNW -> do - c <- tileheight - n <- M.lookup (t+(0,-1)) h - nw <- M.lookup (t+(-1,y)) h - return $ (fromIntegral $ n+nw+c) / 3.0 - VertexNE -> do - c <- tileheight - n <- M.lookup (t+(0,-1)) h - ne <- M.lookup (t+(1,y)) h - return $ (fromIntegral $ n+ne+c) / 3.0 - VertexE -> do - c <- tileheight - ne <- M.lookup (t+(1,y)) h - se <- M.lookup (t+(1,y+1)) h - return $ (fromIntegral $ ne+se+c) / 3.0 - VertexSE -> do - c <- tileheight - s <- M.lookup (t+(0,1)) h - se <- M.lookup (t+(1,y+1)) h - return $ (fromIntegral $ s+se+c) / 3.0 - VertexSW -> do - c <- tileheight - s <- M.lookup (t+(0,1)) h - sw <- M.lookup (t+(-1,y+1)) h - return $ (fromIntegral $ s+sw+c) / 3.0 - VertexW -> do - c <- tileheight - sw <- M.lookup (t+(-1,y+1)) h - nw <- M.lookup (t+(-1,y)) h - return $ (fromIntegral $ sw+nw+c) / 3.0 + VertexNW -> let + n = h (t+(0,-1)) + nw = h (t+(-1,y)) + in (n + nw + tileheight) / 3.0 + VertexNE -> let + n = h (t+(0,-1)) + ne = h (t+(1,y)) + in (n + ne + tileheight) / 3.0 + VertexE -> let + ne = h (t+(1,y)) + se = h (t+(1,y+1)) + in (ne + se + tileheight) / 3.0 + VertexSE -> let + s = h (t+(0,1)) + se = h (t+(1,y+1)) + in (s + se + tileheight) / 3.0 + VertexSW -> let + s = h (t+(0,1)) + sw = h (t+(-1,y+1)) + in (s + sw + tileheight) / 3.0 + VertexW -> let + sw = h (t+(-1,y+1)) + nw = h(t+(-1,y)) + in (sw + nw + tileheight) / 3.0 +heightLookup :: PlayMap -> Tile -> Float +heightLookup hs t@(x,y) = if inRange (bounds hs) t then h else 0 + where + (h,_) = hs ! t hexagon :: [(Float,Float)] hexagon = [ - (0.2,0), - (0.6,0), + (-0.5,-1), + (0.5,-1), + (1,0), (0.5,1), - (1,0.6), - (1,0.2), - (0.5,0) + (-0.5,1), + (-1,0) ] diff --git a/src/Map/Map.hs b/src/Map/Map.hs new file mode 100644 index 0000000..7d2fcaa --- /dev/null +++ b/src/Map/Map.hs @@ -0,0 +1,51 @@ +module Map.Map + +where + +import System.Random +import Data.Array.IArray + +data TileType = + Grass + | Sand + | Water + | Mountain + deriving (Show, Eq) + +type MapEntry = ( + Float, -- ^ Height + TileType + ) + +type PlayMap = Array (Int, Int) MapEntry + +testMapTemplate :: [[String]] +testMapTemplate = [ + ["~~~~~~~~~~"], + ["~~SSSSSS~~"], + ["~SSGGGGS~~"], + ["~SSGGMMS~~"], + ["~SGGMMS~~~"], + ["~SGMMMS~~~"], + ["~GGGGGGS~~"], + ["~SGGGGGS~~"], + ["~~SSSS~~~~"], + ["~~~~~~~~~~"] + ] + +testmap :: IO PlayMap +testmap = do + g <- getStdGen + rawMap <- return $ map (parseTemplate (randoms g)) (concat $ concat testMapTemplate) + return $ listArray ((0,0),(9,9)) rawMap + + +parseTemplate :: [Int] -> Char -> MapEntry +parseTemplate (r:_) t = + case t of + '~' -> (0, Water) + 'S' -> (0, Sand) + '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..."