Browse Source

added jpegrescan (under public domain)

pull/2/head
asiekierka 6 years ago
parent
commit
42488e05cc
1 changed files with 135 additions and 0 deletions
  1. 135
    0
      tools/jpegrescan

+ 135
- 0
tools/jpegrescan View File

@@ -0,0 +1,135 @@
1
+#!/usr/bin/perl -ws
2
+# jpegrescan by Loren Merritt
3
+# Last updated: 2008-11-29
4
+# This code is public domain.
5
+
6
+use File::Slurp;
7
+@ARGV==2 or die "usage: jpegrescan in.jpg out.jpg\ntries various progressive scan orders\n";
8
+$fin = $ARGV[0];
9
+$fout = $ARGV[1];
10
+$ftmp = "/tmp/$$.scan";
11
+$jtmp = "/tmp/$$.jpg";
12
+$verbose = $v;
13
+$quiet = $q;
14
+@restart = $r ? ("-restart", 1) : ();
15
+undef $_ for $v,$q,$r;
16
+undef $/;
17
+$|=1;
18
+
19
+# convert the input to baseline, just to make all the other conversions faster
20
+# FIXME there's still a bunch of redundant computation in separate calls to jpegtran
21
+open $OLDERR, ">&", STDERR;
22
+open STDERR, ">", $ftmp;
23
+open TRAN, "-|", "jpegtran", "-v", "-optimize", $fin or die;
24
+write_file($jtmp, <TRAN>);
25
+close TRAN;
26
+open STDERR, ">&", $OLDERR;
27
+
28
+$type = read_file($ftmp);
29
+$type =~ /components=(\d+)/ or die;
30
+$rgb = $1==3 ? 1 : $1==1 ? 0 : die "not RGB nor gray\n";
31
+
32
+# FIXME optimize order for either progressive transfer or decoding speed
33
+sub canonize {
34
+    my $txt = $prefix.$suffix.shift;
35
+    $txt =~ s/\s*;\s*/;\n/g;
36
+    $txt =~ s/^\s*//;
37
+    $txt =~ s/ +/ /g;
38
+    $txt =~ s/: (\d+) (\d+)/sprintf ": %2d %2d", $1, $2/ge;
39
+    # treat u and v identically. I shouldn't need to do this, but with jpegtran overhead it saves 9% speed. cost: .008% bitrate.
40
+    $txt =~ s/^2:.*\n//gm;
41
+    $txt =~ s/^1:(.+)\n/1:$1\n2:$1\n/gm;
42
+    # dc before ac, coarse before fine
43
+    my @txt = sort {"$a\n$b" =~ /: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/ or die; !$3 <=> !$1 or $4 <=> $2 or $a cmp $b;} split /\n/, $txt;
44
+    return join "\n", @txt;
45
+}
46
+
47
+sub try {
48
+    my $txt = canonize(shift);
49
+    return $memo{$txt} if $memo{$txt};
50
+    write_file($ftmp, $txt);
51
+    open TRAN, "-|", "jpegtran", "-scans", $ftmp, @restart, $jtmp or die;
52
+    $data = <TRAN>;
53
+    close TRAN;
54
+    my $s = length $data;
55
+    $s or die;
56
+    $memo{$txt} = $s;
57
+    !$quiet && print $verbose ? "$txt\n$s\n\n" : ".";
58
+    return $s;
59
+}
60
+
61
+sub triesn {
62
+    my($bmode, $bsize);
63
+    my ($limit, @modes) = @_;
64
+    my $overshoot = 0;
65
+    for(@modes) {
66
+        my $s = try($_);
67
+        if(!$bsize || $s < $bsize) {
68
+            $bsize = $s;
69
+            $bmode = $_;
70
+            $overshoot = 0;
71
+        } elsif(++$overshoot >= $limit) {
72
+            last;
73
+        }
74
+    }
75
+    return $bmode;
76
+}
77
+
78
+sub tries { triesn(99, @_); }
79
+
80
+$prefix = "";
81
+$suffix = "";
82
+
83
+if($rgb) {
84
+    # 012 helps very little
85
+    # 0/12 and 0/1/2 are pretty evenly matched in frequency, but 0/12 wins in total size if every image had to use the same mode
86
+    # dc refinement passes never help
87
+    $dc = tries("0: 0 0 0 0; 1 2: 0 0 0 0;",
88
+                "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
89
+    # jpegtran won't let me omit dc entirely, but I can at least quantize it away to make the rest of the tests faster.
90
+    $prefix = "0 1 2: 0 0 0 9;";
91
+} else {
92
+    $dc = "0: 0 0 0 0;";
93
+    $prefix = "0: 0 0 0 9;";
94
+}
95
+
96
+# luma can make use of up to 3 refinement passes.
97
+# chroma can make use of up to 2 refinement passes.
98
+# refinement passes have some chance of being split (luma: 4%,4%,4%. chroma: 20%,8%) but the total bit gain is negligible.
99
+# msb pass should almost always be split (luma: 87%, chroma: 81%).
100
+# I have no theoretical reason for this list of split positions, they're just the most common in practice.
101
+# splitting into 3 ections is often slightly better, but the total number of bits saved is negligible.
102
+# FIXME: penalize lots of refinement passes because it's slower to decode. if so, then also force overwrite if bigger than the input.
103
+sub try_splits {
104
+    my $str = shift;
105
+    my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;
106
+    my $mode = triesn(2, "$c: 1 63 $str;", @n{2,8,5});
107
+    return $mode if $mode ne $n{8};
108
+    return triesn(1, $mode, @n{12,18});
109
+}
110
+
111
+foreach $c (0..$rgb) {
112
+    my @modes;
113
+    my $ml = "";
114
+    for(0..($c?2:3)) {
115
+        push @modes, "$c: 1 8 0 $_; $c: 9 63 0 $_;".$ml;
116
+        $ml .= sprintf("$c: 1 63 %d %d;", $_+1, $_);
117
+    }
118
+    my $refine = triesn(1, @modes);
119
+    $refine =~ s/.* (0 \d);//;
120
+    $ac .= $refine . try_splits($1);
121
+}
122
+
123
+$prefix = "";
124
+undef %memo;
125
+$mode = canonize($dc.$ac);
126
+try($mode);
127
+$size = $memo{$mode};
128
+!$quiet && print "\n$mode\n$size\n";
129
+$old_size = -s $fin;
130
+!$quiet && printf "%+.2f%%\n", ($size/$old_size-1)*100;
131
+if($size > $old_size && !@restart) {
132
+    $data = read_file($fin);
133
+}
134
+write_file($fout, $data);
135
+unlink $ftmp, $jtmp;

Loading…
Cancel
Save