/[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.9 - (show annotations)
Wed Nov 7 15:02:56 2001 UTC (22 years, 4 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.8: +6 -4 lines
File MIME type: text/plain
font change

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

  ViewVC Help
Powered by ViewVC 1.1.26