1 ! Copyright (C) 2010 Erik Charlebois.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays ascii bit-arrays byte-arrays combinators
4 continuations grouping images images.loader io io.encodings.ascii
5 io.encodings.string kernel locals make math math.functions math.parser
6 sequences io.streams.throwing ;
10 "pbm" pbm-image ?register-image-class
13 : read-token ( -- token )
19 [ "\n" read-until 2drop t ]
23 " \n\r\t" read-until drop swap
26 : read-number ( -- number )
27 read-token string>number ;
29 : read-ascii-bits ( -- )
31 { CHAR: 1 [ 0 , read-ascii-bits ] }
32 { CHAR: 0 [ 255 , read-ascii-bits ] }
34 [ drop read-ascii-bits ]
37 :: read-binary-bits ( width height -- )
38 width 8 align 8 / height * read
39 width 8 align 8 / <groups> [| row |
47 :: write-binary-bits ( bitmap width -- )
48 bitmap width <groups> [
49 width 8 align 255 pad-tail
51 [ 255 = [ f ] [ t ] if ] { } map-as
52 >bit-array reverse bit-array>integer
53 1array >byte-array write
57 :: read-pbm ( -- image )
63 { "P1" [ [ [ read-ascii-bits ] ignore-errors ] B{ } make ] }
64 { "P4" [ [ width height read-binary-bits ] B{ } make ] }
69 { width height } >>dim
72 ubyte-components >>component-type ;
75 M: pbm-image stream>image*
76 drop [ [ read-pbm ] throw-on-eof ] with-input-stream ;
78 M: pbm-image image>stream
80 [ drop "P4\n" ascii encode write ]
81 [ dim>> first number>string " " append ascii encode write ]
82 [ dim>> second number>string "\n" append ascii encode write ]
83 [ [ bitmap>> ] [ dim>> first ] bi write-binary-bits ]