update

Task/Bitmap-Read-a-PPM-file/FBSL/bitmap-read-a-ppm-file.fbsl

@@ -0,0 +1,18 @@
+#ESCAPECHARS ON
+
+DIM colored = ".\\Lena.ppm", grayscale = ".\\LenaGry.ppm"
+DIM head, tail, r, g, b, l, ptr, blobsize
+
+FILEGET(FILEOPEN(colored, BINARY), FILELEN(colored)): FILECLOSE(FILEOPEN) ' Load buffer
+blobsize = INSTR(FILEGET, "\n255\n") + 4 ' Get sizeof PPM header
+head = @FILEGET + blobsize: tail = @FILEGET + FILELEN ' Set loop bounds
+
+FOR ptr = head TO tail STEP 3 ' Transform color triplets
+	r = PEEK(ptr + 0, 1) ' Read colors stored in RGB order
+	g = PEEK(ptr + 1, 1)
+	b = PEEK(ptr + 2, 1)
+	l = 0.2126 * r + 0.7152 * g + 0.0722 * b ' Derive luminance
+	POKE(ptr + 0, CHR(l))(ptr + 1, CHR)(ptr + 2, CHR) ' Write grayscale
+NEXT
+
+FILEPUT(FILEOPEN(grayscale, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' Save buffer

Task/Bitmap-Read-a-PPM-file/Racket/bitmap-read-a-ppm-file.rkt

@@ -0,0 +1,22 @@
+#lang racket
+(require racket/draw)
+
+(define (read-ppm port)
+  (parameterize ([current-input-port port])
+    (define magic (read))
+    (define width (read))
+    (define height (read))
+    (define maxcol (read))
+    (define bm (make-object bitmap% width height))
+    (define dc (new bitmap-dc% [bitmap bm]))
+    (send dc set-smoothing 'unsmoothed)
+    (define (adjust v) (* 255 (/ v maxcol)))
+    (for/list ([x width])
+      (for/list ([y height])
+        (define red (read))
+        (define green (read))
+        (define blue (read))
+        (define color (make-object color% (adjust red) (adjust green) (adjust blue)))
+        (send dc set-pen color 1 'solid)
+        (send dc draw-point x y)))
+    bm))