Bitmap/Write a PPM file

Bitmap/Write 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, write the image to a PPM file (binary P6 prefered).
(Read the definition of PPM file on Wikipedia.)

Ada

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

procedure Put_PPM (File : File_Type; Picture : Image) is

  use Ada.Characters.Latin_1;
  Size   : constant String := Integer'Image (Picture'Length (2)) & Integer'Image (Picture'Length (1));
  Buffer : String (1..Picture'Length (2) * 3);
  Color  : Pixel;
  Index  : Positive;

begin

  String'Write (Stream (File), "P6" & LF);
  String'Write (Stream (File), Size (2..Size'Last) & LF);
  String'Write (Stream (File), "255" & LF);
  for I in Picture'Range (1) loop
     Index := Buffer'First;
     for J in Picture'Range (2) loop
        Color := Picture (I, J);
        Buffer (Index)     := Character'Val (Color.R);
        Buffer (Index + 1) := Character'Val (Color.G);
        Buffer (Index + 2) := Character'Val (Color.B);
        Index := Index + 3;
     end loop;
     String'Write (Stream (File), Buffer);
  end loop;
  Character'Write (Stream (File), LF);

end Put_PPM; </lang> The solution writes the image into an opened file. The file format might fail to work on certain OSes, because 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. This solution uses stream I/O, which should be as portable as possible.

C

Interface:

<lang c>void output_ppm(FILE *fd, image img);</lang>

Implementation:

<lang c>#include "imglib.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);

}</lang>

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

Fortran

Works with: Fortran version 90 and later

It loads RCImageBasic module, which is defined here. <lang fortran>module RCImageIO

 use RCImageBasic

 implicit none

contains

 subroutine output_ppm(u, img)
   integer, intent(in) :: u
   type(rgbimage), intent(in) :: img
   integer :: i, j

   write(u, '(A2)') 'P6'
   write(u, '(I0, ,I0)') img%width, img%height
   write(u, '(A)') '255'
   
   do j=1, img%height
      do i=1, img%width
         write(u, '(3A1)', advance='no') achar(img%red(i,j)), achar(img%green(i,j)), &
                                         achar(img%blue(i,j))
      end do
   end do

 end subroutine output_ppm

end module RCImageIO</lang>

Haskell

<lang haskell>{-# LANGUAGE ScopedTypeVariables #-}

module Bitmap.Netpbm(readNetpbm, writeNetpbm) where

import Bitmap import Data.Char import System.IO import Control.Monad import Control.Monad.ST import Data.Array.ST

nil :: a nil = undefined

readNetpbm :: forall c. Color c => FilePath -> IO (Image RealWorld c) readNetpbm path = do

   ppm <- openFile path ReadMode >>= hGetContents
   let (s, rest) = splitAt 2 ppm
   unless (s == magicNumber) die
   (width, rest) <- getNum rest
   (height, rest) <- getNum rest
   (_, c : rest) <-
       if getMaxval then getNum rest else return (nil, rest)
   unless (isSpace c) die
   stToIO $ listImage width height $ fromNetpbm $ map fromEnum rest
 where die :: IO ()
       die = fail "readImage: bad format"
       getNum :: String -> IO (Int, String)
       getNum ppm = do
           let (s, rest) = span isDigit $ skipBlanks ppm
           when (null s) die
           return (read s, rest)
       skipBlanks =
          dropWhile isSpace .
          until ((/= '#') . head) (tail . dropWhile (/= '\n')) .
          dropWhile isSpace
       magicNumber = netpbmMagicNumber (nil :: c)
       getMaxval = not $ null $ netpbmMaxval (nil :: c)

writeNetpbm :: forall c. Color c => FilePath -> Image RealWorld c -> IO () writeNetpbm path i = do

   h <- openFile path WriteMode
   hSetBuffering h NoBuffering
   (width, height) <- stToIO $ dimensions i
   let w = hPutStrLn h
   w $ magicNumber
   w $ show width ++ " " ++ show height
   if null maxval
     then return ()
     else w maxval
   stToIO (getPixels i) >>= hPutStr h . toNetpbm
 where magicNumber = netpbmMagicNumber (nil :: c)
       maxval = netpbmMaxval (nil :: c)</lang>

Modula-3

Bitmap is the module from Basic Bitmap Storage. <lang modula3>INTERFACE PPM;

IMPORT Bitmap, Pathname;

PROCEDURE Create(imgfile: Pathname.T; img: Bitmap.T);

END PPM.</lang> <lang modula3>MODULE PPM;

IMPORT Bitmap, Wr, FileWr, Pathname; FROM Fmt IMPORT F, Int;

<*FATAL ANY*>

VAR imgfilewr: FileWr.T;

PROCEDURE Create(imgfile: Pathname.T; img: Bitmap.T) =

 VAR height := LAST(img^);
     width := LAST(img[0]);
     color: Bitmap.Pixel;
 BEGIN
   imgfilewr := FileWr.Open(imgfile);
   Wr.PutText(imgfilewr, F("P6\n%s %s\n255\n", Int(height + 1), Int(width + 1)));
   FOR i := 0 TO height DO
     FOR j := 0 TO width DO
       color := img[i,j];
       Wr.PutChar(imgfilewr, VAL(color.R, CHAR));
       Wr.PutChar(imgfilewr, VAL(color.G, CHAR));
       Wr.PutChar(imgfilewr, VAL(color.B, CHAR));
     END;
   END;
   Wr.PutChar(imgfilewr, '\n');
   Wr.Flush(imgfilewr);
 END Create;
 

BEGIN END PPM.</lang>

OCaml

<lang 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;

</lang>

Perl

Library: Imlib2

Imlib2 can handle several formats, among these JPG, PNG, PNM/PPM... (but it depends on how the Imlib2 was built on the system, since the ability to load or save in these formats depends on other external libraries, like libpng e.g.)

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

use strict; use Image::Imlib2;

my $img = Image::Imlib2->new(100,100); $img->set_color(100,200,0, 255); $img->fill_rectangle(0,0,100,100);

$img->save("out0.ppm"); $img->save("out0.jpg"); $img->save("out0.png");

exit 0;</lang>

Normally Image::Imlib2 understands which output format to use from the extension; to override its guess, you can use:

<lang perl>$img->image_set_format("jpeg"); # or png, tiff, ppm ...</lang>

Vedit macro language

This routine creates a RAW PPM file (binary). Pixel data must be stored in edit buffer pointed by numeric register #10. The data in the buffer is assumed to be in R,G,B order, which is the order used by PPM file.

/////////////////////////////////////////////////////////////////////
//
//  Save image as PPM file.
//  @10 = filename.  Buffer #10 contains the Pixel data.
//
:SAVE_PPM:
Buf_Switch(#10)
BOF
IT("P6") IN
Num_Ins(#11, LEFT)	  // width of image
Num_Ins(#12, LEFT)	  // height of image
Num_Ins(255, LEFT+NOCR)	  // maxval
IC(10)
File_Save_As(@10, OK)
Return