Mercurial > hg > forks > geeqie

annotate scripts/decode_sim @ 2916:ae6cdcd69d9f default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with upstream/master.
author Matti Hamalainen <ccr@tnsp.org>
date Tue, 14 May 2019 11:46:50 +0300
parents 1537bf3a3c56
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
1 #! /usr/bin/perl
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
2 #
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
3
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
4 use strict;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
5 use warnings;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
6
2332
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
7 use GD;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
8
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
9 my $file = shift or die;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
10
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
11 open my $in_fh, '<', $file or die;
2332
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
12 binmode $in_fh;
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
13 my $type = <$in_fh>;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
14 chomp $type;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
15
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
16 die unless $type eq 'SIMcache';
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
17
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
18 while (<$in_fh>)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
19 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
20 my $raw = $_;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
21 chomp;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
22 if (/^#(.*)/)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
23 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
24 printf "Comment: %s\n", $1;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
25 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
26 elsif (/^Dimensions=\[(\d+) x (\d+)\]$/)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
27 {
2782
1537bf3a3c56 Change character code in decode_sim
Colin Clark <colin.clark@cclark.uk>
parents: 2332
diff changeset
28 printf "Original image dimensions: %dx%d\n", $1, $2;
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
29 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
30 elsif (/^Date=(.*)/)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
31 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
32 printf "Date (used for pan-view): %s\n", $1;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
33 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
34 elsif (/^Checksum=(.*)/)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
35 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
36 printf "Checksum (never seen): %s\n", $1;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
37 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
38 elsif (/^MD5sum=\[(.*)\]$/)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
39 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
40 printf "MD5 sum: %s\n", $1;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
41 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
42 elsif ($raw =~ /^SimilarityGrid\[(\d+) x (\d+)\]=(.*)$/s)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
43 {
2782
1537bf3a3c56 Change character code in decode_sim
Colin Clark <colin.clark@cclark.uk>
parents: 2332
diff changeset
44 printf "Similarity image %dx%d\n", $1, $2;
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
45 if ($1 != 32 or $2 != 32)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
46 {
2782
1537bf3a3c56 Change character code in decode_sim
Colin Clark <colin.clark@cclark.uk>
parents: 2332
diff changeset
47 print "Warning, similarity data are not size 32x32!\n";
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
48 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
49
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
50 my $simn = $1 * $2 * 3;
2332
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
51 my ($width, $height) = ($1, $2);
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
52 my $simdata = $3;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
53
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
54 $simdata = substr($simdata, 0, -1) if length($simdata) == $simn + 1; # In case all fits to one line
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
55
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
56 if (length($simdata) < $simn)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
57 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
58 read $in_fh, $simdata, $simn - length($simdata), length($simdata) or die;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
59 my $dummy;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
60 read $in_fh, $dummy, 1 or die;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
61 }
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
62
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
63 printf "Warning, similarity data is not %d bytes", $simn unless length($simdata) == $simn;
2332
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
64
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
65 if (length($simdata) == $simn)
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
66 {
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
67 my $gd = GD::Image->new($width, $height, 1);
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
68
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
69 for (my $x = 0; $x < $width; $x++)
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
70 {
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
71 for (my $y = 0; $y < $height; $y++)
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
72 {
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
73 my $colors = substr($simdata, ($x + $y * $width) * 3, 3);
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
74 my @rgb = unpack("CCC", $colors);
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
75 my $index = $gd->colorAllocate(@rgb);
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
76 $gd->setPixel($x, $y, $index);
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
77 }
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
78 } ## end for (my $x = 0; $x < $width; $...
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
79
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
80 my $png = $gd->png;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
81 open my $display_fh, '|-', qw(display -resize), sprintf("%dx%d", $width*10, $height*10), '-' or die;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
82 binmode $display_fh;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
83 print {$display_fh} $png;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
84 close $display_fh;
2873b4dbb77a Display the similarity image
Klaus Ethgen <Klaus@Ethgen.de>
parents: 2330
diff changeset
85 } ## end if (length($simdata) == $simn)
2330
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
86 } ## end elsif (/^SimilarityGrid\[(\d+)...
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
87 else
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
88 {
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
89 my $field = $_;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
90 $field = $1 if /^(.*)=/;
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
91
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
92 printf "Unknown Field '$field'\n";
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
93 } ## end elsif (/^SimilarityGrid\[(\d+)...
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
94 } ## end while (<$in_fh>)
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
95
9b2073c5f6cc Simple script to decode similarity data
Klaus Ethgen <Klaus@Ethgen.de>
parents:
diff changeset
96 close $in_fh;