-- | Reads and writes legacy /portable bitmap/ (/PBM/) image files.  A
-- PBM file contains one or more monochrome images.
--
-- For more information on the PBM format, see the PBM specification:
-- <http://netpbm.sourceforge.net/doc/pbm.html>.
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" and "System.IO" functions; e.g.
--
-- > import qualified Codec.Image.PBM as PBM
module Codec.Image.PBM
    ( readFile
    , writeFile
    , fromString
    , toString
    ) where

import Control.Monad
import Data.Array.IArray
import Data.Bits
import Data.Maybe
import Prelude hiding (readFile, writeFile)
import System.IO hiding (readFile, writeFile)

import Codec.Image.PAM hiding (writeFile, toString)

-- | Writes one or more 'PAM' images to a PBM image file at the given
-- path, converting to monochrome if required.
writeFile :: FilePath -> [PAM] -> IO ()
writeFile filePath l
    = do h <- openFile filePath WriteMode
         hSetBinaryMode h True
         hPutStr h $ unlines $ map toString l
         hClose h
         return ()

-- | Transform a 'PAM' structure to its corresponding 'String'
-- representation in PBM format, converting to monochrome if required.
toString :: PAM -> String
toString (PAM (width, height) depth maxVal _ raster)
    = "P4\n"
      ++ show width  ++ " "
      ++ show height ++ "\n"
      ++ rasterToString (0, 0)
  where
    rasterToString (x, y)
        | y == height
            = []
        | x >= width
            = rasterToString (0, y + 1)
        | otherwise
            = toEnum (getBit 0 `shift` 7 +
                      getBit 1 `shift` 6 +
                      getBit 2 `shift` 5 +
                      getBit 3 `shift` 4 +
                      getBit 4 `shift` 3 +
                      getBit 5 `shift` 2 +
                      getBit 6 `shift` 1 +
                      getBit 7 `shift` 0)
              : rasterToString (x + 8, y)
      where
        getBit bit
            | x + bit >= width
                = 0
            | maximum (raster ! (x + bit, y)) /= 0
                = 0
            | otherwise
                = 1
