/[pliva-si]/m/menu.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /m/menu.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Wed Nov 7 12:09:58 2001 UTC (22 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.7: +8 -6 lines
File MIME type: text/plain
mnogo toga

1 #! /usr/local/bin/perl -w
2
3 use strict;
4 use DBI;
5 use Image::Magick;
6
7 use constant TYPE_NONE => scalar 2;
8 use constant TYPE_BULLET => scalar 3;
9 use constant TYPE_LINE => scalar 1;
10 use constant TYPE_BLUEDOT => scalar 4;
11
12 # size of menu image
13 my $w=125;
14 my $h_base=13;
15 my $h;
16
17 my $dir="/data/pliva-si/m";
18
19 my %iso2utf_tab = (
20 '¹' => 0x0161, 'ð' => 0x0111, 'è' => 0x010d, 'æ' => 0x0107, '¾' => 0x017e,
21 '©' => 0x0160, 'Ð' => 0x0110, 'È' => 0x010c, 'Æ' => 0x0106, '®' => 0x017d
22 );
23
24 sub iso2utf {
25 local($_)=@_;
26
27 sub utf8 {
28 local($_)=@_;
29 return $_ < 0x80 ? chr($_) :
30 $_ < 0x800 ? chr($_>>6&0x3F|0xC0) . chr($_&0x3F|0x80) :
31 chr($_>>12&0x0F|0xE0).chr($_>>6&0x3F|0x80).chr($_&0x3F|0x80);
32 }
33 s/([¹ðè澩ÐÈÆ®])/utf8($iso2utf_tab{$1})/ge;
34 return $_;
35 }
36
37 sub dump_gif {
38 my ($text, $type, $file) = @_;
39 $type ||= TYPE_NONE;
40 $file ||= "$text-$type";
41 $file =~ s/[^a-zA-Z0-9\-]/_/g;
42 $file = lc($file);
43 print "$text" unless ($file eq "-");
44 my $tmp=$text;
45 my $nl=1;
46 $tmp =~ s/\\n/$nl++/gie;
47 $h=$h_base*$nl;
48 my $image = Image::Magick->new;
49 $image->Set('size' => "${w}x${h}");
50 $image->Read('xc:#283880');
51 $text=~tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
52 $text=iso2utf($text);
53 if ($type == TYPE_BULLET) {
54 $image->Annotate('text' => $text, 'geometry' => '+17+10',
55 'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
56 'fill' => '#ffffff', 'align' => 'left');
57 # $image->Annotate('text' => $text, 'geometry' => '+17+1',
58 # 'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
59 # 'pen' => '#FFFFFF', 'align' => 'left');
60 # $image->Blur('radius' => 0.1);
61 $image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
62 'fill' => '#00D000', 'antialias' => 1, 'points' =>
63 '7,4 10,7');
64 } elsif ($type == TYPE_BLUEDOT) {
65 $image->Annotate('text' => $text, 'geometry' => '+17+10',
66 'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
67 'fill' => '#ffffff', 'align' => 'left');
68 $image->Draw('primitive' => 'rectangle', 'stroke' => '#00b2dc',
69 'fill' => '#00b2dc', 'antialias' => 1, 'points' =>
70 '7,4 10,7');
71 } else {
72 if ($type == TYPE_LINE) {
73 $image->Draw('primitive' => 'line',
74 'stroke' => '#00FF00', 'fill' => '#00FF00',
75 'antialias' => 1, 'points' => '1,'.($h-2).' 63,'.($h-2));
76 my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
77 my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
78 my $range = $w - 64;
79 for (my $i = 0; $i < $range; $i++) {
80 my $j = $i + 64;
81 my $color = sprintf("#%02X%02X%02X",
82 $br + (($er - $br) / $range) * $i,
83 $bg + (($eg - $bg) / $range) * $i,
84 $bb + (($eb - $bb) / $range) * $i
85 );
86 $image->Draw('primitive' => 'point',
87 'stroke' => $color,
88 'fill' => $color,
89 'antialias' => 1,
90 'points' => "$j,".($h-2));
91 }
92 }
93 $image->Annotate('text' => $text, 'geometry' => '+3+10',
94 'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
95 'fill' => '#FFFFFF', 'align' => 'left');
96 # $image->Blur('radius' => 1);
97 }
98 print " -> " unless ($file eq "-");
99 $file .= ".gif" unless ($file eq "-");
100 $image->Write('filename' => "gif:$dir/$file", 'colors' => 256,
101 'interlace' => "none", 'compress' => 'lzw');
102 print "$file\n" unless ($file eq "-");
103 return "$file";
104 }
105
106 #print "Content-Type: image/gif\n\n";
107 #dump_gif("NOVOSTI", TYPE_LINE, "-");
108 #exit $?;
109
110 #
111 my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "dpavlin", "") ||
112 die $DBI::errstr;
113 my $sth = $dbh->prepare("SELECT section,item,url,level,num FROM menu") ||
114 die $dbh->errstr();
115 $sth->execute() || die $sth->errstr();
116 while (my @arr = $sth->fetchrow_array()) {
117 my $sql="UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."',w=$w,h=$h WHERE num=$arr[4]";
118 $dbh->do($sql);
119 }
120 $sth->finish;
121 $dbh->disconnect;
122 exit $?;
123

  ViewVC Help
Powered by ViewVC 1.1.26