xref: /trunk/main/solenv/bin/image-sort.pl (revision 953605d5) 
1#!/usr/bin/perl -w
2# *************************************************************
3#
4#  Licensed to the Apache Software Foundation (ASF) under one
5#  or more contributor license agreements.  See the NOTICE file
6#  distributed with this work for additional information
7#  regarding copyright ownership.  The ASF licenses this file
8#  to you under the Apache License, Version 2.0 (the
9#  "License"); you may not use this file except in compliance
10#  with the License.  You may obtain a copy of the License at
11#
12#    http://www.apache.org/licenses/LICENSE-2.0
13#
14#  Unless required by applicable law or agreed to in writing,
15#  software distributed under the License is distributed on an
16#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
17#  KIND, either express or implied.  See the License for the
18#  specific language governing permissions and limitations
19#  under the License.
20#
21# *************************************************************
22
23my @global_list = ();
24my %global_hash = ();
25my $base_path;
26
27sub read_icons($)
28{
29    my $fname = shift;
30    my $fileh;
31    my @images;
32    open ($fileh, "$base_path/$fname") || die "Can't open $base_path/$fname: $!";
33    while (<$fileh>) {
34	m/xlink:href=\"\.uno:(\S+)\"\s+/ || next;
35	push @images, lc($1);
36    }
37    close ($fileh);
38
39    return @images;
40}
41
42# filter out already seen icons & do prefixing
43sub read_new_icons($$)
44{
45    my $fname = shift;
46    my $prefix = shift;
47    my @images = read_icons ($fname);
48    my @new_icons;
49    my %new_icons;
50    for my $icon (@images) {
51	my $iname = "res/commandimagelist/" . $prefix . $icon . ".png";
52	if (!defined $global_hash{$iname} &&
53	    !defined $new_icons{$iname}) {
54	    push @new_icons, $iname;
55	    $new_icons{$iname} = 1;
56	}
57    }
58    return @new_icons;
59}
60
61sub process_group($@)
62{
63    my $prefix = shift;
64    my @uiconfigs = @_;
65    my %group;
66    my $cur_max = 1.0;
67
68# a very noddy sorting algorithm
69    for my $uiconfig (@uiconfigs) {
70	my @images = read_new_icons ($uiconfig, $prefix);
71	my $prev = '';
72	for my $icon (@images) {
73	    if (!defined $group{$icon}) {
74		if (!defined $group{$prev}) {
75		    $group{$icon} = $cur_max;
76		    $cur_max += 1.0;
77		} else {
78		    $group{$icon} = $group{$prev} + (1.0 - 0.5 / $cur_max);
79		}
80	    } # else a duplicate
81	}
82    }
83    for my $icon (sort { $group{$a} <=> $group{$b} } keys %group) {
84	push @global_list, $icon;
85	$global_hash{$icon} = 1;
86    }
87}
88
89sub process_file($$)
90{
91    my @images = read_new_icons (shift, shift);
92
93    for my $icon (@images) {
94	push @global_list, $icon;
95	$global_hash{$icon} = 1;
96    }
97}
98
99sub chew_controlfile($)
100{
101    my $fname = shift;
102    my $fileh;
103    my @list;
104    open ($fileh, $fname) || die "Can't open $fname: $!";
105    while (<$fileh>) {
106	/^\#/ && next;
107	s/[\r\n]*$//;
108	/^\s*$/ && next;
109
110	my $line = $_;
111	if ($line =~ s/^-- (\S+)\s*//) {
112	    # control code
113	    my $code = $1;
114	    my $small = (lc ($line) eq 'small');
115	    if (lc($code) eq 'group') {
116		if (!$small) { process_group ("lc_", @list); }
117		process_group ("sc_", @list);
118	    } elsif (lc ($code) eq 'ordered') {
119		if (!$small) {
120		    for my $file (@list) { process_file ($file, "lc_"); }
121		}
122		for my $file (@list) { process_file ($file, "sc_"); }
123	    } elsif (lc ($code) eq 'literal') {
124		for my $file (@list) {
125		    if (!defined $global_hash{$file}) {
126			push @global_list, $file;
127			$global_hash{$file} = 1;
128		    }
129		}
130	    } else {
131		die ("Unknown code '$code'");
132	    }
133	    @list = ();
134	} else {
135	    push @list, $line;
136	}
137    }
138    close ($fileh);
139}
140
141if (!@ARGV) {
142    print "image-sort <image-sort.lst> /path/to/OOOo/source/root\n";
143    exit 1;
144}
145
146# where the control file lives
147my $control = shift @ARGV;
148# where the uiconfigs live
149$base_path = shift @ARGV;
150# output
151if (@ARGV) {
152    my $outf = shift @ARGV;
153    open ($output, ">$outf") || die "Can't open $outf: $!";
154    $stdout_out = 0;
155} else {
156    $output = STDOUT;
157    $stdout_out = 1;
158}
159
160chew_controlfile ($control);
161
162for my $icon (@global_list) {
163    print $output $icon . "\n" if (!($icon =~ /^sc_/));
164}
165for my $icon (@global_list) {
166    print $output $icon . "\n" if ($icon =~ /^sc_/);
167}
168
169close $output if (!$stdout_out);
170