basis/images/bitmap/bitmap.factor

   1 ! Copyright (C) 2007, 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types arrays byte-arrays columns
   4 combinators compression.run-length endian fry grouping images
   5 images.loader images.normalization io io.binary
   6 io.encodings.binary io.encodings.string io.files
   7 io.streams.limited kernel locals macros math math.bitwise
   8 math.functions namespaces sequences specialized-arrays
   9 strings summary ;
  10 SPECIALIZED-ARRAYS: uint ushort ;
  11 IN: images.bitmap
  12
  13 SINGLETON: bmp-image
  14 "bmp" bmp-image register-image-class
  15
  16 : write2 ( n -- ) 2 >le write ;
  17 : write4 ( n -- ) 4 >le write ;
  18
  19 : output-width-and-height ( image -- )
  20     [ dim>> first write4 ]
  21     [
  22         [ dim>> second ] [ upside-down?>> ] bi
  23         [ neg ] unless write4
  24     ] bi ;
  25
  26 : output-bmp ( image -- )
  27     B{ CHAR: B CHAR: M } write
  28     [
  29         bitmap>> length 14 + 40 + write4
  30         0 write4
  31         54 write4
  32         40 write4
  33     ] [
  34         {
  35             [ output-width-and-height ]
  36
  37             ! planes
  38             [ drop 1 write2 ]
  39
  40             ! bit-count
  41             [ drop 24 write2 ]
  42
  43             ! compression
  44             [ drop 0 write4 ]
  45
  46             ! image-size
  47             [ bitmap>> length write4 ]
  48
  49             ! x-pels
  50             [ drop 0 write4 ]
  51
  52             ! y-pels
  53             [ drop 0 write4 ]
  54
  55             ! color-used
  56             [ drop 0 write4 ]
  57
  58             ! color-important
  59             [ drop 0 write4 ]
  60
  61             ! color-palette
  62             [ bitmap>> write ]
  63         } cleave
  64     ] bi ;
  65
  66 M: bmp-image image>stream
  67     drop BGR reorder-components output-bmp ;
  68