Bitmap/Read a PPM file

Revision as of 10:13, 29 March 2009 by rosettacode>GiM (→‎{{header|D}}: drastically improve reading :))

Using the data storage type defined on this page for raster images, read an image from a PPM file (binary P6 prefered). (Read the definition of PPM file on Wikipedia.)

Task
Bitmap/Read a PPM file
You are encouraged to solve this task according to the task description, using any language you may know.

Task: Use write ppm file solution and grayscale image solution with this one in order to convert a color image to grayscale one.

Ada

<lang ada> with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;

function Get_PPM (File : File_Type) return Image is

  use Ada.Characters.Latin_1;
  use Ada.Integer_Text_IO;
  function Get_Line return String is -- Skips comments
     Byte   : Character;
     Buffer : String (1..80);
  begin
     loop
        for I in Buffer'Range loop
           Character'Read (Stream (File), Byte);
           if Byte = LF then
              exit when Buffer (1) = '#';
              return Buffer (1..I - 1);
           end if;
           Buffer (I) := Byte;
        end loop;
        if Buffer (1) /= '#' then
           raise Data_Error;
        end if;
     end loop;
  end Get_Line;
  Height : Integer;
  Width  : Integer;

begin

  if Get_Line /= "P6" then
     raise Data_Error;
  end if;
  declare
     Line  : String  := Get_Line;
     Start : Integer := Line'First;
     Last  : Positive;
  begin
     Get (Line, Width, Last);                     Start := Start + Last;
     Get (Line (Start..Line'Last), Height, Last); Start := Start + Last;
     if Start <= Line'Last then
        raise Data_Error;
     end if;
     if Width < 1 or else Height < 1 then
        raise Data_Error;
     end if;
  end;
  if Get_Line /= "255" then
     raise Data_Error;
  end if;
  declare
     Result : Image (1..Height, 1..Width);
     Buffer : String (1..Width * 3);
     Index  : Positive;
  begin
     for I in Result'Range (1) loop
        String'Read (Stream (File), Buffer);
        Index := Buffer'First;
        for J in Result'Range (2) loop
           Result (I, J) :=
              (  R => Luminance (Character'Pos (Buffer (Index))),
                 G => Luminance (Character'Pos (Buffer (Index + 1))),
                 B => Luminance (Character'Pos (Buffer (Index + 2)))
              );
           Index := Index + 3;
        end loop;
     end loop;
     return Result;
  end;

end Get_PPM; </lang> The implementation propagates Data_Error when the file format is incorrect. End_Error is propagated when the file end is prematurely met. The following example illustrates conversion of a color file to grayscale. <lang ada> declare

  F1, F2 : File_Type;

begin

  Open (F1, In_File, "city.ppm");
  Create (F2, Out_File, "city_grayscale.ppm");
  Put_PPM (F2, Color (Grayscale (Get_PPM (F1))));
  Close (F1);
  Close (F2);

end; </lang>

C

It is up to the caller to open the file and pass the handler to the function. So this code can be used in Read image file through a pipe without modification. It only understand the P6 file format.

Interface:

<lang c>image get_ppm(FILE *pf);</lang>

Implementation:

<lang c>#include "imglib.h"

  1. define PPMREADBUFLEN 256

image get_ppm(FILE *pf) {

       char buf[PPMREADBUFLEN], *t;
       image img;
       unsigned int w, h, d;
       int r;
       
       if (pf == NULL) return NULL;
       t = fgets(buf, PPMREADBUFLEN, pf);
       if ( (t == NULL) || ( strncmp(buf, "P6\n", 3) != 0 ) ) return NULL;
       do
       { /* Px formats can have # comments after first line */
          t = fgets(buf, PPMREADBUFLEN, pf);
          if ( t == NULL ) return NULL;
       } while ( strncmp(buf, "#", 1) == 0 );
       r = sscanf(buf, "%u %u", &w, &h);
       if ( r < 2 ) return NULL;
       r = fscanf(pf, "%u\n", &d);
       if ( (r < 1) || ( d != 255 ) ) return NULL;
       img = alloc_img(w, h);
       if ( img != NULL )
       {
           size_t rd = fread(img->buf, sizeof(pixel), w*h, pf);
           if ( rd < w*h )
           {
              free_img(img);
              return NULL;
           }
           return img;
       }

}</lang>

The following acts as a filter to convert a PPM file read from standard input into a PPM gray image, and it outputs the converted image to standard output (see Grayscale image, Write ppm file, and Raster graphics operations in general):

<lang c>#include <stdio.h>

  1. include "imglib.h"

int main() {

  image source;
  grayimage idest;
  
  source = get_ppm(stdin);
  idest = tograyscale(source);
  free_img(source);
  source = tocolor(idest);
  output_ppm(stdout, source);
  free_img(source); free_img((image)idest);
  return 0;

}</lang>

D

This example uses storage defined on Basic bitmap storage problem page.

This is wrap-around defined storage, P6 binary mode.

Works with: tango

<lang D> import tango.core.Exception; import tango.io.FileConduit; import tango.io.MappedBuffer; import tango.io.stream.LineStream; import tango.io.protocol.Reader; import tango.text.convert.Integer;

class P6Image {

   class BadInputException : Exception { this() { super("Bad file format"); } }
   class NoImageException : Exception { this() { super("No image data"); } }
   static const char[] type = "P6";
   MappedBuffer fileBuf;
   ubyte _maxVal, gotImg;

public:

   RgbBitmap bitmap;
   this (FileConduit input) {
       fileBuf = new MappedBuffer(input);
       if (processHeader(new LineInput(fileBuf)))
           throw new BadInputException;
       if (processData(fileBuf))
           throw new BadInputException;
   }
   ubyte maxVal() { return _maxVal; }
   int processHeader(LineInput li) {
       char[] line;
       uint eaten;
       li.readln(line);
       if (line != type) return 1;
       li.readln(line);
       // skip comment lines
       while (line.length && line[0] == '#') li.readln(line);
       auto width = parse(line, 0, &eaten);
       auto height = parse(line[eaten..$], 0, &eaten);
       if (!eaten || width > 0xffff_ffff || height > 0xffff_ffff) return 1;
       li.readln(line);
       auto temp = parse(line, 0, &eaten);
       if (!eaten || temp > 255) return 1;
       _maxVal = temp;
       bitmap = RgbBitmap(width, height);
       gotImg = 1;
       return 0;
   }
   int processData(MappedBuffer mb) {
       if (! gotImg) throw new NoImageException;
       mb.fill(bitmap.data);
       return 0;
   }

} </lang>

Reading from file: <lang D> auto p6 = new P6Image(new FileConduit("image.ppm")); </lang>

Forth

: read-ppm { fid -- bmp }
  pad dup 80 fid read-line throw 0= abort" Partial line"
  s" P6" compare abort" Only P6 supported."
  pad dup 80 fid read-line throw 0= abort" Partial line"
  0. 2swap >number
  1 /string		\ skip space
  0. 2swap >number
  2drop drop nip    ( w h )
  bitmap { bmp }
  pad dup 80 fid read-line throw 0= abort" Partial line"
  s" 255" compare abort" Only 8-bits per color channel supported"
  0 pad !
  bmp bdim
  0 do
    dup 0 do
      pad 3 fid read-file throw
      3 - abort" Not enough pixel data in file"
      pad @ i j bmp b!
    loop
  loop drop
  bmp ;
\ testing round-trip
4 3 bitmap value test
red test bfill
green 1 2 test b!

s" red.ppm" w/o create-file throw
test over write-ppm
close-file throw

s" red.ppm" r/o open-file throw
dup read-ppm value test2
close-file throw

: bsize ( bmp -- len ) bdim * pixels bdata ;

test dup bsize  test2 dup bsize  compare .    \ 0 if identical

Fortran

Works with: Fortran version 90 and later

(This function is part of module RCImageIO, see Write ppm file)

<lang fortran> subroutine read_ppm(u, img)

   integer, intent(in) :: u
   type(rgbimage), intent(out) :: img
   integer :: i, j, ncol, cc
   character(2) :: sign
   character :: ccode
   
   img%width = 0
   img%height = 0
   nullify(img%red)
   nullify(img%green)
   nullify(img%blue)
   read(u, '(A2)') sign
   read(u, *) img%width, img%height
   read(u, *) ncol
   write(0,*) sign
   write(0,*) img%width, img%height
   write(0,*) ncol
   if ( ncol /= 255 ) return
   call alloc_img(img, img%width, img%height)
   if ( valid_image(img) ) then
      do j=1, img%height
         do i=1, img%width
            read(u, '(A1)', advance='no', iostat=status) ccode
            cc = iachar(ccode)
            img%red(i,j) = cc
            read(u, '(A1)', advance='no', iostat=status) ccode
            cc = iachar(ccode)
            img%green(i,j) = cc
            read(u, '(A1)', advance='no', iostat=status) ccode
            cc = iachar(ccode)
            img%blue(i,j) = cc
         end do
      end do
   end if
 end subroutine read_ppm</lang>

Notes:

  • doing formatted I/O with Fortran is a pain... And unformatted does not mean free; Fortran2003 has streams, but they are not implemented (yet) in GNU Fortran compiler. Here (as in the write part) I've tried to handle the PPM format through formatted I/O. The tests worked but I have not tried still everything.
  • comments after the first line are not handled

Haskell

The definition of Bitmap.Netpbm.readNetpbm is given here. <lang haskell>import Bitmap import Bitmap.RGB import Bitmap.Gray import Bitmap.Netpbm

import Control.Monad import Control.Monad.ST

main =

   (readNetpbm "original.ppm" :: IO (Image RealWorld RGB)) >>=
   stToIO . toGrayImage >>=
   writeNetpbm "new.pgm"</lang>

The above writes a PGM, not a PPM, since the image being output is in grayscale. If you actually want a gray PPM, convert the Image RealWorld Gray back to an Image RealWorld RGB first: <lang haskell>main =

   (readNetpbm "original.ppm" :: IO (Image RealWorld RGB)) >>=
   stToIO . (toRGBImage <=< toGrayImage) >>=
   writeNetpbm "new.ppm"</lang>

OCaml

<lang ocaml>let read_ppm ~filename =

 let ic = open_in filename in
 let line = input_line ic in
 if line <> "P6" then invalid_arg "not a P6 ppm file";
 let line = input_line ic in
 let line =
   try if line.[0] = '#'  (* skip comments *)
   then input_line ic
   else line
   with _ -> line
 in
 let width, height =
   Scanf.sscanf line "%d %d" (fun w h -> (w, h))
 in
 let line = input_line ic in
 if line <> "255" then invalid_arg "not a 8 bit depth image";
 let all_channels =
   let kind = Bigarray.int8_unsigned
   and layout = Bigarray.c_layout
   in
   Bigarray.Array3.create kind layout 3 width height
 in
 let r_channel = Bigarray.Array3.slice_left_2 all_channels 0
 and g_channel = Bigarray.Array3.slice_left_2 all_channels 1
 and b_channel = Bigarray.Array3.slice_left_2 all_channels 2
 in
 for y = 0 to pred height do
   for x = 0 to pred width do
     r_channel.{x,y} <- (input_byte ic);
     g_channel.{x,y} <- (input_byte ic);
     b_channel.{x,y} <- (input_byte ic);
   done;
 done;
 close_in ic;
 (all_channels,
  r_channel,
  g_channel,
  b_channel)</lang>

and converting a given color file to grayscale: <lang ocaml>let () =

 let img = read_ppm ~filename:"logo.ppm" in
 let img = to_color(to_grayscale ~img) in
 output_ppm ~oc:stdout ~img;
</lang>

sending the result to stdout allows to see the result without creating a temporary file sending it through a pipe to the display utility of ImageMagick:

ocaml script.ml | display -

Perl

Library: Imlib2

<lang perl>#! /usr/bin/perl

use strict; use Image::Imlib2;

my $img = Image::Imlib2->load("out0.ppm");

  1. let's do something with it now

$img->set_color(255, 255, 255, 255); $img->draw_line(0,0, $img->width,$img->height); $img->image_set_format("png"); $img->save("out1.png");

exit 0;</lang>


Vedit macro language

//   Load a PPM file
//     @10 = filename
//   On return:
//     #10 points to buffer containing pixel data,
//     #11 = width,  #12 = height.

:LOAD_PPM:
File_Open(@10)
BOF
Search("|X", ADVANCE)		// skip "P6"
#11 = Num_Eval(ADVANCE)		// #11 = width
Match("|X", ADVANCE)		// skip separator
#12 = Num_Eval(ADVANCE)		// #12 = height
Match("|X", ADVANCE)
Search("|X", ADVANCE)		// skip maxval (assume 255)
Del_Block(0,CP)			// remove the header
Return

Example of usage. In addition to LOAD_PPM routine above, you need routine RGB_TO_GRAYSCALE from Grayscale image and routine SAVE_PPM from Write ppm file.

// Load RGB image
Reg_Set(10, "|(USER_MACRO)\example.ppm")
Call("LOAD_PPM")

// Convert to grayscale
#10 = Buf_Num
Call("RGB_TO_GRAYSCALE")
Buf_Switch(#10) Buf_Quit(OK)

// Convert to RGB
Call("GRAYSCALE_TO_RGB")

// Save the image
Reg_Set(10, "|(USER_MACRO)\example_gray.ppm")
Call("SAVE_PPM")

// Cleanup and exit
Buf_Switch(#20) Buf_Quit(OK)
return