-- The University of New Mexico's Haskell Image Processing Library
-- Copyright (C) 2013 Joseph Collard
--
-- 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 3 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, see .
{-# LANGUAGE TypeFamilies, ViewPatterns, FlexibleContexts #-}
module Data.Image.IO(DisplayFormat(..),
GrayPixel(..),
RGBPixel(..),
writeImage,
toPGM,
toPPM) where
import Data.Image.Internal
--base>=4
import Data.List(intercalate)
-- | A DisplayFormat for writing to a file
class DisplayFormat df where
format :: df -> String
-- | GrayPixels will be converted using this class
class RealFrac (GrayVal px) => GrayPixel px where
type GrayVal px :: *
toGray :: px -> GrayVal px
-- | RGBPixels will be converted using this class
class RealFrac (ColorVal px) => RGBPixel px where
type ColorVal px :: *
toRGB :: px -> (ColorVal px, ColorVal px, ColorVal px)
-- Converts an image into a PGM string
-- | Converts an image an ASCII PPM scaled between pixel values of 0 and 255
toPGM :: (Image img,
GrayPixel (Pixel img)) => img -> [Char]
toPGM img@(dimensions -> (rows, cols)) = "P2 " ++ (show cols) ++ " " ++ (show rows) ++ " 255 " ++ px where
px = intercalate " " . map (show . round . (*scale) . (flip (-) min)) $ pixels
pixels = map toGray . pixelList $ img
min = (minimum (0:pixels))
max = maximum pixels
scale = 255 / (max - min)
-- | Converts an image to an ASCII PPM scaled between pixel values of 0 and 255
toPPM :: (Image img,
RGBPixel (Pixel img)) => img -> [Char]
toPPM img@(dimensions -> (rows, cols)) = "P3 " ++ (show cols) ++ " " ++ (show rows) ++ " 255 " ++ px where
px = intercalate " " rgbs
rgbs = map (showRGB . scaleRGB) pixels
pixels = map toRGB . pixelList $ img
min = comp 0 min' pixels
max = comp (-10e10) max' pixels
scale = 255 / (max - min)
scaleRGB (r, g, b) = (scale*(r-min), scale*(g-min), scale*(b-min))
showRGB (r, g, b) = (show . round $ r) ++ " " ++ (show . floor $ g) ++ " " ++ (show . floor $ b)
min' :: RealFrac a => a -> a -> a
min' = comp' (<)
max' :: RealFrac a => a -> a -> a
max' = comp' (>)
comp' :: RealFrac a => (a -> a -> Bool) -> a -> a -> a
comp' f d0 d1
| f d0 d1 = d0
| otherwise = d1
comp :: RealFrac a => a -> (a -> a -> a) -> [(a, a, a)] -> a
comp seed f = compare' (seed,seed,seed) where
compare' (r,g,b) [] = foldr1 f [r,g,b]
compare' (r,g,b) ((r',g',b'):xs) = compare' (f r r', f g g', f b b') xs
{-| Given a file name and a formatable image, writes the image to that file
with the format.
>>>frog <- readImage "images/frog.pgm"
>>>writeImage "transposeFrog.pgm" (transpose frog)
>>>cactii <- readColorImage "images/cactii.ppm"
>>>writeImage "inverseCactii.ppm" (imageMap (*(-1)) cactii)
-}
writeImage :: (DisplayFormat df) => FilePath -> df -> IO ()
writeImage file = writeFile file . format