diff --git a/Pioneers.cabal b/Pioneers.cabal index 12d4c7f..5dad066 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -11,6 +11,8 @@ executable Pioneers base >= 4, gtk, OpenGL >=2.8.0 && <2.9, - gtkglext >=0.12 + gtkglext >=0.12, + containers >=0.5 && <0.6 ghc-options: -Wall + other-modules: Map.Coordinates diff --git a/src/Main.hs b/src/Main.hs index 853e5a7..87c3a6d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,20 +4,21 @@ import Graphics.UI.Gtk (AttrOp((:=))) import qualified Graphics.UI.Gtk.OpenGL as GtkGL import Graphics.Rendering.OpenGL as GL +import qualified Graphics.UI.Gtk.Gdk.Events as Event + +import Map.Coordinates + +import Data.Maybe (fromMaybe) animationWaitTime = 3 +canvasWidth = 640 +canvasHeight = 480 -- OpenGL polygon-function for drawing stuff. display :: IO () display = do loadIdentity - color (Color3 1 0.5 0.5 :: Color3 GLfloat) -- Instead of glBegin ... glEnd there is renderPrimitive. - renderPrimitive Polygon $ do - vertex (Vertex3 (-1.0) (-1.0) 0.0 :: Vertex3 GLfloat) - vertex (Vertex3 (1.0) (-1.0) 0.0 :: Vertex3 GLfloat) - vertex (Vertex3 (1.0) (1.0) 0.0 :: Vertex3 GLfloat) - vertex (Vertex3 (-1.0) (1.0) 0.0 :: Vertex3 GLfloat) color (Color3 1 1 1 :: Color3 GLfloat) renderPrimitive Polygon $ do vertex (Vertex3 0.25 0.25 0.0 :: Vertex3 GLfloat) @@ -25,6 +26,33 @@ display = do 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) +reconfigure w h = do + -- maintain aspect ratio + let aspectRatio = (fromIntegral canvasWidth) / (fromIntegral canvasHeight) + (w1, h1) = (fromIntegral w, (fromIntegral w) / aspectRatio) + (w2, h2) = ((fromIntegral h) * aspectRatio, fromIntegral h) + (w', h') = if h1 <= fromIntegral h + then (floor w1, floor h1) + else (floor w2, floor h2) + reshape $ Just (w', h') + return (w', h') + +-- Called by reconfigure to fix the OpenGL viewport according to the +-- dimensions of the widget, appropriately. +reshape :: Maybe (Int, Int) -> IO () +reshape dims = do + let (width, height) = fromMaybe (canvasWidth, canvasHeight) dims + viewport $= (Position 0 0, Size (fromIntegral width) (fromIntegral height)) + matrixMode $= Projection + loadIdentity + 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 + matrixMode $= Modelview 0 + loadIdentity main :: IO () main = do @@ -42,7 +70,7 @@ main = do -- Create an OpenGL drawing area widget canvas <- GtkGL.glDrawingAreaNew glconfig - Gtk.widgetSetSizeRequest canvas 500 350 + Gtk.widgetSetSizeRequest canvas canvasWidth canvasHeight -- Initialise some GL setting just before the canvas first gets shown -- (We can't initialise these things earlier since the GL resources that @@ -76,6 +104,7 @@ main = do window <- Gtk.windowNew button <- Gtk.buttonNew exitButton <- Gtk.buttonNew + label <- Gtk.labelNew (Just "Gtk2Hs using OpenGL via HOpenGL!") vbox <- Gtk.vBoxNew False 4 --Wrench them together @@ -88,13 +117,29 @@ main = do Gtk.set vbox [ Gtk.containerChild := canvas, Gtk.containerChild := button, - Gtk.containerChild := exitButton + Gtk.containerChild := exitButton, + Gtk.containerChild := label ] Gtk.afterClicked button (putStrLn "Hello World") Gtk.afterClicked exitButton Gtk.mainQuit Gtk.onDestroy window Gtk.mainQuit + -- "reshape" event handler + Gtk.onConfigure canvas $ \ (Event.Configure _ _ _ w h) -> do + (w', h') <- reconfigure w h + {- texW <- Gtk.pixbufGetWidth pb + texH <- Gtk.pixbufGetHeight pb + texBPS <- Gtk.pixbufGetBitsPerSample pb + texRS <- Gtk.pixbufGetRowstride pb + texNCh <- Gtk.pixbufGetNChannels pb-} + Gtk.labelSetText label $ unwords ["Width:",show w',"Height:",show h'{- , + "TexW:",show texW,"TexH:",show texH, + "BPS:",show texBPS,"RS:",show texRS, + "NCh:",show texNCh-}] + return True + + Gtk.widgetShowAll window Gtk.mainGUI diff --git a/src/Map/Coordinates.hs b/src/Map/Coordinates.hs new file mode 100644 index 0000000..b85835b --- /dev/null +++ b/src/Map/Coordinates.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, BangPatterns #-} +module Map.Coordinates + +--exports.. +(getTileVertices) + +where + +import Graphics.Rendering.OpenGL as GL +import Data.Map as M +import Data.IntMap +import Data.Maybe +import Prelude as P + + + +type Coordinates = (Integer, Integer) +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) + (i,j) * (x,y) = (i*x, j*y) + (i,j) - (x,y) = (i-x, j-y) + negate (x,y) = (negate x, negate y) + abs (x,y) = (abs x, abs y) + signum (_,_) = undefined + fromInteger a = (a,a) + +instance Num Pos where + (i,j) + (x,y) = (i+x, j+y) + (i,j) * (x,y) = (i*x, j*y) + (i,j) - (x,y) = (i-x, j-y) + negate (x,y) = (negate x, negate y) + abs (x,y) = (abs x, abs y) + signum (_,_) = undefined + fromInteger a = (fromIntegral a, fromIntegral a) + +tileToPos :: Tile -> Pos +tileToPos (x,y) = (fromIntegral x, fromIntegral y) + +data Neighbours = + North + | South + | NorthEast + | SouthEast + | NorthWest + | SouthWest + deriving (Show, Eq) + +-- | Ordered Vertice-List for rendering (clockwise) +data TileVertex = + VertexNW + | VertexNE + | VertexE + | VertexSE + | VertexSW + | VertexW + deriving (Show, Eq, Ord) + +--getGrid :: Coordinates -> Coordinates -> [] + +getTileVertices :: MapHeights -> Tile -> [Vertex3 GLfloat] +getTileVertices heights t@(x,y) = let p = P.map (+ tileToPos t) hexagon 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) + ] + +getHeight :: MapHeights -> TileVertex -> Tile -> Maybe Float +getHeight h v t@(_,ty) = + let + ! tileheight = fmap fromIntegral $ M.lookup t h + ! 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 + + +hexagon :: IntMap (Float,Float) +hexagon = undefined {- fromList [ + (0.2,0), + (0.6,0), + (0.5,1), + (1,0.6), + (1,0.2), + (0.5,0) + ]-} + + +-- | convert triple of floats to GLfloat (== CFloat) +floatToVertex :: (Float, Float, Float) -> Vertex3 GLfloat +floatToVertex (a,b,c) = Vertex3 (realToFrac a::GLfloat) (realToFrac b::GLfloat) (realToFrac c::GLfloat)