ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/CV/CV.xs
Revision: 1.45
Committed: Fri Aug 29 18:35:25 2014 UTC (9 years, 8 months ago) by root
Branch: MAIN
Changes since 1.44: +2 -2 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include <string.h>
6 #include <setjmp.h>
7 #include <math.h>
8
9 #include <magic.h>
10
11 #include <jpeglib.h>
12 #include <glib.h>
13 #include <gtk/gtk.h>
14 #include <gdk-pixbuf/gdk-pixbuf.h>
15
16 #include <gperl.h>
17 #include <gtk2perl.h>
18
19 #include <assert.h>
20
21 #define IW 80 /* MUST match Schnauzer.pm! */
22 #define IH 60 /* MUST match Schnauzer.pm! */
23
24 #define RAND (seed = (seed + 7141) * 54773 % 134456)
25
26 #define LINELENGTH 240
27
28 #define ELLIPSIS "\xe2\x80\xa6"
29
30 typedef char *octet_string;
31
32 struct jpg_err_mgr
33 {
34 struct jpeg_error_mgr err;
35 jmp_buf setjmp_buffer;
36 };
37
38 static void
39 cv_error_exit (j_common_ptr cinfo)
40 {
41 longjmp (((struct jpg_err_mgr *)cinfo->err)->setjmp_buffer, 99);
42 }
43
44 static void
45 cv_error_output (j_common_ptr cinfo)
46 {
47 return;
48 }
49
50 static void
51 rgb_to_hsv (unsigned int r, unsigned int g, unsigned int b,
52 unsigned int *h, unsigned int *s, unsigned int *v)
53 {
54 unsigned int mx = r; if (g > mx) mx = g; if (b > mx) mx = b;
55 unsigned int mn = r; if (g < mn) mn = g; if (b < mn) mn = b;
56 unsigned int delta = mx - mn;
57
58 *v = mx;
59
60 *s = mx ? delta * 255 / mx : 0;
61
62 if (delta == 0)
63 *h = 0;
64 else
65 {
66 if (r == mx)
67 *h = ((int)g - (int)b) * 255 / (int)(delta * 3);
68 else if (g == mx)
69 *h = ((int)b - (int)r) * 255 / (int)(delta * 3) + 52;
70 else if (b == mx)
71 *h = ((int)r - (int)g) * 255 / (int)(delta * 3) + 103;
72
73 *h &= 255;
74 }
75 }
76
77 struct feature {
78 float v1, v2, v3; // mean, square, cube
79 int n;
80 };
81
82 static void
83 feature_init (struct feature *f)
84 {
85 f->v1 = 0.;
86 f->v2 = 0.;
87 f->v3 = 0.;
88 f->n = 0;
89 }
90
91 // didn't find an algorithm to neatly do mean, variance and skew in one pass.
92 // elmex ist schuld.
93 static void
94 feature_update_pass_1 (struct feature *f, unsigned int v)
95 {
96 f->v1 += v;
97 f->n += 1;
98 }
99
100 static void
101 feature_finish_pass_1 (struct feature *f)
102 {
103 if (f->n < 1)
104 return;
105
106 f->v1 /= f->n;
107 }
108
109 static void
110 feature_update_pass_2 (struct feature *f, unsigned int v)
111 {
112 float d = v - f->v1;
113
114 f->v2 += d * d;
115 f->v3 += d * d * d;
116 }
117
118 static void
119 feature_finish_pass_2 (struct feature *f)
120 {
121 if (f->n < 1)
122 return;
123
124 f->v2 /= f->n;
125 f->v3 /= f->n;
126
127 f->v1 /= 255.;
128 f->v2 /= 255. * 255.; f->v2 = sqrtf (f->v2);
129 f->v3 /= 255. * 255. * 255.; f->v3 = powf (fabsf (f->v3), 1./3.);
130 }
131
132 static guint32 a85_val;
133 static guint a85_cnt;
134 static guchar a85_buf[LINELENGTH], *a85_ptr;
135
136 static void
137 a85_init (void)
138 {
139 a85_cnt = 4;
140 a85_ptr = a85_buf;
141 }
142
143 static void
144 a85_push (PerlIO *fp, guchar c)
145 {
146 a85_val = a85_val << 8 | c;
147
148 if (!--a85_cnt)
149 {
150 a85_cnt = 4;
151 if (a85_val)
152 {
153 a85_ptr[4] = (a85_val % 85) + 33; a85_val /= 85;
154 a85_ptr[3] = (a85_val % 85) + 33; a85_val /= 85;
155 a85_ptr[2] = (a85_val % 85) + 33; a85_val /= 85;
156 a85_ptr[1] = (a85_val % 85) + 33; a85_val /= 85;
157 a85_ptr[0] = (a85_val ) + 33;
158
159 a85_ptr += 5;
160 }
161 else
162 *a85_ptr++ = 'z';
163
164 if (a85_ptr >= a85_buf + sizeof (a85_buf) - 7)
165 {
166 *a85_ptr++ = '\n';
167 PerlIO_write (fp, a85_buf, a85_ptr - a85_buf);
168 a85_ptr = a85_buf;
169 }
170 }
171
172 }
173
174 static void
175 a85_finish (PerlIO *fp)
176 {
177 while (a85_cnt != 4)
178 a85_push (fp, 0);
179
180 *a85_ptr++ = '~'; // probably buggy end-marker
181 *a85_ptr++ = '>'; // probably buggy end-marker
182 *a85_ptr++ = '\n';
183
184 PerlIO_write (fp, a85_buf, a85_ptr - a85_buf);
185 }
186
187 /////////////////////////////////////////////////////////////////////////////
188
189 MODULE = Gtk2::CV PACKAGE = Gtk2::CV
190
191 PROTOTYPES: ENABLE
192
193 # missing function in perl. really :)
194 int
195 common_prefix_length (a, b)
196 unsigned char *a = (unsigned char *)SvPVutf8_nolen ($arg);
197 unsigned char *b = (unsigned char *)SvPVutf8_nolen ($arg);
198 CODE:
199 RETVAL = 0;
200
201 while (*a == *b && *a)
202 {
203 RETVAL += (*a & 0xc0) != 0x80;
204 a++, b++;
205 }
206
207 OUTPUT:
208 RETVAL
209
210 const char *
211 magic (octet_string path)
212 CODE:
213 {
214 static magic_t cookie;
215
216 if (!cookie)
217 {
218 cookie = magic_open (MAGIC_SYMLINK);
219
220 if (cookie)
221 magic_load (cookie, 0);
222 else
223 XSRETURN_UNDEF;
224 }
225
226 RETVAL = magic_file (cookie, path);
227 }
228 OUTPUT:
229 RETVAL
230
231 const char *
232 magic_mime (octet_string path)
233 CODE:
234 {
235 static magic_t cookie;
236
237 if (!cookie)
238 {
239 cookie = magic_open (MAGIC_MIME | MAGIC_SYMLINK);
240
241 if (cookie)
242 magic_load (cookie, 0);
243 else
244 XSRETURN_UNDEF;
245 }
246
247 RETVAL = magic_file (cookie, path);
248 }
249 OUTPUT:
250 RETVAL
251
252 # missing/broken in Gtk2 perl module
253
254 void
255 gdk_window_clear_hints (GdkWindow *window)
256 CODE:
257 gdk_window_set_geometry_hints (window, 0, 0);
258
259 gboolean
260 gdk_net_wm_supports (GdkAtom property)
261 CODE:
262 #if defined(GDK_WINDOWING_X11) && !defined(GDK_MULTIHEAD_SAFE)
263 RETVAL = gdk_net_wm_supports (property);
264 #else
265 RETVAL = 0;
266 #endif
267 OUTPUT:
268 RETVAL
269
270 GdkPixbuf_noinc *
271 dealpha_expose (GdkPixbuf *pb)
272 CODE:
273 {
274 int w = gdk_pixbuf_get_width (pb);
275 int h = gdk_pixbuf_get_height (pb);
276 int bpp = gdk_pixbuf_get_n_channels (pb);
277 int x, y, i;
278 guchar *src = gdk_pixbuf_get_pixels (pb), *dst;
279 int sstr = gdk_pixbuf_get_rowstride (pb), dstr;
280
281 RETVAL = gdk_pixbuf_new (GDK_COLORSPACE_RGB, 0, 8, w, h);
282
283 dst = gdk_pixbuf_get_pixels (RETVAL);
284 dstr = gdk_pixbuf_get_rowstride (RETVAL);
285
286 for (x = 0; x < w; x++)
287 for (y = 0; y < h; y++)
288 for (i = 0; i < 3; i++)
289 dst[x * 3 + y * dstr + i] = src[x * bpp + y * sstr + i];
290 }
291 OUTPUT:
292 RETVAL
293
294 GdkPixbuf_noinc *
295 rotate (GdkPixbuf *pb, int angle)
296 CODE:
297 if (angle < 0)
298 angle += 360;
299 RETVAL = gdk_pixbuf_rotate_simple (pb, angle == 0 ? GDK_PIXBUF_ROTATE_NONE
300 : angle == 90 ? GDK_PIXBUF_ROTATE_COUNTERCLOCKWISE
301 : angle == 180 ? GDK_PIXBUF_ROTATE_UPSIDEDOWN
302 : angle == 270 ? GDK_PIXBUF_ROTATE_CLOCKWISE
303 : angle);
304 OUTPUT:
305 RETVAL
306
307 GdkPixbuf_noinc *
308 load_jpeg (SV *path, int thumbnail=0)
309 CODE:
310 {
311 struct jpeg_decompress_struct cinfo;
312 struct jpg_err_mgr jerr;
313 guchar *data;
314 int rs;
315 FILE *fp;
316 volatile GdkPixbuf *pb = 0;
317
318 RETVAL = 0;
319
320 fp = fopen (SvPVbyte_nolen (path), "rb");
321
322 if (!fp)
323 XSRETURN_UNDEF;
324
325 cinfo.err = jpeg_std_error (&jerr.err);
326
327 jerr.err.error_exit = cv_error_exit;
328 jerr.err.output_message = cv_error_output;
329
330 if ((rs = setjmp (jerr.setjmp_buffer)))
331 {
332 fclose (fp);
333 jpeg_destroy_decompress (&cinfo);
334
335 if (pb)
336 g_object_unref ((gpointer)pb);
337
338 XSRETURN_UNDEF;
339 }
340
341 jpeg_create_decompress (&cinfo);
342
343 jpeg_stdio_src (&cinfo, fp);
344 jpeg_read_header (&cinfo, TRUE);
345
346 cinfo.dct_method = JDCT_DEFAULT;
347 cinfo.do_fancy_upsampling = FALSE; /* worse quality, but nobody compained so far, and gdk-pixbuf does the same */
348 cinfo.do_block_smoothing = FALSE;
349 cinfo.out_color_space = JCS_RGB;
350 cinfo.quantize_colors = FALSE;
351
352 cinfo.scale_num = 1;
353 cinfo.scale_denom = 1;
354
355 jpeg_calc_output_dimensions (&cinfo);
356
357 if (thumbnail)
358 {
359 cinfo.dct_method = JDCT_FASTEST;
360 cinfo.do_fancy_upsampling = FALSE;
361
362 while (cinfo.scale_denom < 8
363 && cinfo.output_width >= IW*4
364 && cinfo.output_height >= IH*4)
365 {
366 cinfo.scale_denom <<= 1;
367 jpeg_calc_output_dimensions (&cinfo);
368 }
369 }
370
371 pb = RETVAL = gdk_pixbuf_new (GDK_COLORSPACE_RGB, 0, 8, cinfo.output_width, cinfo.output_height);
372 if (!RETVAL)
373 longjmp (jerr.setjmp_buffer, 2);
374
375 data = gdk_pixbuf_get_pixels (RETVAL);
376 rs = gdk_pixbuf_get_rowstride (RETVAL);
377
378 if (cinfo.output_components != 3)
379 longjmp (jerr.setjmp_buffer, 3);
380
381 jpeg_start_decompress (&cinfo);
382
383 while (cinfo.output_scanline < cinfo.output_height)
384 {
385 int remaining = cinfo.output_height - cinfo.output_scanline;
386 JSAMPROW rp[4];
387
388 rp [0] = data + cinfo.output_scanline * rs;
389 rp [1] = (guchar *)rp [0] + rs;
390 rp [2] = (guchar *)rp [1] + rs;
391 rp [3] = (guchar *)rp [2] + rs;
392
393 jpeg_read_scanlines (&cinfo, rp, remaining < 4 ? remaining : 4);
394 }
395
396 jpeg_finish_decompress (&cinfo);
397 fclose (fp);
398 jpeg_destroy_decompress (&cinfo);
399 }
400 OUTPUT:
401 RETVAL
402
403 void
404 compare (GdkPixbuf *a, GdkPixbuf *b)
405 PPCODE:
406 {
407 int w = gdk_pixbuf_get_width (a);
408 int h = gdk_pixbuf_get_height (a);
409
410 int sa = gdk_pixbuf_get_rowstride (a);
411 int sb = gdk_pixbuf_get_rowstride (b);
412
413 guchar *pa = gdk_pixbuf_get_pixels (a);
414 guchar *pb = gdk_pixbuf_get_pixels (b);
415
416 int x, y;
417
418 assert (w == gdk_pixbuf_get_width (b));
419 assert (h == gdk_pixbuf_get_height (b));
420
421 assert (gdk_pixbuf_get_n_channels (a) == 3);
422 assert (gdk_pixbuf_get_n_channels (b) == 3);
423
424 double diff = 0.;
425 int peak = 0;
426
427 if (w && h)
428 for (y = 0; y < h; y++)
429 {
430 guchar *pa_ = pa + y * sa;
431 guchar *pb_ = pb + y * sb;
432
433 for (x = 0; x < w; x++)
434 {
435 int d;
436
437 d = ((int)*pa_++) - ((int)*pb_++); diff += d*d; peak = MAX (peak, abs (d));
438 d = ((int)*pa_++) - ((int)*pb_++); diff += d*d; peak = MAX (peak, abs (d));
439 d = ((int)*pa_++) - ((int)*pb_++); diff += d*d; peak = MAX (peak, abs (d));
440 }
441 }
442
443 EXTEND (SP, 2);
444 PUSHs (sv_2mortal (newSVnv (sqrt (diff / (w * h * 3. * 255. * 255.)))));
445 PUSHs (sv_2mortal (newSVnv (peak / 255.)));
446 }
447
448 #############################################################################
449
450 MODULE = Gtk2::CV PACKAGE = Gtk2::CV::Schnauzer
451
452 # currently only works for filenames (octet strings)
453
454 SV *
455 foldcase (SV *pathsv)
456 PROTOTYPE: $
457 CODE:
458 {
459 STRLEN plen;
460 U8 *path = (U8 *)SvPV (pathsv, plen);
461 U8 *pend = path + plen;
462 U8 dst [plen * 6 * 3], *dstp = dst;
463
464 while (path < pend)
465 {
466 U8 ch = *path;
467
468 if (ch >= 'a' && ch <= 'z')
469 *dstp++ = *path++;
470 else if (ch >= 'A' && ch <= 'Z')
471 *dstp++ = *path++ + ('a' - 'A');
472 else if (ch >= '0' && ch <= '9')
473 {
474 STRLEN el, nl = 0;
475 while (*path >= '0' && *path <= '9' && path < pend)
476 path++, nl++;
477
478 for (el = nl; el < 6; el++)
479 *dstp++ = '0';
480
481 memcpy (dstp, path - nl, nl);
482 dstp += nl;
483 }
484 else
485 *dstp++ = *path++;
486 #if 0
487 else
488 {
489 STRLEN cl;
490 to_utf8_fold (path, dstp, &cl);
491 dstp += cl;
492 path += is_utf8_char (path);
493 }
494 #endif
495 }
496
497 RETVAL = newSVpvn ((const char *)dst, dstp - dst);
498 }
499 OUTPUT:
500 RETVAL
501
502 GdkPixbuf_noinc *
503 p7_to_pb (int w, int h, SV *src_sv)
504 PROTOTYPE: @
505 CODE:
506 {
507 int x, y;
508 guchar *dst, *d;
509 int dstr;
510 guchar *src = (guchar *)SvPVbyte_nolen (src_sv);
511
512 RETVAL = gdk_pixbuf_new (GDK_COLORSPACE_RGB, 0, 8, w, h);
513 dst = gdk_pixbuf_get_pixels (RETVAL);
514 dstr = gdk_pixbuf_get_rowstride (RETVAL);
515
516 for (y = 0; y < h; y++)
517 for (d = dst + y * dstr, x = 0; x < w; x++)
518 {
519 *d++ = (((*src >> 5) & 7) * 255 + 4) / 7;
520 *d++ = (((*src >> 2) & 7) * 255 + 4) / 7;
521 *d++ = (((*src >> 0) & 3) * 255 + 2) / 3;
522
523 src++;
524 }
525 }
526 OUTPUT:
527 RETVAL
528
529 #############################################################################
530
531 MODULE = Gtk2::CV PACKAGE = Gtk2::CV::PostScript
532
533 void
534 dump_ascii85 (PerlIO *fp, GdkPixbuf *pb)
535 CODE:
536 {
537 int w = gdk_pixbuf_get_width (pb);
538 int h = gdk_pixbuf_get_height (pb);
539 int x, y, i;
540 guchar *dst;
541 int bpp = gdk_pixbuf_get_n_channels (pb);
542 guchar *src = gdk_pixbuf_get_pixels (pb);
543 int sstr = gdk_pixbuf_get_rowstride (pb);
544
545 a85_init ();
546
547 for (y = 0; y < h; y++)
548 for (x = 0; x < w; x++)
549 for (i = 0; i < (bpp < 3 ? 1 : 3); i++)
550 a85_push (fp, src [x * bpp + y * sstr + i]);
551
552 a85_finish (fp);
553 }
554
555 void
556 dump_binary (PerlIO *fp, GdkPixbuf *pb)
557 CODE:
558 {
559 int w = gdk_pixbuf_get_width (pb);
560 int h = gdk_pixbuf_get_height (pb);
561 int x, y, i;
562 guchar *dst;
563 int bpp = gdk_pixbuf_get_n_channels (pb);
564 guchar *src = gdk_pixbuf_get_pixels (pb);
565 int sstr = gdk_pixbuf_get_rowstride (pb);
566
567 for (y = 0; y < h; y++)
568 for (x = 0; x < w; x++)
569 for (i = 0; i < (bpp < 3 ? 1 : 3); i++)
570 PerlIO_putc (fp, src [x * bpp + y * sstr + i]);
571 }
572
573 #############################################################################
574
575 MODULE = Gtk2::CV PACKAGE = Gtk2::CV
576
577 SV *
578 pb_to_hv84 (GdkPixbuf *pb)
579 CODE:
580 {
581 int w = gdk_pixbuf_get_width (pb);
582 int h = gdk_pixbuf_get_height (pb);
583 int x, y;
584 guchar *dst;
585 int bpp = gdk_pixbuf_get_n_channels (pb);
586 guchar *src = gdk_pixbuf_get_pixels (pb);
587 int sstr = gdk_pixbuf_get_rowstride (pb);
588
589 RETVAL = newSV (6 * 8 * 12 / 8);
590 SvPOK_only (RETVAL);
591 SvCUR_set (RETVAL, 6 * 8 * 12 / 8);
592
593 dst = (guchar *)SvPVX (RETVAL);
594
595 /* some primitive error distribution + random dithering */
596
597 for (y = 0; y < h; y++)
598 {
599 guchar *p = src + y * sstr;
600
601 for (x = 0; x < w; x += 2)
602 {
603 unsigned int r, g, b, h, s, v, H, V1, V2;
604
605 if (bpp == 3)
606 r = *p++, g = *p++, b = *p++;
607 else if (bpp == 1)
608 r = g = b = *p++;
609 else
610 abort ();
611
612 rgb_to_hsv (r, g, b, &h, &s, &v);
613
614 H = (h * 15 / 255) << 4;
615 V1 = v;
616
617 if (bpp == 3)
618 r = *p++, g = *p++, b = *p++;
619 else if (bpp == 1)
620 r = g = b = *p++;
621 else
622 abort ();
623
624 rgb_to_hsv (r, g, b, &h, &s, &v);
625
626 H |= h * 15 / 255;
627 V2 = v;
628
629 *dst++ = H;
630 *dst++ = V1;
631 *dst++ = V2;
632 }
633 }
634 }
635 OUTPUT:
636 RETVAL
637
638 SV *
639 hv84_to_av (unsigned char *hv84)
640 CODE:
641 {
642 int i = 72 / 3;
643 AV *av = newAV ();
644
645 RETVAL = (SV *)newRV_noinc ((SV *)av);
646 while (i--)
647 {
648 int h = *hv84++;
649 int v1 = *hv84++;
650 int v2 = *hv84++;
651
652 av_push (av, newSViv (v1));
653 av_push (av, newSViv ((h >> 4) * 255 / 15));
654 av_push (av, newSViv (v2));
655 av_push (av, newSViv ((h & 15) * 255 / 15));
656 }
657 }
658 OUTPUT:
659 RETVAL
660
661 #############################################################################
662
663 MODULE = Gtk2::CV PACKAGE = Gtk2::CV::Plugin::RCluster
664
665 SV *
666 extract_features (SV *ar)
667 CODE:
668 {
669 int i;
670 AV *av, *result;
671
672 if (!SvROK (ar) || SvTYPE (SvRV (ar)) != SVt_PVAV)
673 croak ("Not an array ref as first argument to extract_features");
674
675 av = (AV *) SvRV (ar);
676 result = newAV ();
677
678 for (i = 0; i <= av_len (av); ++i)
679 {
680 SV *sv = *av_fetch (av, i, 1);
681 SV *histsv = newSV (9 * sizeof (float) + 1);
682
683 SvPOK_on (histsv);
684 SvCUR_set (histsv, 9 * sizeof (float));
685 float *hist = (float *)SvPVX (histsv);
686
687 struct feature f_h, f_s, f_v;
688 feature_init (&f_h);
689 feature_init (&f_s);
690 feature_init (&f_v);
691
692 {
693 STRLEN len;
694 unsigned char *buf = (unsigned char *)SvPVbyte (sv, len);
695 while (len >= 3)
696 {
697 unsigned int r, g, b, h, s, v;
698 r = *buf++; g = *buf++; b = *buf++;
699 rgb_to_hsv (r, g, b, &h, &s, &v);
700
701 feature_update_pass_1 (&f_h, h);
702 feature_update_pass_1 (&f_s, s);
703 feature_update_pass_1 (&f_v, v);
704
705 len -= 3;
706 }
707
708 feature_finish_pass_1 (&f_h);
709 feature_finish_pass_1 (&f_s);
710 feature_finish_pass_1 (&f_v);
711 }
712
713 {
714 STRLEN len;
715 unsigned char *buf = (unsigned char *)SvPVbyte (sv, len);
716 while (len >= 3)
717 {
718 unsigned int r, g, b, h, s, v;
719 r = *buf++; g = *buf++; b = *buf++;
720 rgb_to_hsv (r, g, b, &h, &s, &v);
721
722 feature_update_pass_2 (&f_h, h);
723 feature_update_pass_2 (&f_s, s);
724 feature_update_pass_2 (&f_v, v);
725
726 len -= 3;
727 }
728
729 feature_finish_pass_2 (&f_h);
730 feature_finish_pass_2 (&f_s);
731 feature_finish_pass_2 (&f_v);
732 }
733
734 hist [0] = f_h.v1 * 2.; hist [1] = f_h.v2 * 2.; hist [2] = f_h.v3 * 2.;
735 hist [3] = f_s.v1 ; hist [4] = f_s.v2 ; hist [5] = f_s.v3 ;
736 hist [6] = f_v.v1 * .5; hist [7] = f_v.v2 * .5; hist [8] = f_v.v3 * .5;
737
738 av_push (result, histsv);
739 }
740
741 RETVAL = newRV_noinc ((SV *)result);
742 }
743 OUTPUT:
744 RETVAL
745