Data update

Task/Bitmap-Write-a-PPM-file/Ada/bitmap-write-a-ppm-file.adb

@@ -0,0 +1,29 @@
+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;

Task/Bitmap-Write-a-PPM-file/Common-Lisp/bitmap-write-a-ppm-file.lisp

@@ -1,28 +1,28 @@
 (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)
+           :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)))
+      (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 |#
+    :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)))))))
+    :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)

Task/Bitmap-Write-a-PPM-file/Crystal/bitmap-write-a-ppm-file-1.cr

@@ -0,0 +1,13 @@
+require "./pixmap"
+
+class Pixmap
+  def write_ppm (io)
+    io.print "P6\n# Visit Rosetta code!\n#{width} #{height}\n255\n"
+    @data.each do |c|
+      io.write_byte c.r
+      io.write_byte c.g
+      io.write_byte c.b
+    end
+  end
+  register_writer ".ppm", write_ppm
+end

Task/Bitmap-Write-a-PPM-file/Crystal/bitmap-write-a-ppm-file-2.cr

@@ -0,0 +1,14 @@
+require "./write_ppm"
+
+img = Pixmap.new 3, 2, Color::WHITE
+
+[[0xFF0000, 0x00FF00, 0x0000FF],
+ [0xFFFF00, 0x00FFFF, 0xFF00FF]].each_with_index do |row, y|
+  row.each_with_index do |color, x|
+    img[x, y] = Color.new color
+  end
+end
+
+img.write "mini.ppm"
+
+File.read("mini.ppm").unsafe_byte_slice(0).hexdump(STDOUT)

Task/Bitmap-Write-a-PPM-file/Euphoria/bitmap-write-a-ppm-file-1.eu

@@ -0,0 +1,15 @@
+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,256), -- red
+            remainder(j,256), -- green
+            remainder(i*j,256) -- blue
+        }
+        puts(fn,color)
+    end for
+end for
+close(fn)

Task/Bitmap-Write-a-PPM-file/Euphoria/bitmap-write-a-ppm-file-2.eu

@@ -0,0 +1,14 @@
+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", {dimx,dimy})
+    for y = 1 to dimy do
+        for x = 1 to dimx do
+            puts(fn, and_bits(image[x][y], {#FF0000,#FF00,#FF}) /
+                                           {#010000,#0100,#01}) -- unpack color triple
+        end for
+    end for
+    close(fn)
+end procedure

Task/Bitmap-Write-a-PPM-file/FBSL/bitmap-write-a-ppm-file.fbsl

@@ -12,12 +12,12 @@ DIM head = @ppmdata + STRLEN, tail = @FILEGET + FILELEN - breadth * 3 - 2 ' Star
 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
+   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)

Task/Bitmap-Write-a-PPM-file/Oz/bitmap-write-a-ppm-file.oz

@@ -12,28 +12,28 @@ define
       F = {New Open.file init(name:Filename flags:[write create truncate binary])}
 
       proc {WriteColor8 color(R G B)}
-	 {F write(vs:[R G B])}
+    {F write(vs:[R G B])}
       end
 
       fun {ToBytes C}
-	 [C div 0x100  C mod 0x100]
+    [C div 0x100  C mod 0x100]
       end
 
       proc {WriteColor16 color(R G B)}
-	 {F write(vs:{Flatten {Map [R G B] ToBytes}})}
+    {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
+            else 0xffff#WriteColor16
+            end
       Header = "P6\n"#W#" "#H#" "#MaxVal#"\n"
    in
       try
-	 {F write(vs:Header)}
-	 {Bitmap.forAllPixels B Writer}
+    {F write(vs:Header)}
+    {Bitmap.forAllPixels B Writer}
       finally
-	 {F close}
+    {F close}
       end
    end
 end

Task/Bitmap-Write-a-PPM-file/Prolog/bitmap-write-a-ppm-file-1.pro

@@ -1,16 +1,16 @@
 :- module(bitmapIO, [
-	write_ppm_p6/2]).
+   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).
+   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).

Task/Bitmap-Write-a-PPM-file/Prolog/bitmap-write-a-ppm-file-2.pro

@@ -2,6 +2,6 @@
 :- 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).
+   new_bitmap(AllBlack,[50,50],[0,0,0]),
+   set_pixel0(AlmostAllBlack,AllBlack,[25,25],[255,255,255]),
+   write_ppm_p6('AlmostAllBlack.ppm',AlmostAllBlack).

Task/Bitmap-Write-a-PPM-file/Raku/bitmap-write-a-ppm-file.raku

@@ -7,9 +7,9 @@ class Bitmap {
         @!data = $p.clone xx ($!width*$!height)
     }
     method pixel(
-	  $i where ^$!width,
-	  $j where ^$!height
-	  --> Pixel
+     $i where ^$!width,
+     $j where ^$!height
+     --> Pixel
       ) is rw { @!data[$i*$!height + $j] }
 
     method data { @!data }
@@ -17,8 +17,8 @@ class Bitmap {
 
 role PPM {
     method P6 returns Blob {
-	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
-	~ Blob.new: flat map { .R, .G, .B }, self.data
+   "P6\n{self.width} {self.height}\n255\n".encode('ascii')
+   ~ Blob.new: flat map { .R, .G, .B }, self.data
     }
 }
 

Task/Bitmap-Write-a-PPM-file/Rebol/bitmap-write-a-ppm-file.rebol

@@ -0,0 +1,57 @@
+Rebol [
+   title: "Rosetta code: Bitmap/Write a PPM file"
+   file:  %Bitmap-Write_a_PPM_file.r3
+   url:   https://rosettacode.org/wiki/Bitmap/Write_a_PPM_file
+]
+
+to-ppm: function [
+    "Converts an image to a PPM (Portable Pixmap) format string"
+    ;; This function is using padding in the output.
+    ;; In the real life usage it could be removed.
+    img [image!]
+][
+    ;; Extract image dimensions as integers
+    wide: to integer! img/size/x
+    high: to integer! img/size/y
+
+    ;; Build the PPM header:
+    ;;   P3 = plain RGB text format
+    ;;   wide/high = pixel dimensions
+    ;;   255 = max color value (8-bit per channel)
+    out: rejoin ["P3^/" wide SP high "^/255^/"]
+
+    ;; Iterate over every pixel in the image
+    n: 0  ;; Pixel counter, used to detect end of each row
+    foreach clr img [
+        ++ n
+        ;; Append R, G, B channel values, right-aligned in fixed-width columns
+        ;; pad ... -5/-4 = right-align in field of 5 or 4 characters
+        append out ajoin [
+            pad clr/1 -5 ;R
+            pad clr/2 -4 ;G
+            pad clr/3 -4 ;B
+            ;; After the last pixel in each row, insert a newline
+            if zero? n % wide [ newline ]
+        ]
+    ]
+    out
+]
+
+; --- Demo ---
+; Create a 2x2 image and set pixels 1 (top-left) and 4 (bottom-right) to black
+img: make image! 2x2
+img/1: img/4: black
+print to-ppm img
+
+;; It is also possible to register a PPM codec
+register-codec [
+    name:  'ppm
+    type:  'image
+    title: "Portable Pixmap (PPM) File Format"
+    suffixes: [%.ppm]
+    encode: :to-ppm
+]
+;; Then use it as:
+ppm-data: encode 'ppm img
+;; or
+save %image.ppm img

Task/Bitmap-Write-a-PPM-file/Stata/bitmap-write-a-ppm-file.stata

@@ -1,16 +1,16 @@
 mata
 void writeppm(name, r, g, b) {
-	n = rows(r)
-	p = cols(r)
-	f = fopen(name, "w")
-	fput(f, "P3")
-	fput(f, strofreal(p) + " " + strofreal(n) + " 255")
-	for (i = 1; i <= n; i++) {
-		for (j = 1; j <= p; j++) {
-			fput(f, strofreal(r[i,j]) + " " + strofreal(g[i,j]) + " " + strofreal(b[i,j]))
-		}
-	}
-	fclose(f)
+   n = rows(r)
+   p = cols(r)
+   f = fopen(name, "w")
+   fput(f, "P3")
+   fput(f, strofreal(p) + " " + strofreal(n) + " 255")
+   for (i = 1; i <= n; i++) {
+      for (j = 1; j <= p; j++) {
+         fput(f, strofreal(r[i,j]) + " " + strofreal(g[i,j]) + " " + strofreal(b[i,j]))
+      }
+   }
+   fclose(f)
 }
 
 r = J(1, 6, (0::5) * 51)

Task/Bitmap-Write-a-PPM-file/Yabasic/bitmap-write-a-ppm-file.basic

@@ -18,12 +18,12 @@ fn = open("exmaple.PPM", "wb")
 print #fn header$
 
 for x = 0 to hei - 1
-	for y = 0 to wid - 1
-		c$ = right$(getbit$(y, x, y, x), 6)
-		poke #fn, dec(left$(c$, 2))
-		poke #fn, dec(right$(c$, 2))
-		poke #fn, dec(mid$(c$, 3, 2))
-	next y
+   for y = 0 to wid - 1
+      c$ = right$(getbit$(y, x, y, x), 6)
+      poke #fn, dec(left$(c$, 2))
+      poke #fn, dec(right$(c$, 2))
+      poke #fn, dec(mid$(c$, 3, 2))
+   next y
 next x
 
 poke #fn, asc("\n")