Bitmap/Write a PPM file: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|Euphoria}}: slightly modified in more euphorean way)
(→‎{{header|Euphoria}}: added example of procedure writing bitmap data storage)
Line 247: Line 247:
end for
end for
close(fn)</lang>
close(fn)</lang>

Procedure writing [[Bitmap#Euphoria|bitmap]] data storage:
<lang euphoria>procedure write_ppm(sequence filename, sequence image)
integer fn,dimx,dimy
dimx = length(image[1])
dimy = length(image)
fn = open(filename,"wb")
printf(fn, "P6\n%d %d\n255\n", {dimx,dimy})
for j = 1 to dimy do
for i = 1 to dimx do
puts(fn,image[i][j])
end for
end for
close(fn)
end procedure</lang>


=={{header|Forth}}==
=={{header|Forth}}==

Revision as of 14:13, 24 June 2011

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

AutoHotkey

Works with: AutoHotkey_L version 45

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

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

} </lang>

C

This is one file program: <lang c>#include <stdlib.h>

  1. include <stdio.h>

int main(void) {

 const int dimx = 800, dimy = 800;
 int i, j;
 FILE *fp = fopen("first.ppm", "wb"); /* b - binary mode */
 (void) fprintf(fp, "P6\n%d %d\n255\n", dimx, dimy);
 for (j = 0; j < dimy; ++j)
 {
   for (i = 0; i < dimx; ++i)
   {
     static unsigned char color[3];
     color[0] = i % 255;  /* red */
     color[1] = j % 255;  /* green */
     color[2] = (i * j) % 255;  /* blue */
     (void) fwrite(color, 1, 3, fp);
   }
 }
 (void) fclose(fp);
 return EXIT_SUCCESS;

}</lang>


Here is program which uses imglib library. One must create files imglib.h and imglib.c using code from category Raster graphics operations.s. Start from bitmap page

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;
 (void) fprintf(fd, "P6\n%d %d\n255\n", img->width, img->height);
 n = img->width * img->height;
 (void) fwrite(img->buf, sizeof(pixel), n, fd);
 (void) fflush(fd);

}</lang>

C#

This implementation uses a StreamWriter to write the header in text, then writes the pixel data in binary using a BinaryWriter. <lang csharp>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();
   }

}</lang>

Common Lisp

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

D

Library: Tango

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

Two additional imports are needed: <lang D>import tango.io.protocol.Writer; import tango.io.protocol.model.IWriter;</lang>

P6Image will implement IWritable interface <lang D>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
   }

}</lang>

Saving a file is easy as a pie: <lang D>auto p6 = new P6Image(new FileConduit("image.ppm")); auto write = new Writer(new FileConduit("out.ppm", FileConduit.WriteCreate));

write (p6);</lang>

E

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

Euphoria

Translation of: C

<lang euphoria>constant dimx = 800, dimy = 800 constant fn = open("first.ppm","wb") -- b - binary mode sequence color printf(fn, "P6\n%d %d\n255\n", {dimx,dimy}) for j = 0 to dimy-1 do

   for i = 0 to dimx-1 do
       color = {
           remainder(i,255), -- red
           remainder(j,255), -- green
           remainder(i*j,255) -- blue
       }
       puts(fn,color)
   end for

end for close(fn)</lang>

Procedure writing bitmap data storage: <lang euphoria>procedure write_ppm(sequence filename, sequence image)

   integer fn,dimx,dimy
   dimx = length(image[1])
   dimy = length(image)
   fn = open(filename,"wb")
   printf(fn, "P6\n%d %d\n255\n", {dimx,dimy})
   for j = 1 to dimy do
       for i = 1 to dimx do
           puts(fn,image[i][j])
       end for
   end for
   close(fn)

end procedure</lang>

Forth

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

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>

GAP

<lang gap># Dirty implementation

  1. Only P3 format, an image is a list of 3 matrices (r, g, b)
  2. Max color is always 255

WriteImage := function(name, img)

 local f, r, g, b, i, j, maxcolor, nrow, ncol, dim;
 f := OutputTextFile(name, false);
 r := img[1];
 g := img[2];
 b := img[3];
 dim := DimensionsMat(r);
 nrow := dim[1];
 ncol := dim[2];
 maxcolor := 255;
 WriteLine(f, "P3");
 WriteLine(f, Concatenation(String(ncol), " ", String(nrow), " ", String(maxcolor)));
 for i in [1 .. nrow] do
   for j in [1 .. ncol] do
     WriteLine(f, Concatenation(String(r[i][j]), " ", String(g[i][j]), " ", String(b[i][j])));
   od;
 od;
 CloseStream(f);

end;

PutPixel := function(img, i, j, color)

 img[1][i][j] := color[1];
 img[2][i][j] := color[2];
 img[3][i][j] := color[3];

end;

GetPixel := function(img, i, j)

 return [img[1][i][j], img[2][i][j], img[3][i][j]];

end;

NewImage := function(nrow, ncol, color)

 local r, g, b;
 r := color[1] + NullMat(nrow, ncol);
 g := color[2] + NullMat(nrow, ncol);
 b := color[3] + NullMat(nrow, ncol);
 return [r, g, b];

end;

  1. Reproducing the example from Wikipedia

black := [ 0, 0, 0 ]; g := NewImage(2, 3, black); PutPixel(g, 1, 1, [255, 0, 0]); PutPixel(g, 1, 2, [0, 255, 0]); PutPixel(g, 1, 3, [0, 0, 255]); PutPixel(g, 2, 1, [255, 255, 0]); PutPixel(g, 2, 2, [255, 255, 255]); PutPixel(g, 2, 3, [0, 0, 0]); WriteImage("example.ppm", g);</lang>

Go

Code below writes 8-bit P6 format only. See Bitmap task for additional file needed to build working raster package. <lang go>package raster

import (

   "fmt"
   "io"
   "os"

)

// WriteTo outputs 8-bit P6 PPM format to an io.Writer. func (b *Bitmap) WritePpmTo(w io.Writer) (err os.Error) {

   // magic number
   if _, err = fmt.Fprintln(w, "P6"); err != nil {
       return
   }
   // comments
   for _, c := range b.Comments {
       if _, err = fmt.Fprintln(w, c); err != nil {
           return
       }
   }
   // x, y, depth
   _, err = fmt.Fprintf(w, "%d %d\n255\n", b.cols, b.rows)
   if err != nil {
       return
   }
   // raster data in a single write
   b3 := make([]byte, 3*len(b.px))
   n1 := 0
   for _, px := range b.px {
       b3[n1] = px.R
       b3[n1+1] = px.G
       b3[n1+2] = px.B
       n1 += 3
   }
   if _, err = w.Write(b3); err != nil {
       return
   }
   return

}

// WriteFile writes to the specified filename. func (b *Bitmap) WritePpmFile(fn string) (err os.Error) {

   var f *os.File
   if f, err = os.Create(fn); err != nil {
       return
   }
   if err = b.WritePpmTo(f); err != nil {
       return
   }
   return f.Close()

}</lang> Demonstration program. Note that it imports package raster. To build package raster, put code above in one file, put code from Bitmap task in another, and compile and link them into a Go package. <lang go>package main

// Files required to build supporting package raster are found in: // * This task (immediately above) // * Bitmap task

import (

   "raster"
   "fmt"

)

func main() {

   b := raster.NewBitmap(400, 300)
   b.FillRgb(0x240008) // a dark red
   err := b.WritePpmFile("write.ppm")
   if err != nil {
       fmt.Println(err)
   }

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

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

J

Solution: <lang j>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

)</lang> Example: Using routines from Basic Bitmap Storage: <lang j> 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</lang>

Lua

<lang lua>function Write_PPM( filename, image )

   local size_x, size_y = #image, #image[1]
   local fp = io.open( filename, "wb" )
   fp:write( string.format( "P6\n%d %d\n255\n", size_x, size_y ) )
   
   for y = 1, size_y do
       for x = 1, size_x do
          fp:write( string.char(image[x][y][1]), string.char(image[x][y][2]), string.char(image[x][y][3]) )
       end
   end
   
   fp:close()

end

-- example how to use the function -- create array and initialize it image = {} for i = 1, 100 do

   image[i] = {}
   for j = 1, 100 do
       image[i][j] = { 0, 0, 255 } 
   end

end

Write_PPM( "pic.ppm", image )</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>

Oz

As a function in the module BitmapIO.oz: <lang 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</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>

PHP

Writes a P6 binary file <lang PHP>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');</lang>

PL/I

<lang PL/I>/* BITMAP FILE: write out a file in PPM format, P6 (binary). 14/5/2010 */ test: procedure options (main);

  declare image (0:19,0:19) bit (24);
  declare 1 pixel union,
           2 color bit (24) aligned,
           2 primaries,
              3 R character (1),
              3 G character (1),
              3 B character (1);
  declare ch character (1);
  declare (i, j) fixed binary;
  declare out file record;
  open file (out) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) OUTPUT;
  ch = 'P'; write file (out) from (ch);
  ch = '6'; write file (out) from (ch);
  call put_integer (hbound(image, 1));
  call put_integer (hbound(image, 2));
  call put_integer (255);
  do i = 0 to hbound(image,1);
     do j = 0 to hbound(image, 2);
        color = image(i,j);
        write file (out) from (R);
        write file (out) from (G);
        write file (out) from (B);
     end;
  end;

put_integer: procedure (k);

  declare k fixed binary;
  declare s character (30) varying;
  declare i fixed binary;
  declare ch character (1);
  s = k;
  s = trim(s);
  do i = 1 to length(s);
     ch = substr(s, i, 1);
     write file (out) from (ch);
  end;
  ch = '09'x;
  write file (out) from (ch);

end put_integer; end test;</lang>

PicoLisp

<lang PicoLisp>(de ppmWrite (Ppm File)

  (out File
     (prinl "P6")
     (prinl (length (car Ppm)) " " (length Ppm))
     (prinl 255)
     (for Y Ppm (for X Y (apply wr X))) ) )</lang>

PureBasic

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

Python

Works with: Python version 3.1

Extending the example given here <lang python>

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

  1. Draw something simple

bitmap = Bitmap(4, 4, black) bitmap.fillrect(1, 0, 1, 2, white) bitmap.set(3, 3, Colour(127, 0, 63))

  1. Write to the open 'file' handle

bitmap.writeppmp3(ppmfileout)

  1. Whats in the generated PPM file

print(ppmfileout.getvalue())

The print statement above produces the following output :

P3

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

  1. Write a P6 file

ppmfileout = open('tmp.ppm', 'wb') bitmap.writeppm(ppmfileout) ppmfileout.close() </lang>

R

Library: pixmap

<lang r>

  1. View the existing code in the library

library(pixmap) pixmap::write.pnm

  1. Usage

write.pnm(theimage, filename) </lang>

Ruby

Extending Basic_bitmap_storage#Ruby <lang 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</lang>

Scala

Extends Pixmap class from task Read PPM file. <lang scala>object Pixmap {

  def save(bm:RgbBitmap, filename:String)={
     val out=new DataOutputStream(new FileOutputStream(filename))
     out.writeBytes("P6\u000a%d %d\u000a%d\u000a".format(bm.width, bm.height, 255))
     for(y <- 0 until bm.height; x <- 0 until bm.width; c=bm.getPixel(x, y)){
        out.writeByte(c.getRed)
        out.writeByte(c.getGreen)
        out.writeByte(c.getBlue)
     }
  }

}</lang>

Scheme

Works with: Scheme version RRS

<lang scheme>(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)))))</lang>

Example using definitions in Basic bitmap storage#Scheme: <lang scheme>(define image (make-image 800 600)) (image-fill! image *black*) (image-set! image 400 300 *blue*) (write-ppm image "out.ppm")</lang>

Tcl

Library: Tk

Referring to Basic bitmap storage#Tcl: <lang 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

  1. 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</lang>

Visual Basic .NET

<lang vbnet>Public Shared Sub SaveRasterBitmapToPpmFile(ByVal rasterBitmap As RasterBitmap, ByVal filepath As String)

  Dim header As String = String.Format("P6{0}{1}{2}{3}{0}255{0}", vbLf, rasterBitmap.Width, " "c, rasterBitmap.Height)
  Dim bufferSize As Integer = header.Length + (rasterBitmap.Width * rasterBitmap.Height * 3)
  Dim bytes(bufferSize - 1) As Byte
  Buffer.BlockCopy(Encoding.ASCII.GetBytes(header.ToString), 0, bytes, 0, header.Length)
  Dim index As Integer = header.Length
  For y As Integer = 0 To rasterBitmap.Height - 1
     For x As Integer = 0 To rasterBitmap.Width - 1
        Dim color As Rgb = rasterBitmap.GetPixel(x, y)
        bytes(index) = color.R
        bytes(index + 1) = color.G
        bytes(index + 2) = color.B
        index += 3
     Next
  Next
  My.Computer.FileSystem.WriteAllBytes(filepath, bytes, False)

End Sub</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