/[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

Annotation of /m/menu.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations)
Mon Nov 5 10:47:10 2001 UTC (22 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.6: +2 -1 lines
File MIME type: text/plain
removed gifs

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

  ViewVC Help
Powered by ViewVC 1.1.26