Bitmap/Read a PPM file

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

<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; </ada> 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. <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; </ada>

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

test  dup bdim * pixels bdata
test2 dup bdim * pixels bdata
compare .    \ 0 if identical

OCaml

<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)</ocaml>