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.bitmap.loading images.loader 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-ARRAY: uint
  11 SPECIALIZED-ARRAY: ushort
  12 IN: images.bitmap
  13
  14 : write2 ( n -- ) 2 >le write ;
  15 : write4 ( n -- ) 4 >le write ;
  16
  17 : save-bitmap ( image path -- )
  18     binary [
  19         B{ CHAR: B CHAR: M } write
  20         [
  21             bitmap>> length 14 + 40 + write4
  22             0 write4
  23             54 write4
  24             40 write4
  25         ] [
  26             {
  27                 ! width height
  28                 [ dim>> first2 [ write4 ] bi@ ]
  29
  30                 ! planes
  31                 [ drop 1 write2 ]
  32
  33                 ! bit-count
  34                 [ drop 24 write2 ]
  35
  36                 ! compression
  37                 [ drop 0 write4 ]
  38
  39                 ! image-size
  40                 [ bitmap>> length write4 ]
  41
  42                 ! x-pels
  43                 [ drop 0 write4 ]
  44
  45                 ! y-pels
  46                 [ drop 0 write4 ]
  47
  48                 ! color-used
  49                 [ drop 0 write4 ]
  50
  51                 ! color-important
  52                 [ drop 0 write4 ]
  53
  54                 ! color-palette
  55                 [ bitmap>> write ]
  56             } cleave
  57         ] bi
  58     ] with-file-writer ;