Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]8960[/thread]

Perl Threads per Button steuern

Leser: 1


<< >> 3 Einträge, 1 Seite
Gast Gast
 2007-05-03 17:21
#76408 #76408
Hi, ich habe eine Anwendung mit Perl / Tk erstellt, die Daten als Graph in einem Canvas-Widget visualisiert. Die Zeichnung des Graphe wird in einem Thread erledigt, der über einen Button aufgerufen wird und soll durch einen zweiten Button wieder beendet werden. Das starten de sThread sklappt ohne Probleme, jedoch nicht das beenden. Der Thread läuft dann nach Aufruf nach wie vor. den entsprechenden Code hab ich hier mal angeklebt:

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
# Starten der Messung
my $StartButton = $ControlFrame->Button(-text =>"Messung starten", 
-command =>\&StartThr1)->pack;

    
# Beenden der Messung
my $StopButton = $ControlFrame->Button(    -text => "Messung beenden",
               
               
          -command=>\&SetKillFlag)->pack;

.
.
.

#-----------------------
#    sub: Measure()
#-----------------------
#    Aufgabe:
#    Führt eine einmalige Messung aus
sub Measure{
    #open( DATEI, ">$fileName") || die("Datei $fileName kann nicht geöffnet werden\n");

    $ob->write('m');
    &_wait;    
    $input = $ob->input;
    
    
    return $input;
}



#-----------------------
#    sub: RunMeasure()
#-----------------------
#    Aufgabe:
#    "Messschleife"
sub RunMeasure{
    
    my $stat = $_[0];
    my $wait = $_[1];
    $count = 0;
    
    while( $count < 1000 )
    {
        
            &_wait;
            &_wait;
            &_wait;
            &_wait;
            $newValue = &Measure;
            
            my $newDraw = $graphYSize/(1<<$resolution) * $newValue;
            my $oldDraw = $graphYSize/(1<<$resolution) * $oldValue;
            
            $lineId = $Canvas->createLine($count,500-$oldDraw,$count+$xShift,500-$newDraw);
               
 
            $count += $xShift;
            
            
            $oldValue = $newValue;
            
            print $killFlag;
    }
    
    
    return;
    
}

.
.
.

sub SetKillFlag{
    $killFlag = 1;
    
}

sub StartThr1{
    $thr1 = threads->create('RunMeasure');
    $thr1->detach;
}
vayu
 2007-05-03 17:41
#76409 #76409
User since
2005-01-13
782 Artikel
BenutzerIn
[default_avatar]
Code: (dl )
1
2
3
4
5
6
-command=>\&SetKillFlag)->pack;

sub SetKillFlag{
    $killFlag = 1;
    
}


schön und gut, du setzt in der Funktion zwar ein flag ... aber du prüfst doch nirgendwo ob das flag gesetzt ist.

ich würd vorschlagen du musst sowas machen:

Code: (dl )
while( $count < 1000 and !$killFlag)
\n\n

<!--EDIT|vayu|1178199759-->
"imitation is the sincerest form of flattery."
- Lee Anthony Iacocca
http://img156.imageshack.us/img156/2056/perluserba...
http://img410.imageshack.us/img410/2664/tcmduserba...
Sucher
 2007-05-04 11:49
#76410 #76410
User since
2007-03-26
47 Artikel
BenutzerIn
[default_avatar]
Hallo,
hier ist ein Beispiel mit Tk und threads, vielleicht hilft es dir:

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
use warnings;
use strict;

use threads;
use threads::shared;

my $var =1;
share $var;
my $data;
share $data;

my @threads;

push @threads, threads->create(\&thread);
push @threads, threads->create(\&tk_thread);

$_ -> join for @threads;

print "threads joined\n";


sub thread{
    my $counter = 0;
    while (1){
        if ($var==1){
            print "thread doing work\n";
            {
                lock $data;
                $data = $counter++;
            }
            sleep (1);
        }elsif($var == 0){
            print "thread waiting\n";
            sleep(1);
        }else{
            print "thread finished\n";
            return;
        }
    }
}
sub tk_thread{
    require Tk;
    Tk->import;
    my $mw = tkinit();
    my $text = $mw->Text->pack;
    $mw->Button(-text => 'start_stop',
                -command => sub {{lock $var;
                                  $var = $var? 0 : 1
                                  }
                             },
            )->pack;
    $mw->Button(-text => 'beenden',
                -command => sub{{lock $var;
                                 $var = -1;
                                 $mw->destroy;}
                            },
                )->pack;
$mw->repeat(100,sub{{lock $data;
                     $text->insert('end', $data."\n") if $data;
                     $data = '';
                     }
                } );
MainLoop();
}


Grüße,
<< >> 3 Einträge, 1 Seite



View all threads created 2007-05-03 17:21.