1 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: ascii assocs byte-arrays destructors fry
4 io.encodings.binary io.files io.pathnames io.streams.byte-array
5 kernel namespaces strings ;
8 ERROR: unknown-image-extension extension ;
13 types [ H{ } clone ] initialize
15 : (image-class) ( type -- class )
16 >lower types get ?at [ throw-unknown-image-extension ] unless ;
18 : image-class ( path -- class )
19 file-extension (image-class) ;
25 GENERIC# load-image* 1 ( obj class -- image )
27 GENERIC: stream>image* ( stream class -- image )
29 : stream>image ( stream class -- image )
30 '[ _ &dispose _ stream>image* ] with-destructors ; inline
32 : register-image-class ( extension class -- )
33 swap types get set-at ;
35 : ?register-image-class ( extension class -- )
36 over types get key? [ 2drop ] [ register-image-class ] if ;
38 : load-image ( path -- image )
39 dup image-class load-image* ;
41 M: object load-image* stream>image ;
43 M: byte-array load-image*
44 [ binary <byte-reader> ] dip stream>image ;
47 [ binary <file-reader> ] dip stream>image ;
49 M: pathname load-image*
50 [ binary <file-reader> ] dip stream>image ;
53 GENERIC: image>stream ( image extension class -- )
55 : save-graphic-image ( image path -- )
56 dup file-extension dup (image-class) rot
57 binary [ image>stream ] with-file-writer ;