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

11l

T Colour = BVec3 V black = Colour(0, 0, 0) V white = Colour(255, 255, 255) T Bitmap Int width, height Colour background [[Colour]] map F (width = 40, height = 40, background = white) assert(width > 0 & height > 0) .width = width .height = height .background = background .map = (0 . < height).map(h ->(0 . < @width).map(w ->@@background)) F fillrect(x, y, width, height, colour = black) assert(x >= 0 & y >= 0 & width > 0 & height > 0) L(h) 0 .< height L(w) 0 .< width .map[y + h][x + w] = colour F set(x, y, colour = black) .map[y][x] = colour F get(x, y) R .map[y][x] F writeppmp3() V magic = "P3\n" V comment = "# generated from Bitmap.writeppmp3\n" V s = magic‘’comment‘’("#. #.\n#.\n".format(.width, .height, 255)) L(h) (.height - 1 .< -1).step(-1) L(w) 0 .< .width V (r, g, b) = .get(w, h) s ‘’= ‘ #3 #3 #3’.format(r, g, b) s ‘’= "\n" R s F writeppmp6() V magic = "P6\n" V comment = "# generated from Bitmap.writeppmp6\n" [Byte] b b [+]= magic.encode() b [+]= comment.encode() b [+]= ("#. #.\n#.\n".format(.width, .height, 255)).encode() L(h) (.height - 1 .< -1).step(-1) L(w) 0 .< .width V (r, g, bl) = .get(w, h) b [+]= [r, g, bl] R b V bitmap = Bitmap(4, 4, black) bitmap.fillrect(1, 0, 1, 2, white) bitmap.set(3, 3, Colour(127, 0, 63)) print(bitmap.writeppmp3()) File(‘tmp.ppm’, WRITE).write_bytes(bitmap.writeppmp6())

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

Action!

INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap PROC SaveHeader(RgbImage POINTER img CHAR ARRAY format BYTE dev) PrintDE(dev,format) PrintBD(dev,img.w) PutD(dev,32) PrintBDE(dev,img.h) PrintBDE(dev,255) RETURN PROC SavePPM3(RgbImage POINTER img CHAR ARRAY path) BYTE dev=[1],x,y RGB c Close(dev) Open(dev,path,8) SaveHeader(img,"P3",dev) FOR y=0 TO img.h-1 DO FOR x=0 TO img.w-1 DO GetRgbPixel(img,x,y,c) PrintBD(dev,c.r) PutD(dev,32) PrintBD(dev,c.g) PutD(dev,32) PrintBD(dev,c.b) IF x=img.w-1 THEN PutDE(dev) ELSE PutD(dev,32) FI OD OD Close(dev) RETURN PROC SavePPM6(RgbImage POINTER img CHAR ARRAY path) BYTE dev=[1],x,y RGB c Close(dev) Open(dev,path,8) SaveHeader(img,"P6",dev) FOR y=0 TO img.h-1 DO FOR x=0 TO img.w-1 DO GetRgbPixel(img,x,y,c) PutD(dev,c.r) PutD(dev,c.g) PutD(dev,c.b) OD OD Close(dev) RETURN PROC Load(CHAR ARRAY path) CHAR ARRAY line(255) BYTE dev=[1] Close(dev) Open(dev,path,4) WHILE Eof(dev)=0 DO InputSD(dev,line) PrintE(line) OD Close(dev) RETURN PROC Main() BYTE ARRAY rgbdata=[ 0 0 0 0 0 255 0 255 0 255 0 0 0 255 255 255 0 255 255 255 0 255 255 255 31 63 127 63 31 127 127 31 63 127 63 31] BYTE width=[3],height=[4] RgbImage img CHAR ARRAY path3="D:PPM3.PPM" CHAR ARRAY path6="D:PPM6.PPM" Put(125) PutE() ;clear the screen InitRgbImage(img,width,height,rgbdata) PrintF("Saving %S. %E%E",path3) SavePPM3(img,path3) PrintF("Saving %S. %E%E",path6) SavePPM6(img,path6) PrintF("Loading %S. %E%E",path3) Load(path3) RETURN

Saving D:PPM3.PPM. Saving D:PPM6.PPM. Loading D:PPM3.PPM. P3 3 4 255 0 0 0 0 0 255 0 255 0 255 0 0 0 255 255 255 0 255 255 255 0 255 255 255 31 63 127 63 31 127 127 31 63 127 63 31

Ada

with Ada.Characters.Latin_1; with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; with Bitmap_Store; use Bitmap_Store; -- This package is defined in the Bitmap task. 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.

Aime

integer i, h, j, w; file f; w = 640; h = 320; f.create("out.ppm", 00644); f.form("P6\n~ ~\n255\n", w, h); j = 0; do < srand(j >> 4); i = 0; do < 16.times(f_bytes, f, drand(255), drand(255), drand(255)); >while ((i += 16) < w); >while ((j += 1) < h);

Applesoft BASIC

100 W = 8 110 H = 8 120 BA = 24576 130 HIMEM: 8192 140 D$ = CHR$ (4) 150 M$ = CHR$ (13) 160 P6$ = "P6" + M$ + STR$ (W) + " " + STR$ (H) + M$ + "255" + M$ 170 FOR I = 1 TO LEN (P6$) 180 POKE BA + I - 1, ASC ( MID$ (P6$,I,1)) 190 NEXT I 200 BB = BA + I - 1 210 BL = (BB + W * H * 3) - BA 220 C = 255 + 255 * 256 + 0 * 65536: GOSUB 600FILL 230 X = 4:Y = 5:C = 127 + 127 * 256 + 255 * 65536: GOSUB 500"SET PIXEL" 240 PRINT D$"BSAVE BITMAP.PPM,A"BA",L"BL 250 END 500 R = C - INT (C / 256) * 256:B = INT (C / 65536):G = INT (C / 256) - B * 256:A = BB + X * 3 + Y * W * 3: POKE A,R: POKE A + 1,G: POKE A + 2,B: RETURN 600 FOR Y = 0 TO H - 1: FOR X = 0 TO W - 1: GOSUB 500: NEXT X,Y: RETURN 

ATS

For this code you will also need bitmap_task.sats and bitmap_task.dats from Bitmap#ATS.

The static file provides templates for writing a PPM in either raw or plain format, regardless of what type you use to represent a pixel. The dynamic file, however, provides implementations only for the rgb24 type defined in bitmap_task.sats .

The ATS static file

The following interface file should be named bitmap_write_ppm_task.sats .

#define ATS_PACKNAME "Rosetta_Code.bitmap_write_ppm_task" staload "bitmap_task.sats" (* Only pixmaps with positive width and height (pixmap1) are accepted for writing a PPM. *) fn pixmap_write_ppm_raw_or_plain (outf : FILEref, pix : !pixmap1 a, plain : bool) : bool (* success *) fn pixmap_write_ppm_raw (outf : FILEref, pix : !pixmap1 a) : bool (* success *) overload pixmap_write_ppm with pixmap_write_ppm_raw_or_plain overload pixmap_write_ppm with pixmap_write_ppm_raw

The ATS dynamic file

The following file of implementations should be named bitmap_write_ppm_task.dats .

(*------------------------------------------------------------------*) #define ATS_DYNLOADFLAG 0 #define ATS_PACKNAME "Rosetta_Code.bitmap_write_ppm_task" #include "share/atspre_staload.hats" staload "bitmap_task.sats" (* You need to staload bitmap_task.dats, so the ATS compiler will have access to its implementations of templates. But we staload it anonymously, so the programmer will not have access. *) staload _ = "bitmap_task.dats" staload "bitmap_write_ppm_task.sats" (*------------------------------------------------------------------*) (* Realizing that MAXVAL, and how to represent depend on the pixel type, we implement the template functions ONLY for pixels of type rgb24. *) (* We will implement raw PPM using "dump", and plain PPM using the "get a pixel" square brackets. The latter method is simpler than writing a different implementation of pixmap$pixels_dump, and also helps us satisfy the stated requirements of the task. ("Dump" goes beyond what was asked for.) *) implement pixmap_write_ppm_raw_or_plain (outf, pix, plain) = begin fprintln! (outf, (if plain then "P3" else "P6") : string); fprintln! (outf, width pix, " ", height pix); fprintln! (outf, "255"); if ~plain then dump (outf, pix) else let val w = width pix and h = height pix prval [w : int] EQINT () = eqint_make_guint w prval [h : int] EQINT () = eqint_make_guint h fun loop .. (pix : !pixmap (rgb24, w, h), x : size_t x, y : size_t y) : void = if y = h then () else if x = w then loop (pix, i2sz 0, succ y) else let val @(r, g, b) = rgb24_values pix[x, y] in fprintln! (outf, r, " ", g, " ", b); loop (pix, succ x, y) end in loop (pix, i2sz 0, i2sz 0); true end end implement pixmap_write_ppm_raw (outf, pix) = pixmap_write_ppm_raw_or_plain (outf, pix, false) (*------------------------------------------------------------------*) #ifdef BITMAP_WRITE_PPM_TASK_TEST #then implement main0 () = let val bgcolor = rgb24_make (217u, 217u, 214u) and fgcolor1 = rgb24_make (210, 0, 0) and fgcolor2 = rgb24_make (0, 150, 0) and fgcolor3 = rgb24_make (0, 0, 220) stadef w = 300 stadef h = 200 val w : size_t w = i2sz 300 and h : size_t h = i2sz 200 val @(pfgc | pix) = pixmap_make (w, h, bgcolor) val () = let var x : Size_t in for* .. (x : size_t x) => (x := i2sz 0; x <> w; x := succ x) begin pix[x, i2sz 50] := fgcolor1; pix[x, i2sz 100] := fgcolor2; pix[x, i2sz 150] := fgcolor3 end end val outf_raw = fileref_open_exn ("image-raw.ppm", file_mode_w) and outf_plain = fileref_open_exn ("image-plain.ppm", file_mode_w) val success = pixmap_write_ppm (outf_raw, pix) val () = assertloc success val success = pixmap_write_ppm (outf_plain, pix, true) val () = assertloc success in fileref_close outf_raw; fileref_close outf_plain; free (pfgc | pix) end #endif (*------------------------------------------------------------------*)

There is a test program that you can compile and run thus:

$ patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_LIBC -DATS BITMAP_WRITE_PPM_TASK_TEST bitmap_task.ats $ ./a.out

If everything worked, you should end up with two image files, image-raw.ppm and image-plain.ppm . The former will have been made with the "dump" functionality that outputs the raw pixel data in one call to fwrite(3) . The latter will have been written more in the way the task assumes: reading pixels individually, left-to-right and top-to-bottom.

The images should appear thus:

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 #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 > 

AWK

#!/usr/bin/awk -f BEGIN  split("255,0,0,255,255,0",R,","); split("0,255,0,255,255,0",G,","); split("0,0,255,0,0,0",B,","); outfile = "P3.ppm"; printf("P3\n2 3\n255\n") >outfile; for (k=1; klength(R); k++)  printf("%3i %3i %3i\n",R[k],G[k],B[k])>outfile > close(outfile); > 

BBC BASIC

Width% = 200 Height% = 200 VDU 23,22,Width%;Height%;8,16,16,128 *display c:\lena f% = OPENOUT("c:\lena.ppm") IF f%=0 ERROR 100, "Failed to open output file" BPUT #f%, "P6" BPUT #f%, "# Created using BBC BASIC" BPUT #f%, STR$(Width%) + " " +STR$(Height%) BPUT #f%, "255" FOR y% = Height%-1 TO 0 STEP -1 FOR x% = 0 TO Width%-1 rgb% = FNgetpixel(x%,y%) BPUT #f%, rgb% >> 16 BPUT #f%, (rgb% >> 8) AND &FF BPUT #f%, rgb% AND &FF NEXT NEXT y% CLOSE#f% END DEF FNgetpixel(x%,y%) LOCAL col% col% = TINT(x%*2,y%*2) SWAP ?^col%,?(^col%+2) = col% 

BQN

header_ppm ← "P6 4 8 255 " red ← 255‿0‿0 # a 3-element 1D list grn ← 0‿255‿0 ble ← 0‿0‿255 blk ← 0‿0‿0 gry ← 128‿128‿128 wht ← 255‿255‿255 all ← ∾red‿grn‿ble‿blk‿gry‿wht # join "colors" to 1D list image_ppm ← 8‿4‿3 ⥊ all # reshape "all" to 8 rows by 4 cols by 3, "all" gets reused as needed to fill image_ppm ↩ @ + ⥊ image_ppm # deshape, convert to chars (uint8_t) bytes_ppm ← header_ppm ∾ image_ppm "small.ppm" •file.Bytes bytes_ppm 

header_ppm ← "P6 800 800 255 " image_ppm ← @ + ⥊ > 256|𝕨‿𝕩‿(𝕨×𝕩)>⌜˜ ↕800 "first_bqn.ppm" •file.Bytes header_ppm ∾ image_ppm 

C

This is one file program which writes one color in each step :

#include #include 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 % 256; /* red */ color[1] = j % 256; /* green */ color[2] = (i * j) % 256; /* blue */ (void) fwrite(color, 1, 3, fp); > > (void) fclose(fp); return EXIT_SUCCESS; > 

This program writes whole array in one step :

#include int main()  const char *filename = "n.pgm"; int x, y; /* size of the image */ const int x_max = 100; /* width */ const int y_max = 100; /* height */ /* 2D array for colors (shades of gray) */ unsigned char data[y_max][x_max]; /* color component is coded from 0 to 255 ; it is 8 bit color file */ const int MaxColorComponentValue = 255; FILE * fp; /* comment should start with # */ const char *comment = "# this is my new binary pgm file"; /* fill the data array */ for (y = 0; y  y_max; ++y)  for (x = 0; x  x_max; ++x)  data[y][x] = (x + y) & 255; > > /* write the whole data array to ppm file in one step */ /* create new file, give it a name and open it in binary mode */ fp = fopen(filename, "wb"); /* write header to the file */ fprintf(fp, "P5\n %s\n %d\n %d\n %d\n", comment, x_max, y_max, MaxColorComponentValue); /* write image data bytes to the file */ fwrite(data, sizeof(data), 1, fp); fclose(fp); printf("OK - file %s saved\n", filename); return 0; > 

Here is a program which uses imglib library. One must create files imglib.h and imglib.c using code from category Raster graphics operations. Start from bitmap page This program writes whole array in one step.

void output_ppm(FILE *fd, image img); 

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

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.WriteLine("P6"); writer.WriteLine($" "); writer.WriteLine("255"); 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.Height; x++) for (int y = 0; y  bitmap.Width; y++)  Color color = bitmap.GetPixel(y, x); writerB.Write(color.R); writerB.Write(color.G); writerB.Write(color.B); > writerB.Close(); > > 

C++

#include int main()  constexpr auto dimx = 800u, dimy = 800u; std::ofstream ofs("first.ppm", ios_base::out | ios_base::binary); ofs  <"P6\n"  <dimx  <' '  <dimy  <"\n255\n"; for (auto j = 0u; j  dimy; ++j) for (auto i = 0u; i  dimx; ++i) ofs  <static_castchar>(i % 256)  <static_castchar>(j % 256)  <static_castchar>((i * j) % 256); > 

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) 

D

The Image module contains a savePPM6 function to save binary PPM images.

Delphi

Helper class to enable bitmap export to ppm.

program btm2ppm;  uses System.SysUtils, System.Classes, Vcl.Graphics; type TBitmapHelper = class helper for TBitmap public procedure SaveAsPPM(FileName: TFileName); end; procedure TBitmapHelper.SaveAsPPM(FileName: TFileName); var i, j, color: Integer; Header: AnsiString; ppm: TMemoryStream; begin ppm := TMemoryStream.Create; try Header := Format('P6'#10'%d %d'#10'255'#10, [Self.Width, Self.Height]); writeln(Header); ppm.Write(Tbytes(Header), Length(Header)); for i := 0 to Self.Height - 1 do for j := 0 to Self.Width - 1 do begin color := ColorToRGB(Self.Canvas.Pixels[i, j]); ppm.Write(color, 3); end; ppm.SaveToFile(FileName); finally ppm.Free; end; end; begin with TBitmap.Create do begin LoadFromFile('Input.bmp'); SaveAsPPM('Output.ppm'); Free; end; end. 

E

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

Erlang

Writes a bitmap to PPM file. Uses 24 bit color depth (color max value 255).

-module(ppm). -export([ppm/1, write/2]). -define(WHITESPACE, 10>>). -define(SPACE, 32>>). % data structure introduced in task Bitmap (module ros_bitmap.erl) -record(bitmap,  pixels = nil, shape = 0, 0> >). % create ppm image from bitmap record ppm(Bitmap) -> Width, Height> = Bitmap#bitmap.shape, Pixels = ppm_pixels(Bitmap), Maxval = 255, % original ppm format maximum list_to_binary([ header(), width_and_height(Width, Height), maxval(Maxval), Pixels]). % write bitmap as ppm file write(Bitmap, Filename) -> Ppm = ppm(Bitmap), ok, File> = file:open(Filename, [binary, write]), file:write(File, Ppm), file:close(File). %%%%%%%%%%%% four parts of ppm file %%%%%%%%%%%%%%%%%%%%%% header() -> ["P6">>, ?WHITESPACE]. width_and_height(Width, Height) -> [encode_decimal(Width), ?SPACE, encode_decimal(Height), ?WHITESPACE]. maxval(Maxval) -> [encode_decimal(Maxval), ?WHITESPACE]. ppm_pixels(Bitmap) -> % 24 bit color depth array:to_list(Bitmap#bitmap.pixels). %%%%%%%%%%%% Internals %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% encode_decimal(Number) -> integer_to_list(Number). 

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", ) for j = 0 to dimy-1 do for i = 0 to dimx-1 do color = < remainder(i,256), -- red remainder(j,256), -- green remainder(i*j,256) -- blue >puts(fn,color) end for end for close(fn)

Procedure writing bitmap data storage:

procedure write_ppm(sequence filename, sequence image) integer fn,dimx,dimy dimy = length(image[1]) dimx = length(image) fn = open(filename,"wb") printf(fn, "P6\n%d %d\n255\n", ) for y = 1 to dimy do for x = 1 to dimx do puts(fn, and_bits(image[x][y], ) / ) -- unpack color triple end for end for close(fn) end procedure

FBSL

This code converts a Windows BMP to a PPM. Uses FBSL volatiles for brevity.

24-bpp P.O.T.-size BMP solution:

#ESCAPECHARS ON DIM bmpin = ".\\LenaClr.bmp", ppmout = ".\\Lena.ppm", bmpblob = 54 ' Size of BMP file headers FILEGET(FILEOPEN(bmpin, BINARY), FILELEN(bmpin)): FILECLOSE(FILEOPEN) ' Fill buffer DIM ppmheader AS STRING * 256, breadth, height LET(breadth, height) = 128 ' Image width and height SPRINTF(ppmheader, "P6\n%d %d\n255\n", breadth, height) ' Create PPM file header DIM ppmdata AS STRING * (STRLEN(ppmheader) + FILELEN - bmpblob) DIM head = @ppmdata + STRLEN, tail = @FILEGET + FILELEN - breadth * 3 - 2 ' Start of last scanline ppmdata = ppmheader ' Copy PPM file header WHILE tail >= @FILEGET + bmpblob ' Flip upside down FOR DIM w = 0 TO (breadth - 1) * 3 STEP 3 POKE(head + 0 + w, CHR(PEEK(tail + 2 + w, 1))) ' Swap R POKE(head + 1 + w, CHR(PEEK(tail + 1 + w, 1))) ' Keep G POKE(head + 2 + w, CHR(PEEK(tail + 0 + w, 1))) ' Swap B NEXT INCR(head, breadth * 3): DECR(tail, breadth * 3) ' Next scanline WEND FILEPUT(FILEOPEN(ppmout, BINARY_NEW), ppmdata): FILECLOSE(FILEOPEN) 

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

It loads rgbimage_m module, which is defined here.

program main use rgbimage_m implicit none integer :: nx, ny, i, j, k type(rgbimage) :: im ! init image of height nx, width ny nx = 400 ny = 300 call im%init(nx, ny) ! set some random pixel data do i = 1, nx do j = 1, ny call im%set_pixel(i, j, [(nint(rand()*255), k=1,3)]) end do end do ! output image into file call im%write('fig.ppm') end program 

FreeBASIC

Dim As Integer ancho = 150, alto = 200 Dim As Integer x, y ' width, height Dim As Ubyte kolor Screenres ancho,alto,32 ' Draw circles Screenlock Circle (75, 100), 50, Rgb(255, 0, 0). F Circle (75, 100), 35, Rgb(0, 255, 0). F Circle (75, 100), 20, Rgb(0, 0, 255). F Screenunlock ' Create PPM file header Dim encabezado As String encabezado = "P6" & Chr(10) & Str(ancho) & " " & Str(alto) & Chr(10) & "255" & Chr(10) ' Open PPM file to write Dim As Integer ff = Freefile Open "i:\example.PPM" For Binary As #ff Put #ff, , encabezado ' Write image data to PPM file For y = 0 To alto - 1 For x = 0 To ancho - 1 kolor = Point(x, y) Put #ff, , Chr( kolor And &HFF) ' Red Put #ff, , Chr((kolor Shr 8) And &HFF) ' Green Put #ff, , Chr((kolor Shr 16) And &HFF) ' Blue Next x Next y Close #ff Sleep 

GAP

# Dirty implementation # Only P3 format, an image is a list of 3 matrices (r, g, b) # 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; # 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); 

Go

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

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

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.

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

Haskell

 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) 

J

require 'files' NB. ($x) is height, width, colors per pixel writeppm=:dyad define header=. 'P6',LF,(":1 0x),LF,'255',LF (header,,xa.) 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 pixellist=: >,i.10 myimg=: ((150 + pixellist) ; 255 0 255) setPixels 0 255 0 makeRGB 600 300 myimg writeppm jpath '~temp/myimg.ppm' 540015 

Java

See Basic Bitmap Storage for the BasicBitmapStorage class.

import java.io.BufferedOutputStream; import java.io.File; import java.io.FileOutputStream; import java.io.IOException; import java.nio.charset.StandardCharsets; public class PPMWriter  public void bitmapToPPM(File file, BasicBitmapStorage bitmap) throws IOException  file.delete(); try (var os = new FileOutputStream(file, true); var bw = new BufferedOutputStream(os))  var header = String.format("P6\n%d %d\n255\n", bitmap.getWidth(), bitmap.getHeight()); bw.write(header.getBytes(StandardCharsets.US_ASCII)); for (var y = 0; y  bitmap.getHeight(); y++)  for (var x = 0; x  bitmap.getWidth(); x++)  var pixel = bitmap.getPixel(x, y); bw.write(pixel.getRed()); bw.write(pixel.getGreen()); bw.write(pixel.getBlue()); > > > > > 

Julia

using Images, FileIO h, w = 50, 70 img = zeros(RGBN0f8>, h, w) img[10:40, 5:35] = colorant"skyblue" for i in 26:50, j in (i-25):40 img[i, j] = colorant"sienna1" end save("data/bitmapWrite.ppm", img) save("data/bitmapWrite.png", img) 

Kotlin

For convenience, we repeat the code for the class used in the Bitmap task here.

// Version 1.2.40 import java.awt.Color import java.awt.Graphics import java.awt.image.BufferedImage import java.io.FileOutputStream class BasicBitmapStorage(width: Int, height: Int)  val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR) fun fill(c: Color)  val g = image.graphics g.color = c g.fillRect(0, 0, image.width, image.height) > fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB()) fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y)) > fun main(args: ArrayString>)  // create BasicBitmapStorage object val width = 640 val height = 640 val bbs = BasicBitmapStorage(width, height) for (y in 0 until height)  for (x in 0 until width)  val c = Color(x % 256, y % 256, (x * y) % 256) bbs.setPixel(x, y, c) > > // now write it to a PPM file val fos = FileOutputStream("output.ppm") val buffer = ByteArray(width * 3) // write one line at a time fos.use  val header = "P6\n$width $height\n255\n".toByteArray() with (it)  write(header) for (y in 0 until height)  for (x in 0 until width)  val c = bbs.getPixel(x, y) buffer[x * 3] = c.red.toByte() buffer[x * 3 + 1] = c.green.toByte() buffer[x * 3 + 2] = c.blue.toByte() > write(buffer) > > > > 

LiveCode

LiveCode has built in support for importing and exporting PBM, JPEG, GIF, BMP or PNG graphics formats

export image "test" to file "~/Test.PPM" as paint -- paint format is one of PBM, PGM, or PPM

Lua

Original

-- helper function, simulates PHP's array_fill function local array_fill = function(vbegin, vend, value) local t = <> for i=vbegin, vend do t[i] = value end return t end Bitmap = <> Bitmap.__index = Bitmap function Bitmap.new(width, height) local self = <> setmetatable(self, Bitmap) local white = array_fill(0, width, 255, 255, 255>) self.data = array_fill(0, height, white) self.width = width self.height = height return self end function Bitmap:writeRawPixel(file, c) local dt dt = string.format("%c", c) file:write(dt) end function Bitmap:writeComment(fh, . ) local strings = local str = "" local result for _, s in pairs(strings) do str = str .. tostring(s) end result = string.format("# %s\n", str) fh:write(result) end function Bitmap:writeP6(filename) local fh = io.open(filename, 'w') if not fh then error(string.format("failed to open %q for writing", filename)) else fh:write(string.format("P6 %d %d 255\n", self.width, self.height)) self:writeComment(fh, "automatically generated at ", os.date()) for _, row in pairs(self.data) do for _, pixel in pairs(row) do self:writeRawPixel(fh, pixel[1]) self:writeRawPixel(fh, pixel[2]) self:writeRawPixel(fh, pixel[3]) end end end end function Bitmap:fill(x, y, width, height, color) width = (width == nil) and self.width or width height = (height == nil) and self.height or height width = width + x height = height + y for i=y, height do for j=x, width do self:setPixel(j, i, color) end end end function Bitmap:setPixel(x, y, color) if x >= self.width then --error("x is bigger than self.width!") return false elseif x  0 then --error("x is smaller than 0!") return false elseif y >= self.height then --error("y is bigger than self.height!") return false elseif y  0 then --error("y is smaller than 0!") return false end self.data[y][x] = color return true end function example_colorful_stripes() local w = 260*2 local h = 260*2 local b = Bitmap.new(w, h) --b:fill(2, 2, 18, 18, ) b:setPixel(0, 15, 255,68,0>) for i=1, w do for j=1, h do b:setPixel(i, j,  (i + j * 8) % 256, (j + (255 * i)) % 256, (i * j) % 256 > ); end end return b end example_colorful_stripes():writeP6('p6.ppm') 

Alternate

Uses the alternate Bitmap implementation here, extending it with..

Bitmap.savePPM = function(self, filename) local fp = io.open(filename, "wb") if fp == nil then return false end fp:write(string.format("P6\n%d %d\n%d\n", self.width, self.height, 255)) for y = 1, self.height do for x = 1, self.width do local pix = self.pixels[y][x] fp:write(string.char(pix[1]), string.char(pix[2]), string.char(pix[3])) end end fp:close() return true end 

local bitmap = Bitmap(11,5) bitmap:clear(255,255,255>) for y = 1, 5 do for x = 1, 11 do if x==1 or x==5 or x==7 or (y>1 and (x==9 or x==11)) or (y==5 and x~=4 and x~=8 and x~=10) or (x==10 and (y==1 or y==3)) then bitmap:set(x-1, y-1, 0,0,0>) -- creates "LUA" with 3x5 font end end end bitmap:savePPM("lua3x5.ppm") 

M2000 Interpreter

Added ToFile in group which return the function Bitmap. In this example we export using ToFile and get bytes (unsigned values) from buffer, and we export from outside, using getpixel and convert the RGB value to bytes (color returned as a negative number, so we have to invert before further process it)

P3 type

Module Checkit < Function Bitmap (x as long, y as long) < if xm=len(rgb)*x mod 4 if m>0 then m=4-m ' add some bytes to raster line m+=len(rgb) *x Structure rasterline < < pad as byte*m >\\ union pad+hline hline as rgb*x > Structure Raster < magic as integer*4 w as integer*4 h as integer*4 lines as rasterline*y >Buffer Clear Image1 as Raster \\ 24 chars as header to be used from bitmap render build in functions Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) \\ fill white (all 255) \\ Str$(string) convert to ascii, so we get all characters from words width to byte width Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) Buffer Clear Pad as Byte*4 SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->< where=alines+3*x+blines*y if c>0 then c=color(c) c-! Return Pad, 0:=c as long Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte > GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) -> < where=alines+3*x+blines*y =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) >StrDib$=Lambda$ Image1, Raster -> < =Eval$(Image1, 0, Len(Raster)) >CopyImage=Lambda Image1 (image$) -> < if left$(image$,12)=Eval$(Image1, 0, 24 ) Then < Return Image1, 0:=Image$ >Else Error "Can't Copy Image" > Export2File=Lambda Image1, x, y (f) -> < \\ use this between open and close Print #f, "P3" Print #f,"# Created using M2000 Interpreter" Print #f, x;" ";y Print #f, 255 x2=x-1 where=24 For y1= 0 to y-1 < a$="" For x1=0 to x2 < Print #f, a$;Eval(Image1, where +2 as byte);" "; Print #f, Eval(Image1, where+1 as byte);" "; Print #f, Eval(Image1, where as byte); where+=3 a$=" " >Print #f m=where mod 4 if m<>0 then where+=4-m > > Group Bitmap < SetPixel=SetPixel GetPixel=GetPixel Image$=StrDib$ Copy=CopyImage ToFile=Export2File >=Bitmap > A=Bitmap(10, 10) Call A.SetPixel(5,5, color(128,0,255)) Open "A2.PPM" for Output as #F Call A.ToFile(F) Close #f ' is the same as this one Try < Open "A.PPM" for Output as #F Print #f, "P3" Print #f,"# Created using M2000 Interpreter" Print #f, 10;" ";10 Print #f, 255 For y=10-1 to 0 < a$="" For x=0 to 10-1 < rgb=-A.GetPixel(x, y) Print #f, a$;Binary.And(rgb, 0xFF); " "; Print #f, Binary.And(Binary.Shift(rgb, -8), 0xFF); " "; Print #f, Binary.Shift(rgb, -16); a$=" " >Print #f > Close #f > > Checkit

P3 # Created using M2000 Interpreter 10 10 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 128 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255

P6 type

Module PPMbinaryP6 < If Versionelse.if Match("N") Then < E$="Not a ppm file" Read f as long buffer whitespace as byte if not Eof(f) then < get #f, whitespace : iF eof(f) then Error E$ P6$=eval$(whitespace) get #f, whitespace : iF eof(f) then Error E$ P6$+=eval$(whitespace) def boolean getW=true, getH=true, getV=true def long v \\ str$("P6") has 2 bytes. "P6" has 4 bytes If p6$=str$("P6") Then < do < get #f, whitespace if Eval$(whitespace)=str$("#") then < do < iF eof(f) then Error E$ get #f, whitespace >until eval(whitespace)=10 > else < select case eval(whitespace) case 32, 9, 13, 10 < if getW and x<>0 then < getW=false >else.if getH and y<>0 then < getH=false >else.if getV and v<>0 then < getV=false >> case 48 to 57 < if getW then < x*=10 x+=eval(whitespace, 0)-48 >else.if getH then < y*=10 y+=eval(whitespace, 0)-48 >else.if getV then < v*=10 v+=eval(whitespace, 0)-48 >> End Select > iF eof(f) then Error E$ > until getV=false > else Error "Not a P6 ppm" > > else Error "No proper arguments" if x m=len(rgb)*x mod 4 if m>0 then m=4-m ' add some bytes to raster line m+=len(rgb) *x Structure rasterline < < pad as byte*m >\\ union pad+hline hline as rgb*x > \\ we use union linesB and lines \\ so we can address linesb as bytes Structure Raster < magic as integer*4 w as integer*4 h as integer*4 < linesB as byte*len(rasterline)*y >lines as rasterline*y > Buffer Clear Image1 as Raster \\ 24 chars as header to be used from bitmap render build in functions Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2) \\ fill white (all 255) \\ Str$(string) convert to ascii, so we get all characters from words width to byte width if not valid(f) then Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y)) Buffer Clear Pad as Byte*4 SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->< where=alines+3*x+blines*y if c>0 then c=color(c) c-! Return Pad, 0:=c as long Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte > GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) -> < where=alines+3*x+blines*y =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte)) >StrDib$=Lambda$ Image1, Raster -> < =Eval$(Image1, 0, Len(Raster)) >CopyImage=Lambda Image1 (image$) -> < if left$(image$,12)=Eval$(Image1, 0, 24 ) Then < Return Image1, 0:=Image$ >Else Error "Can't Copy Image" > Export2File=Lambda Image1, x, y (f) -> < \\ use this between open and close Print #f, "P6";chr$(10); Print #f,"# Created using M2000 Interpreter";chr$(10); Print #f, x;" ";y;" 255";chr$(10); x2=x-1 where=0 Buffer pad as byte*3 For y1= 0 to y-1 < For x1=0 to x2 < \\ use linesB which is array of bytes Return pad, 0:=eval$(image1, 0!linesB!where, 3) Push Eval(pad, 2) Return pad, 2:=Eval(pad, 0), 0:=Number Put #f, pad where+=3 >m=where mod 4 if m<>0 then where+=4-m > > if valid(F) then < x0=x-1 where=0 Buffer Pad1 as byte*3 For y1=y-1 to 0 < For x1=0 to x0 < Get #f, Pad1 ' Read binary \\ reverse rgb Push Eval(pad1, 2) Return pad1, 2:=Eval(pad1, 0), 0:=Number Return Image1, 0!linesB!where:=Eval$(Pad1) where+=3 >m=where mod 4 if m<>0 then where+=4-m > > Group Bitmap < SetPixel=SetPixel GetPixel=GetPixel Image$=StrDib$ Copy=CopyImage ToFile=Export2File >=Bitmap > A=Bitmap(10, 10) Call A.SetPixel(5,5, color(128,0,255)) Open "A.PPM" for Output as #F Call A.ToFile(F) Close #f Print "Saved" Open "A.PPM" for Input as #F C=Bitmap(f) Copy 400*twipsx,200*twipsy use C.Image$() Close #f > Checkit End 1000 Error "Need Version 9.4, Revision 19 or higher" > PPMbinaryP6

Mathematica / Wolfram Language

Export["file.ppm",image,"PPM"] 

MATLAB / Octave

R=[255,0,0;255,255,0]; G=[0,255,0;255,255,0]; B=[0,0,255;0,0,0]; r = R'; r(:); g = R'; g(:); b = R'; b(:); fid=fopen('p6.ppm','w'); fprintf(fid,'P6\n%i %i\n255\n',size(R)); fwrite(fid,[r,g,b]','uint8'); fclose(fid); 

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

Nim

import bitmap import streams #--------------------------------------------------------------------------------------------------- proc writePPM*(img: Image, stream: Stream) = ## Write an image to a PPM stream. stream.writeLine("P6 ", $img.w, " ", $img.h, " 255") for x, y in img.indices: stream.write(chr(img[x, y].r)) stream.write(chr(img[x, y].g)) stream.write(chr(img[x, y].b)) #--------------------------------------------------------------------------------------------------- proc writePPM*(img: Image; filename: string) = ## Write an image in a PPM file. var file = openFileStream(filename, fmWrite) img.writePPM(file) file.close() #——————————————————————————————————————————————————————————————————————————————————————————————————— when isMainModule: var image = newImage(100, 50) image.fill(color(255, 0, 0)) for row in 10..20: for col in 0..image.w: image[col, row] = color(0, 255, 0) for row in 30..40: for col in 0..image.w: image[col, row] = color(0, 0, 255) image.writePPM("output.ppm") 

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

Oz

As a function in the module BitmapIO.oz :

functor import Bitmap Open export %% Read Write define %% Omitted: Read proc F = proc  end fun [C div 0x100 C mod 0x100] end proc >)> end MaxCol = MaxVal#Writer = if MaxCol = < 0xff then 0xff#WriteColor8 else 0xffff#WriteColor16 end Header = "P6\n"#W#" "#H#" "#MaxVal#"\n" in try  finally end end end

Perl

use Imager; $image = Imager->new(xsize => 200, ysize => 200); $image->box(filled => 1, color => red); $image->box(filled => 1, color => black, xmin => 50, ymin => 50, xmax => 150, ymax => 150); $image->write(file => 'bitmap.ppm') or die $image->errstr; 

Phix

Copy of Euphoria. The results may be verified with demo\rosetta\viewppm.exw

-- demo\rosetta\Bitmap_write_ppm.exw constant dimx = 512, dimy = 512 constant fn = open("first.ppm","wb") -- b - binary mode sequence color printf(fn, "P6\n%d %d\n255\n", dimx,dimy>) for y=0 to dimy-1 do for x=0 to dimx-1 do color = remainder(x,256), -- red remainder(y,256), -- green remainder(x*y,256)> -- blue puts(fn,color) end for end for close(fn) 

The following more general purpose routine is used in several other examples (via include ppm.e):

global procedure write_ppm(string filename, sequence image) integer fn = open(filename,"wb"), dimx = length(image), dimy = length(image[1]) printf(fn, "P6\n%d %d\n255\n", dimx,dimy>) for y=1 to dimy do for x=1 to dimx do integer pixel = image[x][y] -- red,green,blue sequence r_g_b = sq_and_bits(pixel,FF0000,#FF00,#FF>) r_g_b = sq_floor_div(r_g_b,010000,#0100,#01>) puts(fn,r_g_b) end for end for close(fn) end procedure 

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'); 

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

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;

Prolog

This is an extremely straight forward way to write in Prolog, more complicated methods might use DCGs:

:- module(bitmapIO, [ write_ppm_p6/2]). :- use_module(library(lists)). %write_ppm_p6(File,Bitmap) write_ppm_p6(Filename,[[X,Y],Pixels]):- open(Filename,write,Output,[encoding(octet)]), %write p6 header writeln(Output, 'P6'), atomic_list_concat([X, Y], ' ', Dimensions), writeln(Output, Dimensions), writeln(Output, '255'), %write bytes maplist(maplist(maplist(put_byte(Output))),Pixels), close(Output). 

:- use_module(bitmap). :- use_module(bitmapIO). write :- new_bitmap(AllBlack,[50,50],[0,0,0]), set_pixel0(AlmostAllBlack,AllBlack,[25,25],[255,255,255]), write_ppm_p6('AlmostAllBlack.ppm',AlmostAllBlack). 

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 

Python

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

R

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

Racket

;P3 (define (bitmap->ppm bitmap output-port) (define height (send bitmap get-height)) (define width (send bitmap get-width)) (define buffer (make-bytes (* width height 4))) ;buffer for storing argb data (send bitmap get-argb-pixels 0 0 width height buffer) ;copy pixels (parameterize ([current-output-port output-port]) (printf "P3\n~a ~a\n255" width height) ;header (for ([i (* width height)]) (define pixel-position (* 4 i)) (when (= (modulo i width) 0) (printf "\n")) ;end of row (printf "~s ~s ~s " (bytes-ref buffer (+ pixel-position 1)) ;r (bytes-ref buffer (+ pixel-position 2)) ;g (bytes-ref buffer (+ pixel-position 3)))))) ;b (call-with-output-file "image.ppm" #:exists 'replace #:mode 'text (lambda (out) (bitmap->ppm bm out))) ; P6 (define (bitmap->ppm bitmap output-port) (define height (send bitmap get-height)) (define width (send bitmap get-width)) (define buffer (make-bytes (* width height 4))) ;buffer for storing argb data (send bitmap get-argb-pixels 0 0 width height buffer) ;copy pixels (parameterize ([current-output-port output-port]) (printf "P6\n~a ~a\n255\n" width height) ;header (for ([i (* width height)]) (define pixel-position (* 4 i)) (write-byte (bytes-ref buffer (+ pixel-position 1))) ; r (write-byte (bytes-ref buffer (+ pixel-position 2))) ; g (write-byte (bytes-ref buffer (+ pixel-position 3)))))) ;b (call-with-output-file "image.ppm" #:exists 'replace #:mode 'binary (lambda (out) (bitmap->ppm bm out))) ;or any other output port 

Raku

(formerly Perl 6)

class Pixel < has uint8 ($.R, $.G, $.B) > class Bitmap has UInt ($.width, $.height); has Pixel @!data; method fill(Pixel $p) @!data = $p.clone xx ($!width*$!height) > method pixel( $i where ^$!width, $j where ^$!height --> Pixel ) is rw < @!data[$i*$!height + $j] > method data < @!data > > role PPM method P6 returns Blob "P6\n \n255\n".encode('ascii') ~ Blob.new: flat map < .R, .G, .B >, self.data > > my Bitmap $b = Bitmap.new(width => 125, height => 125) but PPM; for flat ^$b.height X ^$b.width -> $i, $j $b.pixel($i, $j) = Pixel.new: :R($i*2), :G($j*2), :B(255-$i*2); > $*OUT.write: $b.P6;

Converted to a png. (ppm files not locally supported)

REXX

/*REXX program writes a PPM formatted image file, also known as a P6 (binary) file. */ green = 00ff00 /*define a pixel with the color green. */ parse arg oFN width height color . /*obtain optional arguments from the CL*/ if oFN=='' | oFN=="," then oFN='IMAGE' /*Not specified? Then use the default.*/ if width=='' | width=="," then width= 20 /* " " " " " " */ if height=='' | height=="," then height= 20 /* " " " " " " */ if color=='' | color=="," then color= green /* " " " " " " */ oFID= oFN'.PPM' /*define oFID by adding an extension.*/ @. = x2c(color) /*set all pixels of image a hex color. */ $ = '9'x /*define the separator (in the header).*/ # = 255 /* " " max value for all colors. */ call charout oFID, , 1 /*set the position of the file's output*/ call charout oFID,'P6'width || $ || height || $ || # || $ /*write file header info. */ _= do j =1 for width do k=1 for height; _= _ || @.j.k /*write the PPM file, 1 pixel at a time*/ end /*k*/ /* ↑ a pixel contains three bytes, */ end /*j*/ /* └────which defines the pixel's color*/ call charout oFID, _ /*write the image's raster to the file.*/ call charout oFID /*close the output file just to be safe*/ /*stick a fork in it, we're all done. */ 

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 @height.times do |y| @width.times do |x| f.print @data[x][y].values.pack('C3') end end end end alias_method :write, :save end