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