Bitmap/Write a PPM file

From Rosetta Code

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.)

[edit] 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;

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.

[edit] AutoHotkey

Works with: AutoHotkey_L version 45

 
cyan := color(0,255,255) ; r,g,b 
cyanppm := Bitmap(10, 10, cyan) ; width, height, background-color
Bitmap_write_ppm3(cyanppm, "cyan.ppm")
run, cyan.ppm
return
 
#include bitmap_storage.ahk  ; see basic bitmap storage task
 
Bitmap_write_ppm3(bitmap, filename)
{
file := FileOpen(filename, 0x11) ; utf-8, write
file.seek(0,0) ; overwrite BOM created with fileopen()
file.write("P3`n"  ;  `n = \n in ahk
. bitmap.width . " " . bitmap.height . "`n"
. "255`n")
  loop % bitmap.height
  {
    height := A_Index
    loop % bitmap.width
    {
      width := A_Index
      color := bitmap[height, width] 
      file.Write(color.R . " ")
      file.Write(color.G . " ")
      file.Write(color.B . " ")
    }
    file.write("`n")
  }
  file.close()
 return 0
}

[edit] C

Interface:

void output_ppm(FILE *fd, image img);

Implementation:

#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);
}

[edit] C#

This implementation uses a StreamWriter to write the header in text, then writes the pixel data in binary using a BinaryWriter.

using System;
using System.IO;
class PPMWriter
{
    public static void WriteBitmapToPPM(string file, Bitmap bitmap){
        //Use a streamwriter to write the text part of the encoding
        var writer = new StreamWriter(file);
        writer.Write("P6" + Environment.NewLine);
        writer.Write(bitmap.Width + " " +bitmap.Height + Environment.NewLine);
        writer.Write("255" + Environment.NewLine);
        writer.Close();
        //Switch to a binary writer to write the data
        var writerB = new BinaryWriter(new FileStream(file, FileMode.Append));
        for(int x=0; x<bitmap.Width;x++)
            for (int y = 0; y < bitmap.Height; y++)
            {
                var color = bitmap.GetPixel(x, y);
                writerB.Write(color.Red);
                writerB.Write(color.Green);
                writerB.Write(color.Blue);
            }
        writerB.Close();
    }
}

[edit] Common Lisp

(defun write-rgb-buffer-to-ppm-file (filename buffer)
  (with-open-file (stream filename 
			  :element-type '(unsigned-byte 8)
			  :direction :output 
			  :if-does-not-exist :create
			  :if-exists :supersede)
    (let* ((dimensions (array-dimensions buffer))
	   (width (first dimensions))
	   (height (second dimensions))
	   (header (format nil "P6~A~D ~D~A255~A" 
			   #\newline
			   width height #\newline
			   #\newline)))
      (loop 
	 :for char :across header 
	 :do (write-byte (char-code char) stream)) #| Assumes char-codes match ASCII |#
 
      (loop 
	 :for x :upfrom 0 :below width
	 :do (loop :for y :upfrom 0 :below height 
		:do (let ((pixel (rgb-pixel buffer x y)))
		      (let ((red (rgb-pixel-red pixel))
			    (green (rgb-pixel-green pixel))
			    (blue (rgb-pixel-blue pixel)))
			(write-byte red stream)
			(write-byte green stream)
			(write-byte blue stream)))))))
  filename)

[edit] D

Works with: tango

This describes modifications that needs to be done to class P6Image described on Read ppm file problem page.

Two additional imports are needed:

import tango.io.protocol.Writer;
import tango.io.protocol.model.IWriter;

P6Image will implement IWritable interface

class P6Image : IWritable {
    //....
 
    // additional convinient constructor
    this(RgbBitmap bitmap, ubyte maxVal) {
        this.bitmap = bitmap;
        _maxVal = maxVal;
        gotImg = 1;
    }
 
    // implements tango's IWritable, only one method needed
    override
    void write (IWriter output)
    {
        static const char space = ' ';
        static const char newline = '\n';
        if (! gotImg) throw new NoImageException;
 
        // unfortunatelly, we can't output(type),
        // because arrays are prefixed with array length by IWriter
        foreach (sign; type) output (sign);
        output (newline);
        foreach (sign; .toString(bitmap.width)) output (sign);
        output (space);
        foreach (sign; .toString(bitmap.height)) output (sign);
        output (newline);
 
        foreach (sign; .toString(_maxVal)) output (sign);
        output (newline);
 
        output.buffer.append(bitmap.data);
        output (); // flush
    }
}

Saving a file is easy as a pie:

auto p6 = new P6Image(new FileConduit("image.ppm"));
auto write = new Writer(new FileConduit("out.ppm", FileConduit.WriteCreate));
 
write (p6);

[edit] E

The code for this task is incorporated into Basic bitmap storage#E.

[edit] 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

[edit] Fortran

Works with: Fortran version 90 and later It loads RCImageBasic module, which is defined here.

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

[edit] 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
    let die = fail "readNetpbm: bad format"
    ppm <- readFile path
    let (s, rest) = splitAt 2 ppm
    unless (s == magicNumber) die
    let getNum :: String -> IO (Int, String)
        getNum ppm = do
            let (s, rest) = span isDigit $ skipBlanks ppm
            when (null s) die
            return (read s, rest)
    (width, rest) <- getNum rest
    (height, rest) <- getNum rest
    (_, c : rest) <-
        if getMaxval then getNum rest else return (nil, rest)
    unless (isSpace c) die
    i <- stToIO $ listImage width height $
        fromNetpbm $ map fromEnum rest
    return i
  where 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 = withFile path WriteMode $ \h -> do
    (width, height) <- stToIO $ dimensions i
    let w = hPutStrLn h
    w $ magicNumber
    w $ show width ++ " " ++ show height
    unless (null maxval) (w maxval)
    stToIO (getPixels i) >>= hPutStr h . toNetpbm
  where magicNumber = netpbmMagicNumber (nil :: c)
        maxval = netpbmMaxval (nil :: c)

[edit] J

Solution:

require 'files'
 
NB. ($x) is height, width, colors per pixel
writeppm=:dyad define
  header=. 'P6',LF,(":1 0{$x),LF,'255',LF
  (header,,x{a.) fwrite y
)

Example: Using routines from Basic Bitmap Storage:

   NB. create 10 by 10 block of magenta pixels in top right quadrant of a 300 wide by 600 high green image
   myimg=: ((145 + pixellist) ; 255 0 255) setPixels 0 255 0 makeRGB 600 200
   myimg writeppm jpath '~temp/myimg.ppm'
360015

[edit] Modula-3

Bitmap is the module from Basic Bitmap Storage.

INTERFACE PPM;
 
IMPORT Bitmap, Pathname;
 
PROCEDURE Create(imgfile: Pathname.T; img: Bitmap.T);
 
END PPM.

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.

[edit] 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;
;;

[edit] Oz

As a function in the module BitmapIO.oz:

functor
import
   Bitmap
   Open
export
   %% Read
   Write
define
   %% Omitted: Read
 
   proc {Write B=bitmap(array2d(width:W height:H ...)) Filename}
      F = {New Open.file init(name:Filename flags:[write create truncate binary])}
 
      proc {WriteColor8 color(R G B)}
	 {F write(vs:[R G B])}
      end
 
      fun {ToBytes C}
	 [C div 0x100  C mod 0x100]
      end
 
      proc {WriteColor16 color(R G B)}
	 {F write(vs:{Flatten {Map [R G B] ToBytes}})}
      end
 
      MaxCol = {Bitmap.maxValue B}
      MaxVal#Writer = if MaxCol =< 0xff then 0xff#WriteColor8
		      else 0xffff#WriteColor16
		      end
      Header = "P6\n"#W#" "#H#" "#MaxVal#"\n"
   in
      try
	 {F write(vs:Header)}
	 {Bitmap.forAllPixels B Writer}
      finally
	 {F close}
      end
   end
end

[edit] 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.)

#! /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;

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

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

[edit] PHP

Writes a P6 binary file

class Bitmap {
  public $data;
  public $w;
  public $h;
  public function __construct($w = 16, $h = 16){
    $white = array_fill(0, $w, array(255,255,255));
    $this->data = array_fill(0, $h, $white);
    $this->w = $w;
    $this->h = $h;
  }
  //Fills a rectangle, or the whole image with black by default
  public function fill($x = 0, $y = 0, $w = null, $h = null, $color = array(0,0,0)){
    if (is_null($w)) $w = $this->w;
    if (is_null($h)) $h = $this->h;
    $w += $x;
    $h += $y;
    for ($i = $y; $i < $h; $i++){
      for ($j = $x; $j < $w; $j++){
        $this->setPixel($j, $i, $color);
      }
    }
  }
  public function setPixel($x, $y, $color = array(0,0,0)){
    if ($x >= $this->w) return false;
    if ($x < 0) return false;
    if ($y >= $this->h) return false;
    if ($y < 0) return false;
    $this->data[$y][$x] = $color;
  }
  public function getPixel($x, $y){
    return $this->data[$y][$x];
  }
  public function writeP6($filename){
    $fh = fopen($filename, 'w');
    if (!$fh) return false;
    fputs($fh, "P6 {$this->w} {$this->h} 255\n");
    foreach ($this->data as $row){
      foreach($row as $pixel){
        fputs($fh, pack('C', $pixel[0]));
        fputs($fh, pack('C', $pixel[1]));
        fputs($fh, pack('C', $pixel[2]));
      }
    }
    fclose($fh);
  }
}
 
$b = new Bitmap(16,16);
$b->fill();
$b->fill(2, 2, 18, 18, array(240,240,240));
$b->setPixel(0, 15, array(255,0,0));
$b->writeP6('p6.ppm');

[edit] PureBasic

Procedure SaveImageAsPPM(Image, file$, Binary = 1)
  ; Author Roger Rösch (Nickname Macros)
  IDFiIe = CreateFile(#PB_Any, file$)
  If IDFiIe
    If StartDrawing(ImageOutput(Image))
      WriteStringN(IDFiIe, "P" + Str(3 + 3*Binary))
      WriteStringN(IDFiIe, "#Created with PureBasic using a Function created from Macros for Rosettacode.org ")
      width  = ImageWidth(Image)
      height = ImageHeight(Image)
      WriteStringN(IDFiIe, Str(width) + " " + Str(height))
      WriteStringN(IDFiIe, "255")
      If Binary = 0
        For y = 0 To height - 1
          For x = 0 To width - 1
            color = Point(x, y)
            WriteString(IDFiIe, Str(Red(color)) + " " + Str(Green(color)) + " " + Str(Blue(color)) + "  ")
          Next
          WriteStringN(IDFiIe, "")
        Next
      Else  ; Save in Binary Format
        For y = 0 To height - 1
          For x = 0 To width - 1
            color = Point(x, y)
            WriteByte(IDFiIe, Red(color))
            WriteByte(IDFiIe, Green(color))
            WriteByte(IDFiIe, Blue(color))
          Next
        Next
      EndIf
      StopDrawing()
    EndIf
    CloseFile(IDFiIe)
  EndIf
EndProcedure

[edit] Python

Works with: Python version 3.1

Extending the example given here

 
# String masquerading as ppm file (version P3)
import io
ppmfileout = io.StringIO('')
 
def writeppmp3(self, f):
    self.writeppm(f, ppmformat='P3')
 
def writeppm(self, f, ppmformat='P6'):
    assert ppmformat in ['P3', 'P6'], 'Format wrong'
    magic = ppmformat + '\n'
    comment = '# generated from Bitmap.writeppm\n'
    maxval = max(max(max(bit) for bit in row) for row in self.map)
    assert ppmformat == 'P3' or 0 <= maxval < 256, 'R,G,B must fit in a byte'
    if ppmformat == 'P6':
        fwrite = lambda s: f.write(bytes(s, 'UTF-8'))
        maxval = 255
    else:
        fwrite = f.write
        numsize=len(str(maxval))
    fwrite(magic)
    fwrite(comment)
    fwrite('%i %i\n%i\n' % (self.width, self.height, maxval))
    for h in range(self.height-1, -1, -1):
        for w in range(self.width):
            r, g, b = self.get(w, h)
            if ppmformat == 'P3':
                fwrite('   %*i %*i %*i' % (numsize, r, numsize, g, numsize, b))
            else:
                fwrite('%c%c%c' % (r, g, b))
        if ppmformat == 'P3':
            fwrite('\n')
 
Bitmap.writeppmp3 = writeppmp3
Bitmap.writeppm = writeppm
 
# Draw something simple
bitmap = Bitmap(4, 4, black)
bitmap.fillrect(1, 0, 1, 2, white)
bitmap.set(3, 3, Colour(127, 0, 63))
# Write to the open 'file' handle
bitmap.writeppmp3(ppmfileout)
# Whats in the generated PPM file
print(ppmfileout.getvalue())
 
'''
The print statement above produces the following output :
 
P3
# generated from Bitmap.writeppmp3
4 4
255
     0   0   0     0   0   0     0   0   0   127   0  63
     0   0   0     0   0   0     0   0   0     0   0   0
     0   0   0   255 255 255     0   0   0     0   0   0
     0   0   0   255 255 255     0   0   0     0   0   0
 
'''
 
# Write a P6 file
ppmfileout = open('tmp.ppm', 'wb')
bitmap.writeppm(ppmfileout)
ppmfileout.close()

[edit] R

Library: pixmap

 
# View the existing code in the library
library(pixmap)
pixmap::write.pnm
 
#Usage
write.pnm(theimage, filename)

[edit] Ruby

Extending Basic_bitmap_storage#Ruby

class RGBColour
  def values
    [@red, @green, @blue]
  end
end
 
class Pixmap
  def save(filename)
    File.open(filename, 'w') do |f|
      f.puts "P6", "#{@width} #{@height}", "255"
      f.binmode
      @width.times do |x|
        @height.times do |y|
          f.print @data[x][y].values.pack('C3')
        end
      end
    end
  end
  alias_method :write, :save
end

[edit] Scheme

Works with: Scheme version R $5$ RS

(define (write-ppm image file)
  (define (write-image image)
    (define (write-row row)
      (define (write-colour colour)
        (if (not (null? colour))
            (begin (write-char (integer->char (car colour)))
                   (write-colour (cdr colour)))))
      (if (not (null? row))
          (begin (write-colour (car row)) (write-row (cdr row)))))
    (if (not (null? image))
        (begin (write-row (car image)) (write-image (cdr image)))))
  (with-output-to-file file
    (lambda ()
      (begin (display "P6")
             (newline)
             (display (length (car image)))
             (display " ")
             (display (length image))
             (newline)
             (display 255)
             (newline)
             (write-image image)))))

Example using definitions in Basic bitmap storage#Scheme:

(define image (make-image 800 600))
(image-fill! image *black*)
(image-set! image 400 300 *blue*)
(write-ppm image "out.ppm")

[edit] Tcl

Library: Tk Referring to Basic bitmap storage#Tcl:

package require Tk
 
proc output_ppm {image filename} {
    $image write $filename -format ppm
}
 
set img [newImage 150 150]
fill $img red
setPixel $img green 40 40
output_ppm $img filename.ppm
 
# check the file format:
set fh [open filename.ppm]
puts [gets $fh] ;# ==> P6
puts [gets $fh] ;# ==> 150 150
puts [gets $fh] ;# ==> 255
binary scan [read $fh 3] c3 pixel
foreach colour $pixel {puts [expr {$colour & 0xff}]} ;# ==> 255 \n 0 \n 0 \n
close $fh

[edit] 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