gistfile1.hs

color3f :: Color3 GLfloat -> IO ()
color3f = color

vertex2f :: Vertex2 GLfloat -> IO ()
vertex2f = vertex :: Vertex2 GLfloat -> IO ()

colorVertex :: (Color3 GLfloat, Vertex2 GLfloat) -> IO ()  
colorVertex (c,v) = do
  color3f c
  vertex v

densColor :: Grid -> (Int,Int) -> IO (GLfloat,GLfloat,GLfloat,GLfloat)
densColor g p@(x,y) = do
  d00 <- readVal g p
  d01 <- readVal g (x,y+1)
  d10 <- readVal g (x+1,y)
  d11 <- readVal g (x+1,y+1)
  return (realToFrac d00,realToFrac d01,realToFrac d10,realToFrac d11) 

mapToColor :: (GLfloat,GLfloat) -> GLfloat -> GLfloat -> GLfloat -> (Color3 GLfloat)
mapToColor (i,j) x y z = Color3 (i*x) (j*y) (i/j * z)
                         
drawDensity :: Grid -> IO ()
drawDensity g = do
  color3f (Color3 1 0 1)
  lineWidth $= 0.5
  let h = 1.0 / fromIntegral n
  let f i = (fromIntegral i - 0.5 :: GLfloat) * h
  renderPrimitive Quads $ forM_ [(x,y) | x<-[1..n], y<-[1..n]]
                      (\(i,j) ->
                           do
                             (d00,d01,d10,d11) <- densColor g (i,j)
                             let m = (fromIntegral i / fromIntegral n, fromIntegral j / fromIntegral n)
                             colorVertex (mapToColor m d00 d00 d00, Vertex2 (f i) (f j))
                             colorVertex (mapToColor m d10 d10 d10, Vertex2 (f i+h) (f j))
                             colorVertex (mapToColor m d11 d11 d11, Vertex2 (f i+h) (f j+h))
                             colorVertex (mapToColor m d01 d01 d01, Vertex2 (f i) (f j+h)))
  flush