/[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.6 - (show annotations)
Wed Oct 10 12:00:18 2001 UTC (22 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.5: +28 -0 lines
File MIME type: text/plain
svata...

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 %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 sub dump_gif {
36 my ($text, $type, $file) = @_;
37 $type ||= TYPE_NONE;
38 $file ||= $text;
39 $file =~ s/[^a-zA-Z0-9\-]/_/g;
40 $file = lc($file);
41 print "$text" unless ($file eq "-");
42 my $tmp=$text;
43 my $nl=1;
44 $tmp =~ s/\\n/$nl++/gie;
45 $h=$h_base*$nl;
46 my $image = Image::Magick->new;
47 $image->Set('size' => "${w}x${h}");
48 $image->Read('xc:#283880');
49 $text=~tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
50 $text=iso2utf($text);
51 if ($type == TYPE_BULLET) {
52 $image->Annotate('text' => $text, 'geometry' => '+17+10',
53 'font' => "\@arialbd.ttf", 'pointsize' => 11,
54 '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 $image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
60 'fill' => '#00D000', 'antialias' => 1, 'points' =>
61 '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 '7,4 10,7');
69 } else {
70 if ($type == TYPE_LINE) {
71 $image->Draw('primitive' => 'line',
72 'stroke' => '#00FF00', 'fill' => '#00FF00',
73 'antialias' => 1, 'points' => '1,'.($h-2).' 63,'.($h-2));
74 my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
75 my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
76 my $range = $w - 64;
77 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 'fill' => $color,
87 'antialias' => 1,
88 'points' => "$j,".($h-2));
89 }
90 }
91 $image->Annotate('text' => $text, 'geometry' => '+3+10',
92 'font' => "\@arialbd.ttf", 'pointsize' => 11,
93 'fill' => '#FFFFFF', 'align' => 'left');
94 # $image->Blur('radius' => 1);
95 }
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 #print "Content-Type: image/gif\n\n";
105 #dump_gif("NOVOSTI", TYPE_LINE, "-");
106 #exit $?;
107
108 my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "", "") ||
109 die $DBI::errstr;
110 my $sth = $dbh->prepare("SELECT section,item,url,level,num FROM menu") ||
111 die $dbh->errstr();
112 $sth->execute() || die $sth->errstr();
113 while (my @arr = $sth->fetchrow_array()) {
114 my $sql="UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."',w=$w,h=$h WHERE num=$arr[4]";
115 $dbh->do($sql);
116 }
117 $sth->finish;
118 $dbh->disconnect;
119 exit $?;
120

  ViewVC Help
Powered by ViewVC 1.1.26