extra/alien/data/map/map-tests.factor

   1 ! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.data alien.data.map fry generalizations kernel locals math.vectors
   4 math.vectors.conversion math math.vectors.simd math.ranges sequences
   5 specialized-arrays tools.test ;
   6 FROM: alien.c-types => uchar short int float ;
   7 SPECIALIZED-ARRAYS: int float float-4 uchar-16 ;
   8 IN: alien.data.map.tests
   9
  10 { float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } }
  11 [
  12     int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] )
  13     float cast-array
  14 ] unit-test
  15
  16 {
  17     float-4-array{
  18         float-4{ 0.0 0.0 0.0 0.0 }
  19         float-4{ 1.0 1.0 1.0 1.0 }
  20         float-4{ 2.0 2.0 2.0 2.0 }
  21     }
  22 } [
  23     3 <iota> [ float-4-with ] data-map( object -- float-4 )
  24     float-4 cast-array
  25 ] unit-test
  26
  27 {
  28     float-4-array{
  29         float-4{ 0.0 1.0  2.0  3.0 }
  30         float-4{ 4.0 5.0  6.0  7.0 }
  31         float-4{ 8.0 9.0 10.0 11.0 }
  32     }
  33 } [
  34     12 <iota> [ float-4-boa ] data-map( object[4] -- float-4 )
  35     float-4 cast-array
  36 ] unit-test
  37
  38 { float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } }
  39 [
  40     int-array{ 1 3 5 } float-array{ 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 }
  41     [ dup ] data-map!( int -- float[2] )
  42 ] unit-test
  43
  44 :: float-pixels>byte-pixels-locals ( floats scale bias -- bytes )
  45     floats [
  46         [ scale 255.0 * v*n bias 255.0 * v+n float-4 int-4 vconvert ] 4 napply
  47         [ int-4 short-8 vconvert ] 2bi@
  48         short-8 uchar-16 vconvert
  49     ] data-map( float-4[4] -- uchar-16 ) ; inline
  50
  51 : float-pixels>byte-pixels* ( floats scale bias -- bytes )
  52     '[
  53         [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply
  54         [ int-4 short-8 vconvert ] 2bi@
  55         short-8 uchar-16 vconvert
  56     ] data-map( float-4[4] -- uchar-16 ) ; inline
  57
  58 : float-pixels>byte-pixels ( floats -- bytes )
  59     1.0 0.0 float-pixels>byte-pixels* ;
  60
  61 {
  62     B{
  63         127 191 255 63
  64         255 25 51 76
  65         76 51 229 127
  66         25 255 255 255
  67     }
  68 } [
  69     float-array{
  70         0.5 0.75 1.0 0.25
  71         1.0 0.1 0.2 0.3
  72         0.3 0.2 0.9 0.5
  73         0.1 1.0 1.5 2.0
  74     } 1.0 0.0 float-pixels>byte-pixels-locals
  75 ] unit-test
  76
  77 {
  78     B{
  79         127 191 255 63
  80         255 25 51 76
  81         76 51 229 127
  82         25 255 255 255
  83     }
  84 } [
  85     float-array{
  86         0.5 0.75 1.0 0.25
  87         1.0 0.1 0.2 0.3
  88         0.3 0.2 0.9 0.5
  89         0.1 1.0 1.5 2.0
  90     } float-pixels>byte-pixels
  91 ] unit-test
  92
  93 {
  94     B{
  95         127 191 255 63
  96         255 25 51 76
  97         76 51 229 127
  98         25 255 255 255
  99     }
 100 } [
 101     float-array{
 102         0.5 0.75 1.0 0.25
 103         1.0 0.1 0.2 0.3
 104         0.3 0.2 0.9 0.5
 105         0.1 1.0 1.5 2.0
 106         5.0
 107     } [
 108         [ 255.0 v*n float-4 int-4 vconvert ] 4 napply
 109         [ int-4 short-8 vconvert ] 2bi@
 110         short-8 uchar-16 vconvert
 111     ] data-map( float-4[4] -- uchar-16 )
 112 ] unit-test
 113
 114 : vmerge-transpose ( a b c d -- ac bd ac bd )
 115     [ (vmerge) ] bi-curry@ bi* ; inline
 116
 117 CONSTANT: plane-count 4
 118
 119 : fold-rgba-planes ( r g b a -- rgba )
 120     [ vmerge-transpose vmerge-transpose ]
 121     data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[plane-count] ) ;
 122
 123 {
 124     B{
 125          1  10  11  15
 126          2  20  22  25
 127          3  30  33  35
 128          4  40  44  45
 129          5  50  55  55
 130          6  60  66  65
 131          7  70  77  75
 132          8  80  88  85
 133          9  90  99  95
 134         10 100 110 105
 135         11 110 121 115
 136         12 120 132 125
 137         13 130 143 135
 138         14 140 154 145
 139         15 150 165 155
 140         16 160 176 165
 141     }
 142 } [
 143     B{   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16 }
 144     B{  10  20  30  40  50  60  70  80  90 100 110 120 130 140 150 160 }
 145     B{  11  22  33  44  55  66  77  88  99 110 121 132 143 154 165 176 }
 146     B{  15  25  35  45  55  65  75  85  95 105 115 125 135 145 155 165 }
 147     fold-rgba-planes
 148 ] unit-test
 149
 150 : data-map-compiler-bug-test ( n -- byte-array )
 151     [ 0.0 1.0 1.0 ] dip /f <range>
 152     [ ] data-map( object -- float ) ;
 153
 154 { float-array{ 0.0 0.5 1.0 } }
 155 [ 2 data-map-compiler-bug-test float cast-array ]
 156 unit-test