PGM image loading and saving

basis/images/pgm/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

basis/images/pgm/pgm-tests.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images.testing ;
+IN: images.pgm.tests
+
+"vocab:images/testing/pgm/radial.binary.pgm" decode-test
+"vocab:images/testing/pgm/radial.ascii.pgm" decode-test

basis/images/pgm/pgm.factor

@@ -0,0 +1,63 @@
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types ascii combinators images images.loader
+io io.encodings.ascii io.encodings.string kernel locals make math
+math.parser sequences specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
+IN: images.pgm
+
+SINGLETON: pgm-image
+"pgm" pgm-image register-image-class
+
+: read-token ( -- token )
+    [ read1 dup blank?
+      [ t ]
+      [ dup CHAR: # =
+        [ "\n" read-until 2drop t ]
+        [ f ] if
+      ] if
+    ] [ drop ] while
+    " \n\r\t" read-until drop swap
+    prefix ascii decode ;
+
+: read-number ( -- number )
+    read-token string>number ;
+
+:: read-numbers ( n lim -- )
+    n lim = [
+        read-number ,
+        n 1 + lim read-numbers
+    ] unless ;
+
+ERROR: INSPECT a ;
+:: read-pgm ( -- image )
+    read-token         :> type
+    read-number        :> width
+    read-number        :> height
+    read-number        :> max
+    width height *     :> npixels
+    max 256 >=         :> wide
+    
+    type {
+        { "P2" [ [ 0 npixels read-numbers ] wide [ ushort-array{ } ] [ B{ } ] if make ] }
+        { "P5" [ wide [ 2 ] [ 1 ] if npixels * read ] }
+    } case :> data
+    
+    image new
+    L                                                  >>component-order
+    { width height }                                   >>dim
+    f                                                  >>upside-down?
+    data                                               >>bitmap
+    wide [ ushort-components ] [ ubyte-components ] if >>component-type ;
+
+M: pgm-image stream>image
+    drop [ read-pgm ] with-input-stream ;
+
+M: pgm-image image>stream
+    drop {
+        [ drop "P5\n" ascii encode write ]
+        [ dim>> first number>string " " append ascii encode write ]
+        [ dim>> second number>string "\n" append ascii encode write ]
+        [ component-type>> ubyte-components = [ "255\n" ] [ "65535\n" ] if ascii encode write ]
+        [ bitmap>> write ]
+    } cleave ;

basis/images/pgm/summary.txt

@@ -0,0 +1 @@
+Image loading for PGM image files.