gistfile1.hs

import Foreign.Storable
import Foreign.Marshal.Array
import Data.Word
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Data.IORef
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy as L
import Data.Char (isSpace)


init_ = do  
  clearColor $= Color4 1.0 0.0 1.0 1.0     

circle2f centerx centery radious = do
  mapM_ (\i -> do 
           let theta= 2*pi*i/100
           vertex$((Vertex2 (centerx+radious*(cos theta)) (centery+radious*(sin theta)))::Vertex2 GLfloat)) [0..99]


randomPoint :: [ (Color3 GLfloat, Vertex2 GLfloat) ]
randomPoint = [  (Color3 0.0 1.0 0.0,Vertex2 x y) | x <- [1.0,3.0..159.0] , y <- [1]]

display_ xpos ypos pxdata size= do 
  clear [ColorBuffer]
  yposp <- readIORef ypos
  rasterPos $ Vertex2 100 yposp   
  drawPixels size pxdata
  flush
  swapBuffers
  if (yposp + 0.1 >= 120.0)
     then 
         writeIORef ypos 0.0
     else
         return ()
  postRedisplay Nothing


reshape size= do
  viewport $= (Position 0 0,size)
  matrixMode $= Projection
  loadIdentity
  ortho2D 0.0 160.0 0.0 120.0

main = do 
  initialDisplayMode $= [DoubleBuffered,RGBMode]
  initialWindowSize $= Size 320 240
  (progname, _) <- getArgsAndInitialize  
  createWindow "Displying Images"
  init_
  (pxdata,size) <- readBPM "smiley.bmp" 
  xpos <- newIORef (60.0 :: GLfloat)
  ypos <- newIORef (0.0 :: GLfloat )
  displayCallback $= display_  xpos ypos pxdata size
  reshapeCallback $= Just reshape  
  mainLoop

getBytes n str = let count           = fromIntegral n
                     both@(prefix,_) = L.splitAt count str
                 in if L.length prefix < count
                    then Nothing
                    else Just both

    
readBPM file = do
    f <- L8.readFile file
    let nf = L8.drop 2 f
    let Just (size,r) = getBytes 4 nf
    let (s1:s2:_) = L.unpack size
    let rp = L8.drop 12 r
    let Just (s,rr) = getBytes 8 rp
    let (w:_:_:_:h:_) = L.unpack s    
    let nff = L8.drop 28 rr    
    let n1 = read$show w :: GLsizei
    let n2 = read$show h :: GLsizei
    let Just (pixels,rf) = getBytes (n1*n2) nff
    let p =   L.unpack pixels
    ptr <- newArray p    
    return ((PixelData  RGB UnsignedInt ptr ),(Size n1 n2))