extra/rosetta-code/bitmap/bitmap.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math.matrices sequences ;
   4 IN: rosetta-code.bitmap
   5
   6 ! http://rosettacode.org/wiki/Basic_bitmap_storage
   7
   8 ! Show a basic storage type to handle a simple RGB raster
   9 ! graphics image, and some primitive associated functions.
  10
  11 ! If possible provide a function to allocate an uninitialised
  12 ! image, given its width and height, and provide 3 additional
  13 ! functions:
  14
  15 ! * one to fill an image with a plain RGB color,
  16 ! * one to set a given pixel with a color,
  17 ! * one to get the color of a pixel.
  18
  19 ! (If there are specificities about the storage or the
  20 ! allocation, explain those.)
  21
  22 ! Various utilities
  23 : meach ( matrix quot -- ) [ each ] curry each ; inline
  24 : meach-index ( matrix quot -- )
  25     [ swap 2array ] prepose
  26     [ curry each-index ] curry each-index ; inline
  27 : mmap ( matrix quot -- matrix' ) [ map ] curry map ; inline
  28 : mmap! ( matrix quot -- matrix' ) [ map! ] curry map! ; inline
  29 : mmap-index ( matrix quot -- matrix' )
  30     [ swap 2array ] prepose
  31     [ curry map-index ] curry map-index ; inline
  32
  33 : matrix-dim ( matrix -- i j ) [ length ] [ first length ] bi ;
  34 : set-Mi,j ( elt {i,j} matrix -- ) [ first2 swap ] dip nth set-nth ;
  35 : Mi,j ( {i,j} matrix -- elt ) [ first2 swap ] dip nth nth ;
  36
  37 ! The storage functions
  38 : <raster-image> ( width height -- image )
  39     <zero-matrix> [ drop { 0 0 0 } ] mmap ;
  40 : fill-image ( {R,G,B} image -- image )
  41     swap '[ drop _ ] mmap! ;
  42 : set-pixel ( {R,G,B} {i,j} image -- ) set-Mi,j ; inline
  43 : get-pixel ( {i,j} image -- pixel ) Mi,j ; inline