Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

started work on Coordinate-System for the Map

Browse Source
This commit is contained in:
Stefan Dresselhaus
2013-12-29 01:05:01 +01:00
parent f23ef3cadb
commit 47788b4ef0
3 changed files with 187 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/Main.hs
View File

@ -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