Bitmap/Write a PPM file

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

Ada

<ada> procedure Put_PPM (File : File_Type; Picture : Image) is

  Size : constant String := Integer'Image (Picture'Length (2)) & Integer'Image (Picture'Length (1));

begin

  Put_Line (File, "P6");
  Put_Line (File, Size (2..Size'Last));
  Put_Line (File, "255");
  for I in Picture'Range (1) loop
     for J in Picture'Range (2) loop
        Put (File, Character'Val (Picture (I, J).R));
        Put (File, Character'Val (Picture (I, J).G));
        Put (File, Character'Val (Picture (I, J).B));
     end loop;
  end loop;
  New_Line (File);

end Put_PPM; </ada> The solution writes the image into an opened file. The file format might fail to work on certain OSes, because text output might mangle control characters like LF, CR, FF, HT, VT etc. The OS might also limit the line length of a text file. In general it is a bad idea to mix binary and text output in one file.

C

<C>#include <stdio.h>

void output_ppm(FILE *fd, image img) {

   unsigned int n;
   fprintf(fd, "P6\n%d %d\n255\n", img->width, img->height);
   n = img->width * img->height;
   fwrite(img->buf, sizeof(pixel), n, fd);
   fflush(fd);

}</C>

Forth

: write-ppm { bmp fid -- }
  s" P6"             fid write-line throw
  bmp bdim swap
  0 <# bl hold #s #> fid write-file throw
  0 <#         #s #> fid write-line throw
  s" 255"            fid write-line throw
  bmp bdata  bmp bdim * pixels
  bounds do
    i 3              fid write-file throw
  pixel +loop ;

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

OCaml

<ocaml>let output_ppm ~oc ~img:(_, r_channel, g_channel, b_channel) =

 let width = Bigarray.Array2.dim1 r_channel
 and height = Bigarray.Array2.dim2 r_channel in
 Printf.fprintf oc "P6\n%d %d\n255\n" width height;
 for y = 0 to pred height do
   for x = 0 to pred width do
     output_char oc (char_of_int r_channel.{x,y});
     output_char oc (char_of_int g_channel.{x,y});
     output_char oc (char_of_int b_channel.{x,y});
   done;
 done;
 output_char oc '\n';
 flush oc;

</ocaml>