Thread Tk bind und Buttongröße (12 answers)
Opened by DerHenning at 2008-10-12 01:00

topeg
 2008-10-22 01:22
#115685 #115685
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Das hatte ich mal als Test geschrieben.
Es generiert so was wie einen Farbkreis.
Die Ausgabe ist eine PPM-Datei, in der alles Freundlicherweise In ASCII beschrieben ist.
Vorsicht bei Bildern mit mehr als 10 Bit pro Farbe.
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#!/usr/bin/perl
use strict;
use warnings;

# PPM Header
my $header=<<'EOH';
P3
%s %s
%s
EOH


my $depth=int(shift(@ARGV) || 8);
die "Farbtiefe > 1 angeben\n" unless($depth > 1);
die "Farbtiefe < 16 angeben\n" if($depth > 16);

my $maxval=(2**$depth)-1;
my ($data,$height,$width,undef)=create_colors($depth);
printf($header,$width,$height,$maxval);

while(@$data)
{
 for my $c (1..($width*3))
 {
  print shift(@$data)." ";
 }
 print "\n";
}

#################################
# Farbkreis erzeugen
#################################

# braucht:
#   Farbtiefe
# liefert:
#   die Liste der Werte
#   Hoehe
#   Breite
#   Farbtiefe
sub create_colors
{
 my @data=();
 my $depth=shift || 8;
 my $color=(2**$depth)-1;
 my $w=$color*2;
 my $h=$color*2;
 my $mx=int($w/2);
 my $my=int($h/2);
 $mx-=($mx/10);
 my $radi=int($color/2);
 for my $x (0..($w-1))
 {
  for my $y (0..($h-1))
  {
   my $diff=diff($x,$y,$mx,$my);
   my $wi=winkel($x,$y,$mx,$my,$color);
   my $hell=$diff*($color/$radi);
   my $r=int($hell-abs($wi));
   my $g=int($hell-abs(rotate($wi,($color/3)*2,$color)));
   my $b=int($hell-abs(rotate($wi,-($color/3)*2,$color)));
   $r=0 if($r<0);
   $g=0 if($g<0);
   $b=0 if($b<0);
   $r=$color if($r>$color);
   $g=$color if($g>$color);
   $b=$color if($b>$color);
   push(@data,$r,$g,$b);
  }
 }
 return(\@data,$h,$w,$depth);
}

# Farbtiefe
# liefert:
#  die Liste der Werte binär.
#  Hoehe
#  Breite
#  Farbtiefe
sub create_colors_bin
{
  my @l = create_colors(@_);
  my $d=$l[-1];
  $d = $d==4?'S*':$d==8?'C*':$d==16?'L*':'';
  return(pack($d,@{shift(@l)}), @l);
}

sub rotate
{
 my ($winkel,$wert,$c)=@_;
 my $w2=$winkel+$wert;
 $w2=-$c+($w2-$c) if($w2>=$c);
 $w2=$c+($w2+$c) if($w2<=-$c);
 return $w2;
}

sub diff
{
 my ($xa,$ya,$xb,$yb)=@_;
 my $dx=abs($xb-$xa);
 my $dy=abs($yb-$ya);
 return sqrt($dx**2+$dy**2);
}

sub winkel
{
 my ($xa,$ya,$xb,$yb,$c)=@_;
 my $pi = 3.14159265358979;
 my $dx=$xb-$xa;
 my $dy=$yb-$ya;
 return (atan2($dy,$dx)*$c/$pi);
}


Der Code lässt sich noch sehr verbessern, so brauche ich in diesem Fall nicht das gesammte Bild im Speicher zu halten. Ich könnte es direkt schreiben. Die Werte lassen sich auch schneller errechnen.

hier mal ein Bild (7bit Farben) als jpeg konvertiert:
http://www.topeg.de/bilder_sonst/test.jpeg

View full thread Tk bind und Buttongröße