basis/images/loader/loader.factor

   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 ;
   6 IN: images.loader
   7
   8 ERROR: unknown-image-extension extension ;
   9
  10 <PRIVATE
  11
  12 SYMBOL: types
  13 types [ H{ } clone ] initialize
  14
  15 : (image-class) ( type -- class )
  16     >lower types get ?at [ throw-unknown-image-extension ] unless ;
  17
  18 : image-class ( path -- class )
  19     file-extension (image-class) ;
  20
  21 PRIVATE>
  22
  23 ! Image Decode
  24
  25 GENERIC# load-image* 1 ( obj class -- image )
  26
  27 GENERIC: stream>image* ( stream class -- image )
  28
  29 : stream>image ( stream class -- image )
  30     '[ _ &dispose _ stream>image* ] with-destructors ; inline
  31
  32 : register-image-class ( extension class -- )
  33     swap types get set-at ;
  34
  35 : ?register-image-class ( extension class -- )
  36     over types get key? [ 2drop ] [ register-image-class ] if ;
  37
  38 : load-image ( path -- image )
  39     dup image-class load-image* ;
  40
  41 M: object load-image* stream>image ;
  42
  43 M: byte-array load-image*
  44     [ binary <byte-reader> ] dip stream>image ;
  45
  46 M: string load-image*
  47     [ binary <file-reader> ] dip stream>image ;
  48
  49 M: pathname load-image*
  50     [ binary <file-reader> ] dip stream>image ;
  51
  52 ! Image Encode
  53 GENERIC: image>stream ( image extension class -- )
  54
  55 : save-graphic-image ( image path -- )
  56     dup file-extension dup (image-class) rot
  57     binary [ image>stream ] with-file-writer ;