From 26fc2dc7114c7b9bbbf35d4ef6f5bf0b39f4b7d6 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Mon, 23 Dec 2013 00:00:51 +0100
Subject: [PATCH] added openGL-demo

---
 COMPILING      |  1 +
 Pioneers.cabal |  4 ++-
 src/Main.hs    | 97 ++++++++++++++++++++++++++++++++++++++++++++------
 3 files changed, 90 insertions(+), 12 deletions(-)

diff --git a/COMPILING b/COMPILING
index 63d00dc..608a632 100644
--- a/COMPILING
+++ b/COMPILING
@@ -1,5 +1,6 @@
 set up external dependencies:
 
+> sudo apt-get install libgtkglext1-dev
 > cabal install gtk2hs-buildtools
 
 make sure these are in your PATH (e.g. include $HOME/.cabal/bin in your $PATH)
diff --git a/Pioneers.cabal b/Pioneers.cabal
index fb1c76a..12d4c7f 100644
--- a/Pioneers.cabal
+++ b/Pioneers.cabal
@@ -9,6 +9,8 @@ executable Pioneers
   main-is:         Main.hs
   build-depends:   
                   base >= 4,
-                  gtk
+                  gtk,
+                  OpenGL >=2.8.0 && <2.9,
+                  gtkglext >=0.12
   ghc-options:     -Wall
 
diff --git a/src/Main.hs b/src/Main.hs
index fa5963d..24ffdb6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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 = do
-  initGUI
-  window <- windowNew
-  button <- buttonNew
-  set window [ containerBorderWidth := 10,
-               containerChild := button ]
-  set button [ buttonLabel := "Hello World" ]
-  onClicked button (putStrLn "Hello World")
-  onDestroy window mainQuit
-  widgetShowAll window
-  mainGUI
+  Gtk.initGUI
+  -- Initialise the Gtk+ OpenGL extension
+  -- (including reading various command line parameters)
+  GtkGL.initGL
+
+  -- We need a OpenGL frame buffer configuration to be able to create other
+  -- OpenGL objects.
+  glconfig <- GtkGL.glConfigNew [GtkGL.GLModeRGBA,
+                                 GtkGL.GLModeDepth,
+                                 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