extra/images/ppm/ppm.factor

   1 ! Copyright (C) 2010 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors ascii combinators images images.loader io
   4 io.encodings.ascii io.encodings.string kernel locals make math
   5 math.parser sequences io.streams.throwing ;
   6 IN: images.ppm
   7
   8 SINGLETON: ppm-image
   9 "ppm" ppm-image ?register-image-class
  10
  11 : read-token ( -- token )
  12     [ read1 dup blank?
  13       [ t ]
  14       [ dup CHAR: # =
  15         [ "\n" read-until 2drop t ]
  16         [ f ] if
  17       ] if
  18     ] [ drop ] while
  19     " \n\r\t" read-until drop swap
  20     prefix ascii decode ;
  21
  22 : read-number ( -- number )
  23     read-token string>number ;
  24
  25 :: read-numbers ( n lim -- )
  26     n lim = [
  27         read-number ,
  28         n 1 + lim read-numbers
  29     ] unless ;
  30
  31 :: read-ppm ( -- image )
  32     read-token         :> type
  33     read-number        :> width
  34     read-number        :> height
  35     read-number        :> max
  36     width height 3 * * :> npixels
  37     type {
  38         { "P3" [ [ 0 npixels read-numbers ] B{ } make ] }
  39         { "P6" [ npixels read ] }
  40     } case :> data
  41
  42     image new
  43     RGB              >>component-order
  44     { width height } >>dim
  45     f                >>upside-down?
  46     data             >>bitmap
  47     ubyte-components >>component-type ;
  48
  49 M: ppm-image stream>image*
  50     drop [ [ read-ppm ] throw-on-eof ] with-input-stream ;
  51
  52 M: ppm-image image>stream
  53     2drop {
  54         [ drop "P6\n" ascii encode write ]
  55         [ dim>> first number>string " " append ascii encode write ]
  56         [ dim>> second number>string "\n" append ascii encode write ]
  57         [ drop "255\n" ascii encode write ]
  58         [ bitmap>> write ]
  59     } cleave ;