basis/images/processing/processing.factor

   1 ! Copyright (C) 2009 Marc Fauconneau.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays byte-arrays images kernel math
   4 math.order math.vectors sequences sequences.deep ;
   5 IN: images.processing
   6
   7 : coord-matrix ( dim -- m )
   8     [ <iota> ] map first2 cartesian-product ;
   9
  10 : map^2 ( m quot -- m' ) '[ _ map ] map ; inline
  11 : each^2 ( m quot -- m' ) '[ _ each ] each ; inline
  12
  13 : matrix-dim ( m -- dim ) [ length ] [ first length ] bi 2array ;
  14
  15 : matrix>image ( m -- image )
  16     <image> over matrix-dim >>dim
  17     swap flip flatten
  18     [ 128 * 128 + 0 255 clamp >fixnum ] map
  19     >byte-array >>bitmap L >>component-order ubyte-components >>component-type ;
  20
  21 :: matrix-zoom ( m f -- m' )
  22     m matrix-dim f v*n coord-matrix
  23     [ [ f /i ] map first2 swap m nth nth ] map^2 ;
  24
  25 :: image-offset ( x,y image -- xy )
  26     image dim>> first
  27     x,y second * x,y first + ;
  28
  29 :: draw-grey ( value x,y image -- )
  30     x,y image image-offset 3 * { 0 1 2 }
  31     [
  32         + value 128 + >fixnum 0 255 clamp swap image bitmap>> set-nth
  33     ] with each ;
  34
  35 :: draw-color ( value x,y color-id image -- )
  36     x,y image image-offset 3 * color-id + value >fixnum
  37     swap image bitmap>> set-nth ;
  38
  39 ! : matrix. ( m -- ) 10 matrix-zoom matrix>image image. ;