share/draw/rtest_picture.mac

   1 /* test functions in share/draw/picture.lisp
   2  * first apply picture functions to level and rgb pictures
   3  */
   4
   5 (data_list: makelist (floor (255*k/12), k, 1, 12),
   6  aa: make_array (fixnum, 3*4),
   7  fillarray (aa, data_list),
   8  0);
   9 0;
  10
  11 foo: make_level_picture (data_list, 4, 3);
  12 picture (level, 4, 3, ''aa);
  13
  14 bar: make_level_picture (genmatrix (lambda ([i, j], data_list[(i - 1)*4 + j]), 3, 4));
  15 picture (level, 4, 3, ''aa);
  16
  17 picturep (foo);
  18 true;
  19
  20 [picturep (1), picturep ([1, 2, 3]), picturep (x*y*z), picturep (aa)];
  21 [false, false, false, false];
  22
  23 picture_equalp (foo, bar);
  24 true;
  25
  26 (aa_rgb: make_array (fixnum, 3*12),
  27  fillarray (aa_rgb, makelist (floor (255*k/36), k, 1, 36)),
  28  ll_red:   makelist (aa_rgb[k - 1], k, 1, 36, 3),
  29  ll_green: makelist (aa_rgb[k - 1], k, 2, 36, 3),
  30  ll_blue:  makelist (aa_rgb[k - 1], k, 3, 36, 3),
  31  aa_red:   make_array (fixnum, 12),
  32  fillarray (aa_red, ll_red),
  33  aa_green: make_array (fixnum, 12),
  34  fillarray (aa_green, ll_green),
  35  aa_blue:  make_array (fixnum, 12),
  36  fillarray (aa_blue, ll_blue),
  37  0);
  38 0;
  39
  40 red_level:   make_level_picture (ll_red, 4, 3);
  41 picture (level, 4, 3, ''aa_red);
  42
  43 green_level: make_level_picture (ll_green, 4, 3);
  44 picture (level, 4, 3, ''aa_green);
  45
  46 blue_level:  make_level_picture (ll_blue, 4, 3);
  47 picture (level, 4, 3, ''aa_blue);
  48
  49 rgb_pic: make_rgb_picture (red_level, green_level, blue_level);
  50 picture (rgb, 4, 3, ''aa_rgb);
  51
  52 take_red: take_channel (rgb_pic, 'red);
  53 ''red_level;
  54
  55 take_green: take_channel (rgb_pic, 'green);
  56 ''green_level;
  57
  58 take_blue: take_channel (rgb_pic, 'blue);
  59 ''blue_level;
  60
  61 [picture_equalp (take_red, red_level), picture_equalp (take_green, green_level), picture_equalp (take_blue, blue_level)];
  62 [true, true, true];
  63
  64 (aa_red_negated: make_array (fixnum, 12),
  65  for k:0 thru 11 do aa_red_negated[k]: 255 - aa_red[k],
  66  aa_green_negated: make_array (fixnum, 12),
  67  for k:0 thru 11 do aa_green_negated[k]: 255 - aa_green[k],
  68  aa_blue_negated: make_array (fixnum, 12),
  69  for k:0 thru 11 do aa_blue_negated[k]: 255 - aa_blue[k]);
  70 done;
  71
  72 red_level_negated: negative_picture (red_level);
  73 picture (level, 4, 3, ''aa_red_negated);
  74
  75 green_level_negated: negative_picture (green_level);
  76 picture (level, 4, 3, ''aa_green_negated);
  77
  78 blue_level_negated: negative_picture (blue_level);
  79 picture (level, 4, 3, ''aa_blue_negated);
  80
  81 rgb_pic_negated: negative_picture (rgb_pic);
  82 ''(negated_rgb_via_make_pic: make_rgb_picture (red_level_negated, green_level_negated, blue_level_negated));
  83
  84 picture_equalp (rgb_pic_negated, negated_rgb_via_make_pic);
  85 true;
  86
  87 (aa_mean_rgb: fillarray (make_array (fixnum, 12), round ((ll_red + ll_green + ll_blue)/3)),
  88  aa_mean_rgb_negated: fillarray (make_array (fixnum, 12), round (255 - (ll_red + ll_green + ll_blue)/3)),
  89  0);
  90 0;
  91
  92 rgb2level (rgb_pic);
  93 picture (level, 4, 3, ''aa_mean_rgb);
  94
  95 rgb2level (rgb_pic_negated);
  96 picture (level, 4, 3, ''aa_mean_rgb_negated);
  97
  98 (by_n (l, n) := makelist (makelist (l[k + j - 1], j, 1, n), k, 1, length (l), n), 0);
  99 0;
 100
 101 makelist (makelist (get_pixel (rgb_pic, i - 1, j - 1), i, 1, 4), j, 1, 3);
 102 ''(by_n (by_n (listarray (aa_rgb), 3), 4));
 103
 104 (test_example_rgba_list: block ([ibase: 16.], read_list (file_search ("test-example-rgba.csv"), 'comma)),
 105  test_example_rgba_array: make_array (fixnum, length (test_example_rgba_list)),
 106  fillarray (test_example_rgba_array, test_example_rgba_list),
 107  test_example_rgba_picture: picture (rgb_alpha, 20, 10, test_example_rgba_array),
 108  0);
 109 0;
 110
 111 test_example_xpm: read_xpm (file_search ("test-example.xpm"));
 112 ''test_example_rgba_picture;
 113
 114 (openr (file_search ("test-example.xpm")),
 115  read_xpm (%%));
 116 ''test_example_xpm;
 117
 118 /* apply picture functions to rgb_alpha pictures */
 119
 120 first (test_example_xpm);
 121 rgb_alpha;
 122
 123 picturep (test_example_xpm);
 124 true;
 125
 126 picture_equalp (test_example_xpm, test_example_rgba_picture);
 127 true;
 128
 129 [width, height]: [second (test_example_xpm), third (test_example_xpm)];
 130 [20, 10];
 131
 132 xpm_red: take_channel (test_example_xpm, 'red);
 133 ''(picture (level, width, height, fillarray (make_array (fixnum, width*height), makelist (test_example_rgba_list[i], i, 1, length (test_example_rgba_list), 4))));
 134
 135 xpm_green: take_channel (test_example_xpm, 'green);
 136 ''(picture (level, width, height, fillarray (make_array (fixnum, width*height), makelist (test_example_rgba_list[i], i, 2, length (test_example_rgba_list), 4))));
 137
 138 xpm_blue: take_channel (test_example_xpm, 'blue);
 139 ''(picture (level, width, height, fillarray (make_array (fixnum, width*height), makelist (test_example_rgba_list[i], i, 3, length (test_example_rgba_list), 4))));
 140
 141 [picturep (xpm_red), picturep (xpm_green), picturep (xpm_blue)];
 142 [true, true, true];
 143
 144 [picture_equalp (xpm_red, xpm_green), picture_equalp (xpm_green, xpm_blue), picture_equalp (xpm_blue, xpm_red)];
 145 [false, false, false];
 146
 147 xpm_negative: negative_picture (test_example_xpm);
 148 ''(picture (rgb_alpha, width, height, fillarray (make_array (fixnum, 4*width*height), makelist (if mod (i, 4) = 0 then test_example_rgba_list[i] else 255 - test_example_rgba_list[i], i, 1, length (test_example_rgba_list)))));
 149
 150 xpm_level: rgb2level (test_example_xpm);
 151 ''(picture (level, width, height, fillarray (make_array (fixnum, width*height), makelist (round ((test_example_rgba_list[1 + (i - 1)*4] + test_example_rgba_list[2 + (i - 1)*4] + test_example_rgba_list[3 + (i - 1)*4])/3), i, 1, width*height))));
 152
 153 [picturep (xpm_negative), picturep (xpm_level)];
 154 [true, true];
 155
 156 picture_equalp (xpm_negative, xpm_level);
 157 false;
 158
 159 makelist (makelist (get_pixel (test_example_xpm, i - 1, j - 1), i, 1, second (test_example_xpm)), j, 1, third (test_example_xpm));
 160 ''(by_n (by_n (test_example_rgba_list, 4), second (test_example_xpm)));