added openGL-demo

This commit is contained in:
Nicole Dresselhaus 2013-12-23 00:00:51 +01:00
parent c46e24befd
commit 26fc2dc711
3 changed files with 90 additions and 12 deletions

View File

@ -1,5 +1,6 @@
set up external dependencies: set up external dependencies:
> sudo apt-get install libgtkglext1-dev
> cabal install gtk2hs-buildtools > cabal install gtk2hs-buildtools
make sure these are in your PATH (e.g. include $HOME/.cabal/bin in your $PATH) make sure these are in your PATH (e.g. include $HOME/.cabal/bin in your $PATH)

View File

@ -9,6 +9,8 @@ executable Pioneers
main-is: Main.hs main-is: Main.hs
build-depends: build-depends:
base >= 4, base >= 4,
gtk gtk,
OpenGL >=2.8.0 && <2.9,
gtkglext >=0.12
ghc-options: -Wall ghc-options: -Wall

View File

@ -1,15 +1,90 @@
import Graphics.UI.Gtk import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk (AttrOp((:=)))
import qualified Graphics.UI.Gtk.OpenGL as GtkGL
import Graphics.Rendering.OpenGL as GL
animationWaitTime = 3
-- OpenGL polygon-function for drawing stuff.
display = do
loadIdentity
color (Color3 1 1 1 :: Color3 GLfloat)
-- Instead of glBegin ... glEnd there is renderPrimitive.
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)
main :: IO () main :: IO ()
main = do main = do
initGUI Gtk.initGUI
window <- windowNew -- Initialise the Gtk+ OpenGL extension
button <- buttonNew -- (including reading various command line parameters)
set window [ containerBorderWidth := 10, GtkGL.initGL
containerChild := button ]
set button [ buttonLabel := "Hello World" ] -- We need a OpenGL frame buffer configuration to be able to create other
onClicked button (putStrLn "Hello World") -- OpenGL objects.
onDestroy window mainQuit glconfig <- GtkGL.glConfigNew [GtkGL.GLModeRGBA,
widgetShowAll window GtkGL.GLModeDepth,
mainGUI GtkGL.GLModeDouble]
-- Create an OpenGL drawing area widget
canvas <- GtkGL.glDrawingAreaNew glconfig
Gtk.widgetSetSizeRequest canvas 250 250
-- Initialise some GL setting just before the canvas first gets shown
-- (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)
matrixMode $= Projection
loadIdentity
ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0
depthFunc $= Just Less
drawBuffer $= BackBuffers
-- Set the repaint handler
Gtk.onExpose canvas $ \_ -> do
GtkGL.withGLDrawingArea canvas $ \glwindow -> do
GL.clear [GL.DepthBuffer, GL.ColorBuffer]
display
GtkGL.glDrawableSwapBuffers glwindow
return True
-- Setup the animation
Gtk.timeoutAddFull (do
Gtk.widgetQueueDraw canvas
return True)
Gtk.priorityDefaultIdle animationWaitTime
--------------------------------
-- Setup the rest of the GUI:
--
-- Objects
window <- Gtk.windowNew
button <- Gtk.buttonNew
exitButton <- Gtk.buttonNew
vbox <- Gtk.vBoxNew False 4
--Wrench them together
Gtk.set window [ Gtk.containerBorderWidth := 10,
Gtk.containerChild := vbox,
Gtk.windowTitle := "Pioneer" ]
Gtk.set button [ Gtk.buttonLabel := "Hello World" ]
Gtk.set exitButton [ Gtk.buttonLabel := "Quit" ]
Gtk.set vbox [
Gtk.containerChild := canvas,
Gtk.containerChild := button,
Gtk.containerChild := exitButton
]
Gtk.onClicked button (putStrLn "Hello World")
Gtk.onClicked exitButton Gtk.mainQuit
Gtk.onDestroy window Gtk.mainQuit
Gtk.widgetShowAll window
Gtk.mainGUI