diff --git a/Pioneers.cabal b/Pioneers.cabal index 2107bee..3771ed4 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -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, diff --git a/src/Main.hs b/src/Main.hs index 554b55c..ed3f362 100644 --- a/src/Main.hs +++ b/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 - 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 (20.0) 1.0 + ps@PS { + px = px + , py = py + , pz = pz + , pitch = pitch + , heading = heading } + <- readTVarIO state + loadIdentity + 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) - -- 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) -} + 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 () --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 diff --git a/src/Map/Coordinates.hs b/src/Map/Coordinates.hs index c5d5bf7..d0dcd25 100644 --- a/src/Map/Coordinates.hs +++ b/src/Map/Coordinates.hs @@ -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 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 7d2fcaa..63496fd 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -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.."