{-
    Copyright (C) 2006 Alex McLean

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Main where

import LSystem
import IO (isEOFError)
import System.IO    
import System(getArgs)
import Foreign
import CForeign
import Char(ord, chr)
import System(getArgs)

main = do args <- getArgs
          input <- openBinaryFile (head args) ReadMode 
          output <- openBinaryFile "out.ppm" WriteMode 
          filesize <- hFileSize input
          let level   = (findLevel (length peano) (fromInteger filesize))
              width   = findWidth level $ (length peano)
              area    = findArea level $ length peano
              mapping = fill level peano
              flat    = flatten width mapping
              header  = ("P5\n# peano.pgm\n"
                         ++ (show width) ++ " " ++ (show width) ++ "\n"
                         ++ "255\n"
                        )
          hPutStrLn stderr ("making " 
                            ++ (show area) 
                            ++ " bytes from " 
                            ++ (show filesize)
                            ++ " byte file, will make "
                            ++ (show width) ++ "x" ++ (show width)
                            ++ " image (" ++ (show area) ++ " bytes) with a "
                            ++ (show (length header))
                            ++ " byte header"
                           )
          hPutStrLn output header

          present (fromInteger filesize) (length header) input output flat
          hClose input
          hClose output

present _ _ _ _ [] = return ()

present filesize offset input output (pos:xs) = 
    do hSeek output AbsoluteSeek (fromIntegral (offset + fromIntegral pos))
       shunt input output `catch` eofHandler output pos
       present filesize offset input output xs

shunt input output = 
    do c <- hGetChar input
       -- make zero black and peaks white
       let i = (ceiling (abs $ (fromIntegral $ ord c) - 127.5) * 2)
       hPutChar output ( chr i )

eofHandler output pos e = if isEOFError e then hPutChar output (chr 0) else ioError e