Animation

A lot of the OpenGL programming is centered around the program being prepared to launch some sequenc when some event occurs. Let's use this to build a rotating version of our bunch of points up there. In order to do things over time, we're going to be using the global callbacks idleCallback and timerCallback. So, we'll modify the structure of our files a bit - starting from the top.

We'll need a new callback. And we'll also need a state variable of our own, which in turn needs to be fed to all functions that may need to use it. Incorporating these changes, we get a new HelloWorld.hs:

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Bindings
import Data.IORef

main = do
  (progname,_) <- getArgsAndInitialize
  createWindow "Hello World"
  reshapeCallback $= Just reshape
  keyboardMouseCallback $= Just keyboardMouse
  angle <- newIORef 0.0
  displayCallback $= (display angle)
  idleCallback $= Just (idle angle)
  mainLoop

module Bindings (idle,display,reshape,keyboardMouse) where

Display.hs:

module Display (display,idle) where

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef

import Cube
import Points

display angle = do
  clear [ColorBuffer]
  a <- get angle
  rotate a $ Vector3 0 0 (1::GLfloat)
  scale 0.7 0.7 (0.7::GLfloat)
  mapM_ (\(x,y,z) -> preservingMatrix $ do
    color $ Color3 ((x+1.0)/2.0) ((y+1.0)/2.0) ((z+1.0)/2.0)
    translate $ Vector3 x y z
    cube (0.1::GLfloat)
    ) $ points 7
  flush

idle angle = do
  a <- get angle
  angle $= a + 0.1

Now, running this program makes a couple of different things painfully obvious. One is that things flicker. Another is that our ring is shrinking violently. The shrinking is due to our forgetting to reset all our transformations before we apply the next, and the flicker is because we're redrawing an entire picture step by step. Much smoother animation'll be had if we use a double buffering technique. Now, this isn't at all hard. We need to modify a few places - tell HOpenGL that we want to do doublebuffering and also when we want to swap the ready drawn canvas for the one on the screen. So, we modify, again, HelloWorld.hs:

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef
import Bindings

main = do
  (progname,_) <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered]
  createWindow "Hello World"
  reshapeCallback $= Just reshape
  keyboardMouseCallback $= Just keyboardMouse
  angle <- newIORef 0.0
  idleCallback $= Just (idle angle)
  displayCallback $= (display angle)
  mainLoop

and we also need to modify Display.hs to implement the bufferswapping. While we're at it, we add the command loadIdentity, which resets the modification matrix.

module Display (display,idle) where

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef

import Cube
import Points

display angle = do
  clear [ColorBuffer]
  loadIdentity
  a <- get angle
  rotate a $ Vector3 0 0 (1::GLfloat)
  scale 0.7 0.7 (0.7::GLfloat)
  mapM_ (\(x,y,z) -> preservingMatrix $ do
    color $ Color3 ((x+1.0)/2.0) ((y+1.0)/2.0) ((z+1.0)/2.0)
    translate $ Vector3 x y z
    cube (0.1::GLfloat)
    ) $ points 7
  swapBuffers

idle angle = do
  a <- get angle
  angle $= a+0.1
  postRedisplay Nothing

There we are! That looks pretty, doesn't it? Now, we could start adding control to the user, couldn't we? Let's add some keyboard interfaces. We'll start by letting the rotation direction change when we press spacebar, and let the arrows displace the whole figure and + and - increase/decrease the rotation speed.

Again, we're adding states, so we need to modify HelloWorld.hs

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef
import Bindings

main = do
  (progname,_) <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered]
  createWindow "Hello World"
  reshapeCallback $= Just reshape
  angle <- newIORef (0.0::GLfloat)
  delta <- newIORef (0.1::GLfloat)
  position <- newIORef (0.0::GLfloat, 0.0)
  keyboardMouseCallback $= Just (keyboardMouse delta position)
  idleCallback $= Just (idle angle delta)
  displayCallback $= (display angle position)
  mainLoop

Note that position is sent along to the keyboard as well as the display callbacks. And in Bindings.hs, we give the keyboard callback actual function

module Bindings (idle,display,reshape,keyboardMouse) where
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef

import Display

reshape s@(Size w h) = do
  viewport $= (Position 0 0, s)

keyboardAct a p (Char ' ') Down = do
  a' <- get a
  a $= -a'
keyboardAct a p (Char '+') Down = do
  a' <- get a
  a $= 2*a'
keyboardAct a p (Char '-') Down = do
  a' <- get a
  a $= a'/2
keyboardAct a p (SpecialKey KeyLeft) Down = do
  (x,y) <- get p
  p $= (x-0.1,y)
keyboardAct a p (SpecialKey KeyRight) Down = do
  (x,y) <- get p
  p $= (x+0.1,y)
keyboardAct a p(SpecialKey KeyUp) Down = do
  (x,y) <- get p
  p $= (x,y+0.1)
keyboardAct a p (SpecialKey KeyDown) Down = do
  (x,y) <- get p
  p $= (x,y-0.1)
keyboardAct _ _ _ _ = return ()

keyboardMouse angle pos key state modifiers position = do
  keyboardAct angle pos key state

finally, in Display.hs we use the new information to accordingly redraw the scene, specifically the now changing amount to change the current angle with. Note that in order to avoid the placement of the circle to be pulled in with all the other modifications we're doing, we do the translation outside a preservingMatrix call.

module Display (display,idle) where

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef

import Cube
import Points

display angle position = do
  clear [ColorBuffer]
  loadIdentity
  (x,y) <- get position
  translate $ Vector3 x y 0
  preservingMatrix $ do
    a <- get angle
    rotate a $ Vector3 0 0 (1::GLfloat)
    scale 0.7 0.7 (0.7::GLfloat)
    mapM_ (\(x,y,z) -> preservingMatrix $ do
      color $ Color3 ((x+1.0)/2.0) ((y+1.0)/2.0) ((z+1.0)/2.0)
      translate $ Vector3 x y z
      cube (0.1::GLfloat)
      ) $ points 7
  swapBuffers

idle angle delta = do
  a <- get angle
  d <- get delta
  angle $= a+d
  postRedisplay Nothing