Thread Tk bind und Buttongröße
(12 answers)
Opened by DerHenning at 2008-10-12 01:00
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 |