Haskell orthograpic projection

ortho.hs

import qualified Graphics.UI.GLUT as GLUT
import Data.IORef

type Mat3 = (
              GLf, GLf, GLf,
              GLf, GLf, GLf,
              GLf, GLf, GLf
            )
type Vec3 = ( GLf, GLf, GLf )
type GLf = GLUT.GLfloat

rotateX :: GLf -> Mat3
rotateX tau = (
                1, 0,        0,
                0, cos(tau), -sin(tau),
                0, sin(tau),  cos(tau)
              )

rotateY :: GLf -> Mat3
rotateY tau = (
                cos(tau),  0, sin(tau),
                0,         1, 0,
                -sin(tau), 0, cos(tau)
              )

rotateZ :: GLf -> Mat3
rotateZ tau = (
                cos(tau), -sin(tau), 0,
                sin(tau),  cos(tau), 0,
                0,        0,         1
              )

multiplyM :: Mat3 -> Mat3 -> Mat3
multiplyM ( a00, a01, a02, a10, a11, a12, a20, a21, a22 )
          ( b00, b01, b02, b10, b11, b12, b20, b21, b22 ) =
  (
    b00 * a00 + b01 * a10 + b02 * a20,
    b00 * a01 + b01 * a11 + b02 * a21,
    b00 * a02 + b01 * a12 + b02 * a22,

    b10 * a00 + b11 * a10 + b12 * a20,
    b10 * a01 + b11 * a11 + b12 * a21,
    b10 * a02 + b11 * a12 + b12 * a22,

    b20 * a00 + b21 * a10 + b22 * a20,
    b20 * a01 + b21 * a11 + b22 * a21,
    b20 * a02 + b21 * a12 + b22 * a22
  )

orthoMatrix :: GLf -> GLf -> Mat3
orthoMatrix tx tz = multiplyM (rotateZ tz) (rotateX tx)

multiplyV :: Mat3 -> Vec3 -> Vec3
multiplyV ( a00, a01, a02, a10, a11, a12, a20, a21, a22 ) ( x, y, z ) =
  (
    (a00 * x) + (a01 * y) + (a02 * z),
    (a10 * x) + (a11 * y) + (a12 * z),
    (a20 * x) + (a21 * y) + (a22 * z)
  )

domain :: [ (GLf, GLf) ]
domain = [ (x, y) | x <- [-64 .. 64], y <- [-64 .. 64] ]

func :: GLf -> (GLf, GLf) -> Vec3
func t (x, y) = (x, y, 8 * (sin(4 * t + x / 8) + sin(y / 8)))

transformPoints :: GLf -> GLf -> GLf -> [ (GLf, GLf) ] -> [ (GLf, GLf, GLf) ]
transformPoints t tauX tauZ points =
  map transform points
    where
      transform :: (GLf, GLf) -> Vec3
      transform = (multiplyV (orthoMatrix tauX tauZ) . (func t))

main :: IO ()
main = do
  (_, _)  <- GLUT.getArgsAndInitialize
  _window <- GLUT.createWindow ""
  GLUT.windowSize GLUT.$= GLUT.Size 800 800
  angle <- newIORef 0.0
  GLUT.displayCallback GLUT.$= display angle
  GLUT.idleCallback GLUT.$= Just (idle angle)
  GLUT.mainLoop

display :: IORef GLf -> GLUT.DisplayCallback
display t = do
  t' <- GLUT.get t
  GLUT.clear [ GLUT.ColorBuffer ]
  GLUT.renderPrimitive GLUT.Points $
    mapM_ toVertex $ (transformPoints t' (pi * 2 / 3) t' domain)
  GLUT.flush
    where
      toVertex (x, y, z) = do
        GLUT.color  $ GLUT.Color3  y' y' y'
        GLUT.vertex $ GLUT.Vertex2 (x / 64) (y / 64)
          where y' = (1.25 - (y / 64))


idle :: IORef GLf -> GLUT.IdleCallback
idle angle = do
  angle GLUT.$~! (+ 0.005)
  GLUT.postRedisplay Nothing