{-
   ReadImage.hs (adapted from readImage.c which is (c) Silicon Graphics, Inc.)
   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>
   This file is part of HOpenGL and distributed under a BSD-style license
   See the file libraries/GLUT/LICENSE

   Support for reading a file of raw RGB data:
      4 bytes big-endian width
      4 bytes big-endian height
      width * height RGB byte triples
-}

module ReadImage ( readImage, readImageWithSize ) where

import Data.Word ( Word8, Word32 )
import Control.Exception ( bracket )
import Control.Monad ( when )
import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose )
import System.IO.Error ( mkIOError, eofErrorType )
import Foreign ( Ptr, alloca, mallocBytes, Storable(..) )
import Graphics.UI.GLUT

-- This is probably overkill, but anyway...
newtype Word32BigEndian = Word32BigEndian Word32

word32BigEndianToGLsizei :: Word32BigEndian -> GLsizei
word32BigEndianToGLsizei (Word32BigEndian x) = fromIntegral x

instance Storable Word32BigEndian where
   sizeOf ~(Word32BigEndian x) = sizeOf x
   alignment ~(Word32BigEndian x) = alignment x
   peek ptr = do
      let numBytes = sizeOf (undefined :: Word32BigEndian)
      bytes <- mapM (peekByteOff ptr) [ 0 ..  numBytes - 1 ] :: IO [Word8]
      let value = foldl (\val byte -> val * 256 + fromIntegral byte) 0 bytes
      return $ Word32BigEndian value
   poke = error ""

-- This is the reason for all this stuff above...
readGLsizei :: Handle -> IO GLsizei
readGLsizei handle =
   alloca $ \buf -> do
      hGetBufFully handle buf (sizeOf (undefined :: Word32BigEndian))
      fmap word32BigEndianToGLsizei $ peek buf

-- A handy variant of hGetBuf with additional error checking
hGetBufFully :: Handle -> Ptr a -> Int -> IO ()
hGetBufFully handle ptr numBytes = do
   bytesRead <- hGetBuf handle ptr numBytes
   when (bytesRead /= numBytes) $
      ioError $ mkIOError eofErrorType "hGetBufFully" (Just handle) Nothing

-- Closing a file is nice, even when an error occurs during reading.
withBinaryFile :: FilePath -> (Handle -> IO a) -> IO a
withBinaryFile filePath = bracket (openBinaryFile filePath ReadMode) hClose

readImage :: FilePath -> IO (Size, PixelData a)
readImage filePath =
   withBinaryFile filePath $ \handle -> do
      width <- readGLsizei handle
      height <- readGLsizei handle
      let numBytes = fromIntegral (3 * width * height)
      buf <- mallocBytes numBytes
      hGetBufFully handle buf numBytes
      return (Size width height, PixelData RGB UnsignedByte buf)

readImageWithSize :: FilePath -> GLint -> GLint -> IO (Size, PixelData a)
readImageWithSize filePath width height =
   withBinaryFile filePath $ \handle -> do
      let numBytes = fromIntegral (3 * width * height)
      buf <- mallocBytes numBytes
      hGetBufFully handle buf numBytes
      return (Size width height, PixelData RGB UnsignedByte buf)