basis/images/tessellation/tessellation.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays fry grouping images kernel locals math
   4 math.vectors sequences ;
   5 IN: images.tessellation
   6
   7 : group-rows ( bitmap bitmap-dim -- rows )
   8     first <groups> ; inline
   9
  10 : tesselate-rows ( bitmap-rows tess-dim -- bitmaps )
  11     second <groups> ; inline
  12
  13 : tesselate-columns ( bitmap-rows tess-dim -- bitmaps )
  14     first '[ _ <groups> ] map flip ; inline
  15
  16 : tesselate-bitmap ( bitmap bitmap-dim tess-dim -- bitmap-grid )
  17     [ group-rows ] dip
  18     [ tesselate-rows ] keep
  19     '[ _ tesselate-columns ] map ;
  20
  21 : tile-width ( tile-bitmap original-image -- width )
  22     [ first length ] [ bytes-per-pixel ] bi* /i ;
  23
  24 : <tile-image> ( tile-bitmap original-image -- tile-image )
  25     clone
  26         swap
  27         [ concat >>bitmap ]
  28         [ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
  29
  30 :: tesselate ( image tess-dim -- image-grid )
  31     image bytes-per-pixel :> bpp
  32     image dim>> { bpp 1 } v* :> image-dim'
  33     tess-dim { bpp 1 } v* :> tess-dim'
  34     image bitmap>> image-dim' tess-dim' tesselate-bitmap
  35     [ [ image <tile-image> ] map ] map ;