/[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.2 - (hide annotations)
Thu Jun 28 18:44:38 2001 UTC (22 years, 9 months ago) by dpavlin
Branch: MAIN
Changes since 1.1: +18 -20 lines
File MIME type: text/plain
menu

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 ravilov 1.1
11     sub dump_gif {
12     my ($text, $type, $file) = @_;
13     $type ||= TYPE_NONE;
14     $file ||= $text;
15     $file =~ s/[^a-zA-Z0-9\-]/_/g;
16     print "$text" unless ($file eq "-");
17     my $image = Image::Magick->new;
18     $image->Set('size' => '125x13');
19     $image->Read('xc:#283880');
20     if ($type == TYPE_BULLET) {
21 dpavlin 1.2 $image->Annotate('text' => $text, 'geometry' => '+17+10',
22 ravilov 1.1 'font' => "\@arialbd.ttf", 'pointsize' => 11,
23 dpavlin 1.2 'fill' => '#ffffff', 'align' => 'left');
24     # $image->Annotate('text' => $text, 'geometry' => '+17+1',
25     # 'font' => "\@arialbd.ttf", 'pointsize' => 11,
26     # 'pen' => '#FFFFFF', 'align' => 'left');
27     # $image->Blur('radius' => 0.1);
28 ravilov 1.1 $image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
29     'fill' => '#00D000', 'antialias' => 1, 'points' =>
30     '7,4 10,7');
31     } else {
32 dpavlin 1.2 $image->Annotate('text' => $text, 'geometry' => '+3+10',
33 ravilov 1.1 'font' => "\@arialbd.ttf", 'pointsize' => 11,
34 dpavlin 1.2 'fill' => '#FFFFFF', 'align' => 'left');
35     # $image->Blur('radius' => 1);
36 ravilov 1.1 if ($type == TYPE_LINE) {
37     $image->Draw('primitive' => 'line',
38     'stroke' => '#00FF00', 'fill' => '#00FF00',
39     'antialias' => 1, 'points' => '1,11 63,11');
40     my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
41     my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
42     my $range = 125 - 64;
43     for (my $i = 0; $i < $range; $i++) {
44     my $j = $i + 64;
45     my $color = sprintf("#%02X%02X%02X",
46     $br + (($er - $br) / $range) * $i,
47     $bg + (($eg - $bg) / $range) * $i,
48     $bb + (($eb - $bb) / $range) * $i
49     );
50     $image->Draw('primitive' => 'point',
51     'stroke' => $color,
52     'antialias' => 1,
53     'points' => "$j,11");
54     }
55     }
56     }
57     # $image->Resize('geometry' => '125x15',
58     # 'filter' => 'Lanczos', 'blur' => '1.8');
59     #$image->Scale('geometry' => '50%');
60     # $image->Draw('stroke' => '#CCCCCC', 'primitive' => 'line',
61     # 'points' => '0,14 118,14', 'linewidth' => 1);
62     # $image->Draw('stroke' => '#cccccc', 'primitive' => 'line',
63     # 'points' => '118,14 118,7', 'linewidth' => 2);
64     print " -> " unless ($file eq "-");
65     $file .= ".gif" unless ($file eq "-");
66     $image->Write('filename' => "gif:$file", 'colors' => 256,
67     'interlace' => "none", 'compress' => 'lzw');
68     print "$file\n" unless ($file eq "-");
69     return "$file";
70     }
71    
72 dpavlin 1.2 #print "Content-Type: image/gif\n\n";
73     #dump_gif("NOVOSTI", TYPE_LINE, "-");
74     #exit $?;
75 ravilov 1.1
76 dpavlin 1.2 my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "", "") ||
77 ravilov 1.1 die $DBI::errstr;
78 dpavlin 1.2 my $sth = $dbh->prepare("SELECT section,item,url,level FROM menu") ||
79 ravilov 1.1 die $dbh->errstr();
80     $sth->execute() || die $sth->errstr();
81     while (my @arr = $sth->fetchrow_array()) {
82 dpavlin 1.2 $dbh->do("UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."' WHERE item='$arr[1]'");
83 ravilov 1.1 }
84     $sth->finish;
85     $dbh->disconnect;
86     exit $?;

  ViewVC Help
Powered by ViewVC 1.1.26