Menu
▾
▴
[Gtk2hs-commit] (main branch): Move opengl demo to `gtk/gtkglext/demo`.
|
From: Andy S. <And...@co...> - 2010-05-01 17:42:53
|
Sat May 1 13:32:31 EDT 2010 Andy Stewart <laz...@gm...>
* Move opengl demo to `gtk/gtkglext/demo`.
Ignore-this: 5c11b627899153dfec86424037ad147e
hunk ./demo/opengl/Makefile 1
-
-PROG = cube
-SOURCES = RotatingCube.hs
-
-$(PROG) : $(SOURCES)
- $(HC) --make $< -o $@ $(HCFLAGS)
-
-clean:
- rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
-
-HC=ghc
rmfile ./demo/opengl/Makefile
hunk ./demo/opengl/RotatingCube.hs 1
-module Main (main) where
-
-import Data.IORef
-
-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
-
-main :: IO ()
-main = do [_$_]
- 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 350 350
-
- -- 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
-
- ref <- newIORef (0, 0, 0)
-
- -- Set the repaint handler
- Gtk.onExpose canvas $ \_ -> do
- GtkGL.withGLDrawingArea canvas $ \glwindow -> do
- (r_x, r_y, r_z) <- readIORef ref
- GL.clear [GL.DepthBuffer, GL.ColorBuffer]
- drawCube (r_x, r_y, r_z)
- GtkGL.glDrawableSwapBuffers glwindow
- return True
-
- -- Setup the animation
- Gtk.timeoutAddFull (do
- modifyIORef ref (\(r_x, r_y, r_z) -> (r_x + dx, r_y + dy, r_z + dz))
- Gtk.widgetQueueDraw canvas
- return True)
- Gtk.priorityDefaultIdle animationWaitTime
-
- --------------------------------
- -- Setup the rest of the GUI:
- --
- window <- Gtk.windowNew
- Gtk.onDestroy window Gtk.mainQuit
- Gtk.set window [ Gtk.containerBorderWidth := 8,
- Gtk.windowTitle := "Gtk2Hs + HOpenGL demo" ]
-
- vbox <- Gtk.vBoxNew False 4
- Gtk.set window [ Gtk.containerChild := vbox ]
-
- label <- Gtk.labelNew (Just "Gtk2Hs using OpenGL via HOpenGL!")
- button <- Gtk.buttonNewWithLabel "Close"
- Gtk.onClicked button Gtk.mainQuit
- Gtk.set vbox [ Gtk.containerChild := canvas,
- Gtk.containerChild := label,
- Gtk.containerChild := button ]
-
- Gtk.widgetShowAll window
- Gtk.mainGUI
-
-drawCube :: (GLfloat, GLfloat, GLfloat) -> IO ()
-drawCube (r_x, r_y, r_z) = do
- loadIdentity
- rotate r_x (Vector3 1 0 0 :: Vector3 GLfloat)
- rotate r_y (Vector3 0 1 0 :: Vector3 GLfloat)
- rotate r_z (Vector3 0 0 1 :: Vector3 GLfloat)
- mapM_ drawFace (zip colours faces)
-
- where drawFace :: (Color3 GLfloat, IO ()) -> IO ()
- drawFace (colour, face) = do color colour
- renderPrimitive Quads face
- faces = map (mapM_ vertex) faceVertices :: [IO ()]
- colours = [red, green, yellow, blue, purple, cyan]
- faceVertices = [
- [Vertex3 to to to,
- Vertex3 from to to,
- Vertex3 from from to,
- Vertex3 to from to],
- [Vertex3 to to from,
- Vertex3 from to from,
- Vertex3 from from from,
- Vertex3 to from from],
- [Vertex3 to to to,
- Vertex3 from to to,
- Vertex3 from to from,
- Vertex3 to to from],
- [Vertex3 to from to,
- Vertex3 from from to,
- Vertex3 from from from,
- Vertex3 to from from],
- [Vertex3 to to to,
- Vertex3 to from to,
- Vertex3 to from from,
- Vertex3 to to from],
- [Vertex3 from to to,
- Vertex3 from from to,
- Vertex3 from from from,
- Vertex3 from to from]]
-
-to, from :: GLfloat
-to = 0.4
-from = -0.4
-
-animationWaitTime :: Int
-animationWaitTime = 3
-
-dx, dy, dz :: GLfloat
-dx = 0.1
-dy = 0.3
-dz = 0.7
-
-red, green, yellow, blue, purple, cyan :: Color3 GLfloat
-red = Color3 1 0 0
-green = Color3 0 1 0
-yellow = Color3 1 1 0
-blue = Color3 0 0 1
-purple = Color3 1 0 1
-cyan = Color3 0 1 1
rmfile ./demo/opengl/RotatingCube.hs
rmdir ./demo/opengl
adddir ./gtkglext/demo
addfile ./gtkglext/demo/Makefile
hunk ./gtkglext/demo/Makefile 1
+
+PROG = cube
+SOURCES = RotatingCube.hs
+
+$(PROG) : $(SOURCES)
+ $(HC) --make $< -o $@ $(HCFLAGS)
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
+
+HC=ghc
addfile ./gtkglext/demo/RotatingCube.hs
hunk ./gtkglext/demo/RotatingCube.hs 1
+module Main (main) where
+
+import Data.IORef
+
+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
+
+main :: IO ()
+main = do [_$_]
+ 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 350 350
+
+ -- 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
+
+ ref <- newIORef (0, 0, 0)
+
+ -- Set the repaint handler
+ Gtk.onExpose canvas $ \_ -> do
+ GtkGL.withGLDrawingArea canvas $ \glwindow -> do
+ (r_x, r_y, r_z) <- readIORef ref
+ GL.clear [GL.DepthBuffer, GL.ColorBuffer]
+ drawCube (r_x, r_y, r_z)
+ GtkGL.glDrawableSwapBuffers glwindow
+ return True
+
+ -- Setup the animation
+ Gtk.timeoutAddFull (do
+ modifyIORef ref (\(r_x, r_y, r_z) -> (r_x + dx, r_y + dy, r_z + dz))
+ Gtk.widgetQueueDraw canvas
+ return True)
+ Gtk.priorityDefaultIdle animationWaitTime
+
+ --------------------------------
+ -- Setup the rest of the GUI:
+ --
+ window <- Gtk.windowNew
+ Gtk.onDestroy window Gtk.mainQuit
+ Gtk.set window [ Gtk.containerBorderWidth := 8,
+ Gtk.windowTitle := "Gtk2Hs + HOpenGL demo" ]
+
+ vbox <- Gtk.vBoxNew False 4
+ Gtk.set window [ Gtk.containerChild := vbox ]
+
+ label <- Gtk.labelNew (Just "Gtk2Hs using OpenGL via HOpenGL!")
+ button <- Gtk.buttonNewWithLabel "Close"
+ Gtk.onClicked button Gtk.mainQuit
+ Gtk.set vbox [ Gtk.containerChild := canvas,
+ Gtk.containerChild := label,
+ Gtk.containerChild := button ]
+
+ Gtk.widgetShowAll window
+ Gtk.mainGUI
+
+drawCube :: (GLfloat, GLfloat, GLfloat) -> IO ()
+drawCube (r_x, r_y, r_z) = do
+ loadIdentity
+ rotate r_x (Vector3 1 0 0 :: Vector3 GLfloat)
+ rotate r_y (Vector3 0 1 0 :: Vector3 GLfloat)
+ rotate r_z (Vector3 0 0 1 :: Vector3 GLfloat)
+ mapM_ drawFace (zip colours faces)
+
+ where drawFace :: (Color3 GLfloat, IO ()) -> IO ()
+ drawFace (colour, face) = do color colour
+ renderPrimitive Quads face
+ faces = map (mapM_ vertex) faceVertices :: [IO ()]
+ colours = [red, green, yellow, blue, purple, cyan]
+ faceVertices = [
+ [Vertex3 to to to,
+ Vertex3 from to to,
+ Vertex3 from from to,
+ Vertex3 to from to],
+ [Vertex3 to to from,
+ Vertex3 from to from,
+ Vertex3 from from from,
+ Vertex3 to from from],
+ [Vertex3 to to to,
+ Vertex3 from to to,
+ Vertex3 from to from,
+ Vertex3 to to from],
+ [Vertex3 to from to,
+ Vertex3 from from to,
+ Vertex3 from from from,
+ Vertex3 to from from],
+ [Vertex3 to to to,
+ Vertex3 to from to,
+ Vertex3 to from from,
+ Vertex3 to to from],
+ [Vertex3 from to to,
+ Vertex3 from from to,
+ Vertex3 from from from,
+ Vertex3 from to from]]
+
+to, from :: GLfloat
+to = 0.4
+from = -0.4
+
+animationWaitTime :: Int
+animationWaitTime = 3
+
+dx, dy, dz :: GLfloat
+dx = 0.1
+dy = 0.3
+dz = 0.7
+
+red, green, yellow, blue, purple, cyan :: Color3 GLfloat
+red = Color3 1 0 0
+green = Color3 0 1 0
+yellow = Color3 1 1 0
+blue = Color3 0 0 1
+purple = Color3 1 0 1
+cyan = Color3 0 1 1
|
