https://wiki.haskell.org/index.php?title=Gtk2Hs/Demos/GtkGLext/hello.hs&feed=atom&action=history
Gtk2Hs/Demos/GtkGLext/hello.hs - Revision history
2024-03-29T01:09:54Z
Revision history for this page on the wiki
MediaWiki 1.35.5
https://wiki.haskell.org/index.php?title=Gtk2Hs/Demos/GtkGLext/hello.hs&diff=21397&oldid=prev
Mrd: hello demo -- simple gtkglext demo
2008-06-20T01:21:51Z
<p>hello demo -- simple gtkglext demo</p>
<p><b>New page</b></p><div><haskell><br />
module Main (main) where<br />
<br />
import qualified Graphics.UI.Gtk as Gtk<br />
import Graphics.UI.Gtk (AttrOp((:=)))<br />
import qualified Graphics.UI.Gtk.OpenGL as GtkGL<br />
<br />
import Graphics.Rendering.OpenGL as GL<br />
<br />
main :: IO ()<br />
main = do <br />
Gtk.initGUI<br />
<br />
-- Initialise the Gtk+ OpenGL extension<br />
-- (including reading various command line parameters)<br />
GtkGL.initGL<br />
<br />
-- We need a OpenGL frame buffer configuration to be able to create other<br />
-- OpenGL objects.<br />
glconfig <- GtkGL.glConfigNew [GtkGL.GLModeRGBA,<br />
GtkGL.GLModeDepth,<br />
GtkGL.GLModeDouble]<br />
<br />
-- Create an OpenGL drawing area widget<br />
canvas <- GtkGL.glDrawingAreaNew glconfig<br />
<br />
Gtk.widgetSetSizeRequest canvas 250 250<br />
<br />
-- Initialise some GL setting just before the canvas first gets shown<br />
-- (We can't initialise these things earlier since the GL resources that<br />
-- we are using wouldn't heve been setup yet)<br />
Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do<br />
clearColor $= (Color4 0.0 0.0 0.0 0.0)<br />
matrixMode $= Projection<br />
loadIdentity<br />
ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0<br />
depthFunc $= Just Less<br />
drawBuffer $= BackBuffers<br />
<br />
-- Set the repaint handler<br />
Gtk.onExpose canvas $ \_ -> do<br />
GtkGL.withGLDrawingArea canvas $ \glwindow -> do<br />
GL.clear [GL.DepthBuffer, GL.ColorBuffer]<br />
display<br />
GtkGL.glDrawableSwapBuffers glwindow<br />
return True<br />
<br />
-- Setup the animation<br />
Gtk.timeoutAddFull (do<br />
Gtk.widgetQueueDraw canvas<br />
return True)<br />
Gtk.priorityDefaultIdle animationWaitTime<br />
<br />
--------------------------------<br />
-- Setup the rest of the GUI:<br />
--<br />
window <- Gtk.windowNew<br />
Gtk.onDestroy window Gtk.mainQuit<br />
Gtk.set window [ Gtk.containerBorderWidth := 8,<br />
Gtk.windowTitle := "Gtk2Hs + HOpenGL demo" ]<br />
<br />
vbox <- Gtk.vBoxNew False 4<br />
Gtk.set window [ Gtk.containerChild := vbox ]<br />
<br />
label <- Gtk.labelNew (Just "Gtk2Hs using OpenGL via HOpenGL!")<br />
button <- Gtk.buttonNewWithLabel "Close"<br />
Gtk.onClicked button Gtk.mainQuit<br />
Gtk.set vbox [ Gtk.containerChild := canvas,<br />
Gtk.containerChild := label,<br />
Gtk.containerChild := button ]<br />
<br />
Gtk.widgetShowAll window<br />
Gtk.mainGUI<br />
<br />
-- Draw the OpenGL polygon.<br />
display = do<br />
loadIdentity<br />
color (Color3 1 1 1 :: Color3 GLfloat)<br />
-- Instead of glBegin ... glEnd there is renderPrimitive. <br />
renderPrimitive Polygon $ do<br />
vertex (Vertex3 0.25 0.25 0.0 :: Vertex3 GLfloat)<br />
vertex (Vertex3 0.75 0.25 0.0 :: Vertex3 GLfloat)<br />
vertex (Vertex3 0.75 0.75 0.0 :: Vertex3 GLfloat)<br />
vertex (Vertex3 0.25 0.75 0.0 :: Vertex3 GLfloat)<br />
<br />
animationWaitTime = 3<br />
</haskell></div>
Mrd