Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Graphische Oberflächen
[thread]4661[/thread]

zykloide flüssig zeichnen



<< >> 10 Einträge, 1 Seite
Gast Gast
 2003-09-28 20:18
#44297 #44297
Hallo,
ich hab hier mal ein kleines Programm geschrieben, das Zykloide zeichnet:
Code: (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
#!/usr/bin/perl -w
#3.14159265358979
use Tk;

my $MainWindow = MainWindow->new();

my $Canvas     = $MainWindow->Canvas();

#$MainWindow->bind('<Configure>', \&Hallo);
$MainWindow->bind('<ButtonPress-1>', \&Hallo);

#$Canvas->createText(100,100,-tags => 'Text', -text => $text);

$Canvas->pack(-expand => 'yes', -fill => 'both');

MainLoop;

sub Hallo
{
$text = $Canvas->geometry();

$Canvas->delete(Text);
$Canvas->createText(100,100,-tags => 'Text', -text => $text);

$xm = 250;
$ym = 250;
$r  = 30;

$Canvas->createOval($xm - $r,$ym - $r,$xm + $r,$ym + $r, -tags =>'A');

for($i=0; $i<=3.14159265358979*6; $i=$i+0.01)
{

  $x1=(30+20)*cos($i)-20*cos((30+20)*$i/20);
  $x2=(30+20)*cos($i+0.01)-20*cos((30+20)*($i+0.01)/20);
  $y1=(30+20)*sin($i)-20*sin((30+20)*$i/20);
  $y2=(30+20)*sin($i+0.01)-20*sin((30+20)*($i+0.01)/20);



  $xP=50*cos($i);
  $yP=50*sin($i);
  $xm = 250 + $xP;
  $ym = 250 + $yP;
  $r  = 20;

  $Canvas->delete(B);
  $Canvas->delete(radius);
  $Canvas->createOval($xm - $r,$ym - $r,$xm + $r,$ym + $r, -tags =>'B');
  $Canvas->createLine($xm, $ym, $x2+250, $y2+250, -tags => 'radius');
  $Canvas->createLine($x1+250, $y1+250, $x2+250, $y2+250, -tags => 'zykloid');
  $MainWindow->update;

}
}

Das Problem ist jetzt nur, dass der zykloid mal schneller und mal langsamer gezeichnet wird, es variiert also die Zeichengeschwindigkeit. Hat von euch jemand ne Idee, wie man es schaffen könnte, dass der Zykloid gleichmässig schnell gezeichnet wird?

Danke schon mal im Voraus
jan10001
 2003-09-29 13:07
#44298 #44298
User since
2003-08-14
962 Artikel
BenutzerIn
[default_avatar]
Hm, habe davon keine Ahnung, aber wie wäre es mit einen Zwischenspeicher? Speichere alle Rechenergebnisse in ein Array und zur Ausgabe lies die Ergebnisse im Array mit ner Schleife aus. Dann sollte es gleichmäßig gehen.
Ishka
 2003-09-29 16:14
#44299 #44299
User since
2003-08-04
771 Artikel
HausmeisterIn
[Homepage] [default_avatar]
Hab mir zwar deinen code nciht so genau durchlesen, aber mit $main->repeat(100=>sub {...Code...}); kannst du einen code in Periodischen Abständen ausführen lassen (hier als Beispiel 100 Millisekunden)
sub z{if(@_){1while$x[$k=rand 10];t($t=$x[$k]=1)}print map"$z[$x[$_]]$_".($_%3?
"":"\n"),1..9}sub t{$j=0;$x[$_+1]==$t&&($j+=2**$_)for 0..8;z,die"Gewinner $z[$t]
"if grep$_==($j&$_),7,56,73,84,146,273,292,448;z,die"Gleichstand\n"if@x>9&&!grep
!$_,@x}@x=4;@z=qw{. [ (};z$^T&1;while(<>){next if$_>9||$x[$_];t$t=$x[$_]=2;z 1}
Crian
 2003-10-20 14:22
#44300 #44300
User since
2003-08-04
5866 Artikel
ModeratorIn
[Homepage]
user image
Was sind Zykloide?

Tipp: Verwende use strict; ...

Mir scheint Dir fehlt eine Ausdrucksweise für Konstanten in Perl. (Mir eigentlich auch.) Es gibt (mindestens) drei Möglichkeiten, das fehlende Keyword "const" zu ersetzen:

Code: (dl )
use constant Pi => 3.14159265358979;


oder

Code: (dl )
*PI = \3.14159265358979;


oder

Code: (dl )
*PI = sub () { 3.14159265358979 };


wobei die erste Möglichkeit ev. die eleganteste ist.
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite
ptk
 2003-12-02 19:38
#44301 #44301
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Es hilft, wenn du Tags wiederverwendest und anstatt des Loeschens
einfach ->coords() verwendest, um die Koordinaten zu aendern. Anscheinend wird Tk-intern beim Loeschen und Wiederanlegen eine Liste immer laenger und deshalb das Abarbeiten mit der Zeit immer langsamer :-(

$calc ist nur dazu da, um den Code fuer die Berechnung der Variablen nicht duplizieren zu muessen.

Code: (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
#!/usr/bin/perl -w
#3.14159265358979
use Tk;

my $MainWindow = MainWindow->new();

my $Canvas     = $MainWindow->Canvas();

#$MainWindow->bind('<Configure>', \&Hallo);
$MainWindow->bind('<ButtonPress-1>', \&Hallo);

#$Canvas->createText(100,100,-tags => 'Text', -text => $text);

$Canvas->pack(-expand => 'yes', -fill => 'both');

MainLoop;

sub Hallo
{
$text = $Canvas->geometry();

$Canvas->delete(Text);
$Canvas->createText(100,100,-tags => 'Text', -text => $text);

$xm = 250;
$ym = 250;
$r  = 30;

$Canvas->createOval($xm - $r,$ym - $r,$xm + $r,$ym + $r, -tags =>'A');

my $calc = sub {
 my $i = shift;
 $x1=(30+20)*cos($i)-20*cos((30+20)*$i/20);
 $x2=(30+20)*cos($i+0.01)-20*cos((30+20)*($i+0.01)/20);
 $y1=(30+20)*sin($i)-20*sin((30+20)*$i/20);
 $y2=(30+20)*sin($i+0.01)-20*sin((30+20)*($i+0.01)/20);



 $xP=50*cos($i);
 $yP=50*sin($i);
 $xm = 250 + $xP;
 $ym = 250 + $yP;
 $r  = 20;
};

$calc->(0);

$Canvas->delete("B");
$Canvas->delete("radius");
my $oval = $Canvas->createOval($xm - $r,$ym - $r,$xm + $r,$ym + $r, -tags =>'B');
my $line1 = $Canvas->createLine($xm, $ym, $x2+250, $y2+250, -tags => 'radius');
my $line2 = $Canvas->createLine($x1+250, $y1+250, $x2+250, $y2+250, -tags => 'zykloid');

for($i=0; $i<=3.14159265358979*6; $i=$i+0.01)
{

 $calc->($i);

 $Canvas->coords($oval, $xm - $r,$ym - $r,$xm + $r,$ym + $r);
 $Canvas->coords($line1, $xm, $ym, $x2+250, $y2+250);
 $Canvas->coords($line2, $x1+250, $y1+250, $x2+250, $y2+250);

 $MainWindow->update;

}
}
Crian
 2003-12-03 14:31
#44302 #44302
User since
2003-08-04
5866 Artikel
ModeratorIn
[Homepage]
user image
[quote=ptk,02.12.2003, 18:38]Anscheinend wird Tk-intern beim Loeschen und Wiederanlegen eine Liste immer laenger und deshalb das Abarbeiten mit der Zeit immer langsamer :-([/quote]
:-(

Weißt Du, ob die interne Liste wenigstens gelöscht wird, wenn man das ganze Canvas löscht?
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite
ptk
 2003-12-03 19:31
#44303 #44303
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Code: (dl )
perl -MTk -e '$c=tkinit->Canvas;$c->createLine( 0,0,1,1 ); $c->delete("all"); warn $c->createLine(0,0,1,1)'

ergibt 2. Also meine Vermutung: nein. Hoechstens, wenn man das Canvas mit destroy ganz zerstoert und neu erstellt.
Crian
 2003-12-04 01:36
#44304 #44304
User since
2003-08-04
5866 Artikel
ModeratorIn
[Homepage]
user image
Mist! Denn ich mach beim refresh immer so etwas in der Art

Code: (dl )
1
2
3
4
5
$Canvas->delete('all');
zeichne_objektart1($_) for (0..$n1);
zeichne_objektart2($_) for (0..$n2);
zeichne_objektart3($_) for (0..$n3);
...


Hmmm.... da muss ich mal sehen, aber mit Canvas-Objekt löschen und neu anlegen wirds wohl flackern :|
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite
Gast Gast
 2007-10-29 16:14
#101538 #101538
Hallo,

ich muss den Thread hier mal ausgraben :).

Stehe gerade vorm selben Problem mit $Canvas->delete('all'). Es wird nichts gelöscht und die Liste wird immer länger.

Sowas blödes. Da freut man sich, dass man damit tolle Sachen machen kann und dann das hier...

Ist hier schon was inzischen rausgekommen? Kann mir das jemand sagen?

Danke!
ptk
 2007-10-29 22:40
#101545 #101545
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Wenn ich mir das ursprüngliche Skript anschaue, dann sehe ich eine Menge Bugs. Viele Items werden niemals gelöscht und immer wieder neu gezeichnet. Ansonsten scheint es kein Problem mit $c->delete("all") mehr zu geben.
<< >> 10 Einträge, 1 Seite



View all threads created 2003-09-28 20:18.