B

Task/Bitmap-Read-a-PPM-file/0DESCRIPTION

@@ -0,0 +1,4 @@
+Using the data storage type defined [[Basic_bitmap_storage|on this page]] for raster images, read an image from a PPM file (binary P6 prefered).
+(Read [[wp:Netpbm_format|the definition of PPM file]] on Wikipedia.)
+
+'''Task''': Use [[write ppm file]] solution and [[grayscale image]] solution with this one in order to convert a color image to grayscale one.

Task/Bitmap-Read-a-PPM-file/1META.yaml

@@ -0,0 +1,4 @@
+---
+category:
+- Input Output
+note: Raster graphics operations

Task/Bitmap-Read-a-PPM-file/Ada/bitmap-read-a-ppm-file-1.ada

@@ -0,0 +1,70 @@
+with Ada.Characters.Latin_1;  use Ada.Characters.Latin_1;
+with Ada.Integer_Text_IO;     use Ada.Integer_Text_IO;
+with Ada.Streams.Stream_IO;   use Ada.Streams.Stream_IO;
+
+function Get_PPM (File : File_Type) return Image is
+   use Ada.Characters.Latin_1;
+   use Ada.Integer_Text_IO;
+
+   function Get_Line return String is -- Skips comments
+      Byte   : Character;
+      Buffer : String (1..80);
+   begin
+      loop
+         for I in Buffer'Range loop
+            Character'Read (Stream (File), Byte);
+            if Byte = LF then
+               exit when Buffer (1) = '#';
+               return Buffer (1..I - 1);
+            end if;
+            Buffer (I) := Byte;
+         end loop;
+         if Buffer (1) /= '#' then
+            raise Data_Error;
+         end if;
+      end loop;
+   end Get_Line;
+
+   Height : Integer;
+   Width  : Integer;
+begin
+   if Get_Line /= "P6" then
+      raise Data_Error;
+   end if;
+   declare
+      Line  : String  := Get_Line;
+      Start : Integer := Line'First;
+      Last  : Positive;
+   begin
+      Get (Line, Width, Last);                     Start := Start + Last;
+      Get (Line (Start..Line'Last), Height, Last); Start := Start + Last;
+      if Start <= Line'Last then
+         raise Data_Error;
+      end if;
+      if Width < 1 or else Height < 1 then
+         raise Data_Error;
+      end if;
+   end;
+   if Get_Line /= "255" then
+      raise Data_Error;
+   end if;
+   declare
+      Result : Image (1..Height, 1..Width);
+      Buffer : String (1..Width * 3);
+      Index  : Positive;
+   begin
+      for I in Result'Range (1) loop
+         String'Read (Stream (File), Buffer);
+         Index := Buffer'First;
+         for J in Result'Range (2) loop
+            Result (I, J) :=
+               (  R => Luminance (Character'Pos (Buffer (Index))),
+                  G => Luminance (Character'Pos (Buffer (Index + 1))),
+                  B => Luminance (Character'Pos (Buffer (Index + 2)))
+               );
+            Index := Index + 3;
+         end loop;
+      end loop;
+      return Result;
+   end;
+end Get_PPM;

Task/Bitmap-Read-a-PPM-file/Ada/bitmap-read-a-ppm-file-2.ada

@@ -0,0 +1,9 @@
+declare
+   F1, F2 : File_Type;
+begin
+   Open (F1, In_File, "city.ppm");
+   Create (F2, Out_File, "city_grayscale.ppm");
+   Put_PPM (F2, Color (Grayscale (Get_PPM (F1))));
+   Close (F1);
+   Close (F2);
+end;

Task/Bitmap-Read-a-PPM-file/AutoHotkey/bitmap-read-a-ppm-file.ahk

@@ -0,0 +1,57 @@
+img := ppm_read("lena50.ppm") ;
+x := img[4,4] ; get pixel(4,4)
+y := img[24,24] ; get pixel(24,24)
+msgbox % x.rgb() " " y.rgb()
+img.write("lena50copy.ppm")
+return
+
+ppm_read(filename, ppmo=0) ; only ppm6 files supported
+{
+if !ppmo  ; if image not already in memory, read from filename
+  fileread, ppmo, % filename
+
+  index := 1
+  pos := 1
+
+  loop, parse, ppmo, `n, `r
+  {
+    if (substr(A_LoopField, 1, 1) == "#")
+      continue
+loop,
+{
+ if !pos := regexmatch(ppmo, "\d+", pixel, pos)
+break
+    bitmap%A_Index% := pixel
+    if (index == 4)
+      Break
+    pos := regexmatch(ppmo, "\s", x, pos)
+    index ++
+}
+  }
+
+  type := bitmap1
+  width := bitmap2
+  height := bitmap3
+  maxcolor := bitmap4
+  bitmap := Bitmap(width, height, color(0,0,0))
+  index := 1
+  i := 1
+  j := 1
+ bits := pos
+loop % width * height
+  {
+      bitmap[i, j, "r"]  := numget(ppmo, 3 * A_Index + bits, "uchar")
+      bitmap[i, j, "g"]  := numget(ppmo, 3 * A_Index + bits + 1, "uchar")
+      bitmap[i, j, "b"]  := numget(ppmo, 3 * A_Index + bits + 2, "uchar")
+
+      if (j == width)
+{
+	j := 1
+	i += 1
+}
+      else
+	j++
+}
+ return bitmap
+  }
+#include bitmap_storage.ahk ; from http://rosettacode.org/wiki/Basic_bitmap_storage/AutoHotkey

Task/Bitmap-Read-a-PPM-file/BBC-BASIC/bitmap-read-a-ppm-file.bbc

@@ -0,0 +1,30 @@
+      f% = OPENIN("c:\lena.ppm")
+      IF f%=0 ERROR 100, "Failed to open input file"
+
+      IF GET$#f% <> "P6" ERROR 101, "File is not in P6 format"
+      REPEAT
+        in$ = GET$#f%
+      UNTIL LEFT$(in$,1) <> "#"
+      size$ = in$
+      max$ = GET$#f%
+
+      Width% = VAL(size$)
+      space% = INSTR(size$, " ")
+      Height% = VALMID$(size$, space%)
+
+      VDU 23,22,Width%;Height%;8,16,16,128
+
+      FOR y% = Height%-1 TO 0 STEP -1
+        FOR x% = 0 TO Width%-1
+          r% = BGET#f% : g% = BGET#f% : b% = BGET#f%
+          l% = INT(0.3*r% + 0.59*g% + 0.11*b% + 0.5)
+          PROCsetpixel(x%,y%,l%,l%,l%)
+        NEXT
+      NEXT y%
+      END
+
+      DEF PROCsetpixel(x%,y%,r%,g%,b%)
+      COLOUR 1,r%,g%,b%
+      GCOL 1
+      LINE x%*2,y%*2,x%*2,y%*2
+      ENDPROC

Task/Bitmap-Read-a-PPM-file/C/bitmap-read-a-ppm-file-1.c

@@ -0,0 +1 @@
+image get_ppm(FILE *pf);

Task/Bitmap-Read-a-PPM-file/C/bitmap-read-a-ppm-file-2.c

@@ -0,0 +1,38 @@
+#include "imglib.h"
+
+#define PPMREADBUFLEN 256
+image get_ppm(FILE *pf)
+{
+        char buf[PPMREADBUFLEN], *t;
+        image img;
+        unsigned int w, h, d;
+        int r;
+
+        if (pf == NULL) return NULL;
+        t = fgets(buf, PPMREADBUFLEN, pf);
+        /* the code fails if the white space following "P6" is not '\n' */
+        if ( (t == NULL) || ( strncmp(buf, "P6\n", 3) != 0 ) ) return NULL;
+        do
+        { /* Px formats can have # comments after first line */
+           t = fgets(buf, PPMREADBUFLEN, pf);
+           if ( t == NULL ) return NULL;
+        } while ( strncmp(buf, "#", 1) == 0 );
+        r = sscanf(buf, "%u %u", &w, &h);
+        if ( r < 2 ) return NULL;
+
+        r = fscanf(pf, "%u", &d);
+        if ( (r < 1) || ( d != 255 ) ) return NULL;
+        fseek(pf, 1, SEEK_CUR); /* skip one byte, should be whitespace */
+
+        img = alloc_img(w, h);
+        if ( img != NULL )
+        {
+            size_t rd = fread(img->buf, sizeof(pixel), w*h, pf);
+            if ( rd < w*h )
+            {
+               free_img(img);
+               return NULL;
+            }
+            return img;
+        }
+}

Task/Bitmap-Read-a-PPM-file/C/bitmap-read-a-ppm-file-3.c

@@ -0,0 +1,16 @@
+#include <stdio.h>
+#include "imglib.h"
+
+int main()
+{
+   image source;
+   grayimage idest;
+
+   source = get_ppm(stdin);
+   idest = tograyscale(source);
+   free_img(source);
+   source = tocolor(idest);
+   output_ppm(stdout, source);
+   free_img(source); free_img((image)idest);
+   return 0;
+}

Task/Bitmap-Read-a-PPM-file/Forth/bitmap-read-a-ppm-file.fth

@@ -0,0 +1,38 @@
+: read-ppm { fid -- bmp }
+  pad dup 80 fid read-line throw 0= abort" Partial line"
+  s" P6" compare abort" Only P6 supported."
+  pad dup 80 fid read-line throw 0= abort" Partial line"
+  0. 2swap >number
+  1 /string		\ skip space
+  0. 2swap >number
+  2drop drop nip    ( w h )
+  bitmap { bmp }
+  pad dup 80 fid read-line throw 0= abort" Partial line"
+  s" 255" compare abort" Only 8-bits per color channel supported"
+  0 pad !
+  bmp bdim
+  0 do
+    dup 0 do
+      pad 3 fid read-file throw
+      3 - abort" Not enough pixel data in file"
+      pad @ i j bmp b!
+    loop
+  loop drop
+  bmp ;
+
+\ testing round-trip
+4 3 bitmap value test
+red test bfill
+green 1 2 test b!
+
+s" red.ppm" w/o create-file throw
+test over write-ppm
+close-file throw
+
+s" red.ppm" r/o open-file throw
+dup read-ppm value test2
+close-file throw
+
+: bsize ( bmp -- len ) bdim * pixels bdata ;
+
+test dup bsize  test2 dup bsize  compare .    \ 0 if identical

Task/Bitmap-Read-a-PPM-file/Fortran/bitmap-read-a-ppm-file.f

@@ -0,0 +1,42 @@
+subroutine read_ppm(u, img)
+  integer, intent(in) :: u
+  type(rgbimage), intent(out) :: img
+  integer :: i, j, ncol, cc
+  character(2) :: sign
+  character :: ccode
+
+  img%width = 0
+  img%height = 0
+  nullify(img%red)
+  nullify(img%green)
+  nullify(img%blue)
+
+  read(u, '(A2)') sign
+  read(u, *) img%width, img%height
+  read(u, *) ncol
+
+  write(0,*) sign
+  write(0,*) img%width, img%height
+  write(0,*) ncol
+
+  if ( ncol /= 255 ) return
+
+  call alloc_img(img, img%width, img%height)
+
+  if ( valid_image(img) ) then
+     do j=1, img%height
+        do i=1, img%width
+           read(u, '(A1)', advance='no', iostat=status) ccode
+           cc = iachar(ccode)
+           img%red(i,j) = cc
+           read(u, '(A1)', advance='no', iostat=status) ccode
+           cc = iachar(ccode)
+           img%green(i,j) = cc
+           read(u, '(A1)', advance='no', iostat=status) ccode
+           cc = iachar(ccode)
+           img%blue(i,j) = cc
+        end do
+     end do
+  end if
+
+end subroutine read_ppm

Task/Bitmap-Read-a-PPM-file/Go/bitmap-read-a-ppm-file-1.go

@@ -0,0 +1,68 @@
+package raster
+
+import (
+    "errors"
+    "io"
+    "io/ioutil"
+    "os"
+    "regexp"
+    "strconv"
+)
+
+// ReadFrom constructs a Bitmap object from an io.Reader.
+func ReadPpmFrom(r io.Reader) (b *Bitmap, err error) {
+    var all []byte
+    all, err = ioutil.ReadAll(r)
+    if err != nil {
+        return
+    }
+    bss := rxHeader.FindSubmatch(all)
+    if bss == nil {
+        return nil, errors.New("unrecognized ppm header")
+    }
+    x, _ := strconv.Atoi(string(bss[3]))
+    y, _ := strconv.Atoi(string(bss[6]))
+    maxval, _ := strconv.Atoi(string(bss[9]))
+    if maxval > 255 {
+        return nil, errors.New("16 bit ppm not supported")
+    }
+    allCmts := append(append(append(bss[1], bss[4]...), bss[7]...), bss[10]...)
+    b = NewBitmap(x, y)
+    b.Comments = rxComment.FindAllString(string(allCmts), -1)
+    b3 := all[len(bss[0]):]
+    var n1 int
+    for i := range b.px {
+        b.px[i].R = byte(int(b3[n1]) * 255 / maxval)
+        b.px[i].G = byte(int(b3[n1+1]) * 255 / maxval)
+        b.px[i].B = byte(int(b3[n1+2]) * 255 / maxval)
+        n1 += 3
+    }
+    return
+}
+
+const (
+    // single whitespace character
+    ws = "[ \n\r\t\v\f]"
+    // isolated comment
+    cmt = "#[^\n\r]*"
+    // comment sub expression
+    cmts = "(" + ws + "*" + cmt + "[\n\r])"
+    // number with leading comments
+    num = "(" + cmts + "+" + ws + "*|" + ws + "+)([0-9]+)"
+)
+
+var rxHeader = regexp.MustCompile("^P6" + num + num + num +
+    "(" + cmts + "*" + ")" + ws)
+var rxComment = regexp.MustCompile(cmt)
+
+// ReadFile writes binary P6 format PPM from the specified filename.
+func ReadPpmFile(fn string) (b *Bitmap, err error) {
+    var f *os.File
+    if f, err = os.Open(fn); err != nil {
+        return
+    }
+    if b, err = ReadPpmFrom(f); err != nil {
+        return
+    }
+    return b, f.Close()
+}

Task/Bitmap-Read-a-PPM-file/Go/bitmap-read-a-ppm-file-2.go

@@ -0,0 +1,28 @@
+package main
+
+// Files required to build supporting package raster are found in:
+// * This task (immediately above)
+// * Bitmap
+// * Grayscale image
+// * Write a PPM file
+
+import (
+    "raster"
+    "fmt"
+)
+
+func main() {
+    // (A file with this name is output by the Go solution to the task
+    // "Bitmap/Read an image through a pipe," but of course any 8-bit
+    //  P6 PPM file should work.)
+    b, err := raster.ReadPpmFile("pipein.ppm")
+    if err != nil {
+        fmt.Println(err)
+        return
+    }
+    b = b.Grmap().Bitmap()
+    err = b.WritePpmFile("grayscale.ppm")
+    if err != nil {
+        fmt.Println(err)
+    }
+}

Task/Bitmap-Read-a-PPM-file/Haskell/bitmap-read-a-ppm-file-1.hs

@@ -0,0 +1,12 @@
+import Bitmap
+import Bitmap.RGB
+import Bitmap.Gray
+import Bitmap.Netpbm
+
+import Control.Monad
+import Control.Monad.ST
+
+main =
+    (readNetpbm "original.ppm" :: IO (Image RealWorld RGB)) >>=
+    stToIO . toGrayImage >>=
+    writeNetpbm "new.pgm"

Task/Bitmap-Read-a-PPM-file/Haskell/bitmap-read-a-ppm-file-2.hs

@@ -0,0 +1,4 @@
+main =
+    (readNetpbm "original.ppm" :: IO (Image RealWorld RGB)) >>=
+    stToIO . (toRGBImage <=< toGrayImage) >>=
+    writeNetpbm "new.ppm"

Task/Bitmap-Read-a-PPM-file/Lua/bitmap-read-a-ppm-file.lua

@@ -0,0 +1,34 @@
+function Read_PPM( filename )
+    local fp = io.open( filename, "rb" )
+    if fp == nil then return nil end
+
+    local data = fp:read( "*line" )
+    if data ~= "P6" then return nil end
+
+    repeat
+        data = fp:read( "*line" )
+    until string.find( data, "#" ) == nil
+
+    local image = {}
+    local size_x, size_y
+
+    size_x = string.match( data, "%d+" )
+    size_y = string.match( data, "%s%d+" )
+
+    data = fp:read( "*line" )
+    if tonumber(data) ~= 255 then return nil end
+
+    for i = 1, size_x do
+        image[i] = {}
+    end
+
+    for j = 1, size_y do
+        for i = 1, size_x do
+            image[i][j] = { string.byte( fp:read(1) ), string.byte( fp:read(1) ), string.byte( fp:read(1) ) }
+        end
+    end
+
+    fp:close()
+
+    return image
+end

Task/Bitmap-Read-a-PPM-file/Perl/bitmap-read-a-ppm-file.pl

@@ -0,0 +1,14 @@
+#! /usr/bin/perl
+
+use strict;
+use Image::Imlib2;
+
+my $img = Image::Imlib2->load("out0.ppm");
+
+# let's do something with it now
+$img->set_color(255, 255, 255, 255);
+$img->draw_line(0,0, $img->width,$img->height);
+$img->image_set_format("png");
+$img->save("out1.png");
+
+exit 0;

Task/Bitmap-Read-a-PPM-file/PicoLisp/bitmap-read-a-ppm-file-1.l

@@ -0,0 +1,18 @@
+(de ppmRead (File)
+   (in File
+      (unless (and `(hex "5036") (rd 2))  # P6
+         (quit "Wrong file format" File) )
+      (rd 1)
+      (let (DX 0  DY 0  Max 0  C)
+         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
+            (setq DX (+ (* 10 DX) C)) )
+         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
+            (setq DY (+ (* 10 DY) C)) )
+         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
+            (setq Max (+ (* 10 Max) C)) )
+         (prog1
+            (make (do DY (link (need DX))))
+            (for Y @
+               (map
+                  '((X) (set X (list (rd 1) (rd 1) (rd 1))))
+                  Y ) ) ) ) ) )

Task/Bitmap-Read-a-PPM-file/PicoLisp/bitmap-read-a-ppm-file-2.l

@@ -0,0 +1 @@
+(pgmWrite (ppm->pgm (ppmRead "img.ppm")) "img.pgm")

Task/Bitmap-Read-a-PPM-file/Python/bitmap-read-a-ppm-file.py

@@ -0,0 +1,69 @@
+# With help from http://netpbm.sourceforge.net/doc/ppm.html
+
+# String masquerading as ppm file (version P3)
+import io
+
+ppmtxt = '''P3
+# feep.ppm
+4 4
+15
+ 0  0  0    0  0  0    0  0  0   15  0 15
+ 0  0  0    0 15  7    0  0  0    0  0  0
+ 0  0  0    0  0  0    0 15  7    0  0  0
+15  0 15    0  0  0    0  0  0    0  0  0
+'''
+
+
+def tokenize(f):
+    for line in f:
+        if line[0] != '#':
+            for t in line.split():
+                yield t
+
+def ppmp3tobitmap(f):
+    t = tokenize(f)
+    nexttoken = lambda : next(t)
+    assert 'P3' == nexttoken(), 'Wrong filetype'
+    width, height, maxval = (int(nexttoken()) for i in range(3))
+    bitmap = Bitmap(width, height, Colour(0, 0, 0))
+    for h in range(height-1, -1, -1):
+        for w in range(0, width):
+            bitmap.set(w, h, Colour( *(int(nexttoken()) for i in range(3))))
+
+    return bitmap
+
+print('Original Colour PPM file')
+print(ppmtxt)
+ppmfile = io.StringIO(ppmtxt)
+bitmap = ppmp3tobitmap(ppmfile)
+print('Grey PPM:')
+bitmap.togreyscale()
+ppmfileout = io.StringIO('')
+bitmap.writeppmp3(ppmfileout)
+print(ppmfileout.getvalue())
+
+
+'''
+The print statements above produce the following output:
+
+Original Colour PPM file
+P3
+# feep.ppm
+4 4
+15
+ 0  0  0    0  0  0    0  0  0   15  0 15
+ 0  0  0    0 15  7    0  0  0    0  0  0
+ 0  0  0    0  0  0    0 15  7    0  0  0
+15  0 15    0  0  0    0  0  0    0  0  0
+
+Grey PPM:
+P3
+# generated from Bitmap.writeppmp3
+4 4
+11
+    0  0  0    0  0  0    0  0  0    4  4  4
+    0  0  0   11 11 11    0  0  0    0  0  0
+    0  0  0    0  0  0   11 11 11    0  0  0
+    4  4  4    0  0  0    0  0  0    0  0  0
+
+'''

Task/Bitmap-Read-a-PPM-file/Ruby/bitmap-read-a-ppm-file.rb

@@ -0,0 +1,33 @@
+class Pixmap
+  # 'open' is a class method
+  def self.open(filename)
+    bitmap = nil
+    File.open(filename, 'r') do |f|
+      header = [f.gets.chomp, f.gets.chomp, f.gets.chomp]
+      width, height = header[1].split.map {|n| n.to_i }
+      if header[0] != 'P6' or header[2] != '255' or width < 1 or height < 1
+        raise StandardError, "file '#{filename}' does not start with the expected header"
+      end
+      f.binmode
+      bitmap = self.new(width, height)
+      height.times do |y|
+        width.times do |x|
+          # read 3 bytes
+          red, green, blue = f.read(3).unpack('C3')
+          bitmap[x,y] = RGBColour.new(red, green, blue)
+        end
+      end
+    end
+    bitmap
+  end
+end
+
+# create an image: a green cross on a blue background
+colour_bitmap = Pixmap.new(20, 30)
+colour_bitmap.fill(RGBColour::BLUE)
+colour_bitmap.height.times {|y| [9,10,11].each {|x| colour_bitmap[x,y]=RGBColour::GREEN}}
+colour_bitmap.width.times  {|x| [14,15,16].each {|y| colour_bitmap[x,y]=RGBColour::GREEN}}
+colour_bitmap.save('testcross.ppm')
+
+# then, convert to grayscale
+Pixmap.open('testcross.ppm').to_grayscale!.save('testgray.ppm')

Task/Bitmap-Read-a-PPM-file/Scala/bitmap-read-a-ppm-file-1.scala

@@ -0,0 +1,46 @@
+import scala.io._
+import scala.swing._
+import java.io._
+import java.awt.Color
+import javax.swing.ImageIcon
+
+object Pixmap {
+   private case class PpmHeader(format:String, width:Int, height:Int, maxColor:Int)
+	
+   def load(filename:String):Option[RgbBitmap]={
+      implicit val in=new BufferedInputStream(new FileInputStream(filename))
+      val header=readHeader
+      if(header.format=="P6")
+      {
+         val bm=new RgbBitmap(header.width, header.height);
+         for(y <- 0 until bm.height; x <- 0 until bm.width; c=readColor)
+            bm.setPixel(x, y, c)
+         return Some(bm)
+      }
+      None
+   }
+
+   private def readHeader(implicit in:InputStream)={
+      var format=readLine
+		
+      var line=readLine
+      while(line.startsWith("#"))   //skip comments
+         line=readLine
+
+      val parts=line.split("\\s")
+      val width=parts(0).toInt
+      val height=parts(1).toInt
+      val maxColor=readLine.toInt
+		
+      new PpmHeader(format, width, height, maxColor)
+   }
+
+   private def readColor(implicit in:InputStream)=new Color(in.read, in.read, in.read)
+
+   private def readLine(implicit in:InputStream)={
+      var out=""
+      var b=in.read
+      while(b!=0xA){out+=b.toChar; b=in.read}
+      out
+   }
+}

Task/Bitmap-Read-a-PPM-file/Scala/bitmap-read-a-ppm-file-2.scala

@@ -0,0 +1,15 @@
+object PixmapTest {
+   def main(args: Array[String]): Unit = {
+      val img=Pixmap.load("image.ppm").get
+      val grayImg=BitmapOps.grayscale(img);
+      Pixmap.save(grayImg, "image_gray.ppm")
+
+      val mainframe=new MainFrame(){
+         title="Test"
+         visible=true
+         contents=new Label(){
+            icon=new ImageIcon(grayImg.image)
+         }
+      }
+   }
+}

Task/Bitmap-Read-a-PPM-file/Tcl/bitmap-read-a-ppm-file-1.tcl

@@ -0,0 +1,5 @@
+package require Tk
+
+proc readPPM {image file} {
+    $image read $file -format ppm
+}

Task/Bitmap-Read-a-PPM-file/Tcl/bitmap-read-a-ppm-file-2.tcl

@@ -0,0 +1,21 @@
+package require Tk
+
+proc grayscaleFile {filename {newFilename ""}} {
+    set buffer [image create photo]
+    if {$newFilename eq ""} {set newFilename $filename}
+    try {
+        $buffer read $filename -format ppm
+        set w [image width $buffer]
+        set h [image height $buffer]
+        for {set x 0} {$x<$w} {incr x} {
+            for {set y 0} {$y<$h} {incr y} {
+                lassign [$buffer get $x $y] r g b
+                set l [expr {int(0.2126*$r + 0.7152*$g + 0.0722*$b)}]
+                $buffer put [format "#%02x%02x%02x" $l $l $l] -to $x $y
+            }
+        }
+        $buffer write $newFilename -format ppm
+    } finally {
+        image delete $buffer
+    }
+}

Task/Bitmap-Read-a-PPM-file/Tcl/bitmap-read-a-ppm-file-3.tcl

@@ -0,0 +1,12 @@
+package require Tk
+
+proc grayscaleFile {filename {newFilename ""}} {
+    set buffer [image create photo]
+    if {$newFilename eq ""} {set newFilename $filename}
+    try {
+        $buffer read $filename -format ppm
+        $buffer write $newFilename -format ppm -grayscale
+    } finally {
+        image delete $buffer
+    }
+}