basis/images/processing/processing.factor

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