Bitmap/Read a PPM file

From Rosetta Code
Revision as of 19:20, 23 May 2009 by rosettacode>Dkf (→‎{{header|Tcl}}: a few more notes)
Task
Bitmap/Read a PPM file
You are encouraged to solve this task according to the task description, using any language you may know.

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: 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 understands 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;
       // The program fails if the first byte of the image is equal to 32. because the fscanf eats the space and the image is read with some bit less
       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>


Tcl

Library: Tk

The actual PPM reader is built into the photo image engine: <lang tcl>package require Tk

proc readPPM {image file} {

   $image read $file -format ppm

}</lang> Thus, to read a PPM, convert it to grayscale, and write it back out again becomes this (which requires Tcl 8.6 for try/finally); the PPM reader and writer are inlined because they are trivial at the script level: <lang tcl>package require Tk

proc grayscaleFile {filename} {

   set buffer [image create photo]
   try {
       $buffer read $filename -format ppm
       set w [image width $buffer]
       set h [image height $buffer]
       for {set x 0} {$x<$w} {incr x} {
           for {set y 0} {$y<$h} {incr y} {
               lassign [$buffer get $x $y] r g b
               set l [expr {int(0.2126*$r + 0.7152*$g + 0.0722*$b)}]
               $buffer put [format "#%02x%02x%02x" $l $l $l] -to $x $y
           }
       }
       $buffer write $filename -format ppm
   } finally {
       image delete $buffer
   }

}</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