use Thread;
use warnings;
use Tk;
my $x = 10;
my $mw = new MainWindow;
$mw->Label(-text => 'honeywell')->place(-x => $x, -y => 50);
my $thr = new Thread \&sub1;
sub sub1 {
for ($i = 0 ; $i < 20 ; $i++) {
$x += 20;
sleep(2);
$mw->update;
}
}
MainLoop;
I am trying to update the label so that the text appears going down.I want to implement it using thread.But the text os not sliding down.Can anyone plz help me?
Try this code:
use strict;
use warnings;
use Tk;
my $x = 10;
my $mw = new MainWindow;
my $label = $mw->Label(-text => 'honeywell')->place(-x => $x, -y => 50);
$mw->repeat(2000, \&sub1);
sub sub1 {
return if $x >= 400;
$x += 20;
$label->place(-x => $x, -y => 50);
$mw->update;
}
MainLoop;
I don't think that this will ever work (using Thread or threads).
place uses the content of $x and does not bind the variable $x. So changing the variable after the initial placement won't do anything to the label.
Related
when I am using "--disk-cache=true" in phantomjs_arg then it's getting error In this line:
my $form = $self->{obj_mech}->form_number( 2 );
No elements found for form number 2 at modules/TestLogin.pm line 1129.
at /usr/local/share/perl/5.22.1/WWW/Mechanize/PhantomJS.pm line 796.
WWW::Mechanize::PhantomJS::signal_condition(WWW::Mechanize::PhantomJS=HASH(0x4cfa120),
"No elements found for form number 2") called at
/usr/local/share/perl/5.22.1/WWW/Mechanize/PhantomJS.pm line 1732
WWW::Mechanize::PhantomJS::xpath(WWW::Mechanize::PhantomJS=HASH(0x4cfa120),
"(//form)[2]", "user_info", "form number 2", "single", 1) called at
/usr/local/share/perl/5.22.1/WWW/Mechanize/PhantomJS.pm line 2102
WWW::Mechanize::PhantomJS::form_number(WWW::Mechanize::PhantomJS=HASH(0x4cfa120),
2) called at modules/TestLogin.pm line 1129
TestLogin::TestLogin_login(TestLogin=HASH(0x4f5c8a8)) called at collectBets.pl line 20 Debugged program terminated. Use q to quit
or R to restart, use o inhibit_exit to avoid stopping after program
termination, h q, h R or h o to get additional info.
without disk-cashe it's working fine.
This is my sample code for better understanding.
#!/usr/bin/perl
use strict;
use warnings;
use Helper;
use WWW::Mechanize::PhantomJS;
use DataBase;
use MyConfig;
use JSON;
use DateTime;
use HTML::Entities;
sub new($$) {
my ($class,$params) = #_;
my $self = $params || {};
bless $self, $class;
$self->{obj_mech} = WWW::Mechanize::PhantomJS -> new( phantomjs_arg => ['--ssl-protocol=any','--disk-cache=true','--max-disk-cache-size=1024'], ignore_ssl_errors => 1);
$self->{obj_helper} = new Helper();
#$self->{obj_db} = new DataBase();
$self->{logged_in} = 0;
#$self->setTorProxy();
#$self->init_market_master();
return $self;
}
Login();
print "\nlogin done...\n";
exit;
sub Login {
my ($self) = #_;
my $html = $self->{obj_mech}->get( "https://www.gmail.com/" );
sleep(25);
$html = $self->{obj_mech}->content;
$self->{obj_mech}->viewport_size({ width => 1366, height => 768 });
my $form = $self->{obj_mech}->form_number( 2 );
my $user_name = '*****';
my $password = '******';
$self->{obj_mech}->set_fields('InputEmail' =>$user_name);
$self->{obj_mech}->set_fields('InputPassword' =>$password);
$self->{obj_mech}->click({ xpath => '//button[#class="PrimaryButton"]' });
sleep(20);
my $test_html=$self->{obj_mech}->content;
$self->{obj_helper}->writeFileNew( "TestLoginPage.html" , $test_html );
my $png = $self->{obj_mech}->content_as_png();
$self->{obj_helper}->writeFileNew( "LoginPage.png" , $png );
return 1;
}
Well, before looking at the disk-cache arguments, I found that there are no such elements.
# There is only 1 form. If you want to keep this line,
# you need to change the form number to 1
my $form = $self->{obj_mech}->form_number( 2 );
# I didn't find input field named 'InputEmail'
# The actual field name is 'Email'
$self->{obj_mech}->set_fields('InputEmail' =>$user_name);
# You have to click 'Next' button firstly then the password
# input box is shown. And the field name should be 'Passwd'
$self->{obj_mech}->set_fields('InputPassword' =>$password);
# The xpath of 'Sign in' button is //input[#value="Sign in"]
$self->{obj_mech}->click({ xpath => '//button[#class="PrimaryButton"]' });
A simple working script either with disk cache or without disk cache:
#! /usr/bin/perl
use strict;
use warnings;
use WWW::Mechanize::PhantomJS;
use open ':std', ':encoding(UTF-8)';
#my $p = WWW::Mechanize::PhantomJS->new(phantomjs_arg=>['--ssl-protocol=any','--disk-cache=false','--max-disk-cache-size=1024'],ignore_ssl_errors=>1);
my $p = WWW::Mechanize::PhantomJS->new(phantomjs_arg=>['--ssl-protocol=any','--disk-cache=true','--max-disk-cache-size=1024'],ignore_ssl_errors=>1);
my $html = $p->get("https://www.gmail.com/");
sleep(5);
write_html('first-page.html', $p->content);
$p->viewport_size({width=>1366,height=>768});
my $form = $p->form_number(1);
my $user_name = '*****';
my $password = '*****';
$p->set_fields('Email'=>$user_name);
sleep(5);
$p->click({xpath=>'//input[#value="Next"]'});
sleep(5);
write_html('after-click-next.html', $p->content);
$p->set_fields('Passwd'=>$password);
sleep(5);
$p->click({xpath=>'//input[#value="Sign in"]'});
sleep(5);
write_html('after-login.html', $p->content);
sub write_html {
my ($file, $content) = #_;
open my $fh, '>', $file or die;
print $fh $content;
close $fh;
}
I need graphical output from a Perl program. The window has a label status field and should show what programming code decides.
How do I change the text of a label field after the window has been created without any buttons?
I have the following:
use Tk;
$mw = Tk::MainWindow->new(-title => 'Status Window',-bg=>"white");
$mw->geometry ("400x200+0+0");
$lala = $mw->Label(-text => "Current Status")->grid(-row=>0,-column=>0);
$mw->bind( 'all' => '<Key-Escape>' => sub {exit;} );
MainLoop;
How do I incorporate the following subroutine so that it is run automatically
after the window is created? Label-Widget does not have
a -command field. It should start immediately and
not wait for a event to happen
sub calculate() {
for ( $i = 0; $i < 10; $i++ ) {
sleep 2s;
$lala->configure(-text=>"Current Status : $i");
}
}
The following seems to work. I used after() to run code after 100 ms then used update() to redraw window:
use feature qw(say);
use strict;
use warnings;
use Tk;
my $mw = Tk::MainWindow->new(-title => 'Status Window',-bg=>"white");
$mw->geometry ("400x200+0+0");
my $lala = $mw->Label(-text => "Current Status")->grid(-row=>0,-column=>0);
$mw->bind('all'=> '<Key-Escape>' => sub {exit;});
$lala->after(100, \&calculate );
MainLoop;
sub calculate() {
for(my $i=0; $i<10; $i++){
sleep 1;
$lala->configure(-text=>"Current Status : $i");
$mw->update();
}
}
Edit:
The above code blocks during the sleep 1 call, so any input for the Tk event loop will will be delayed. In particular, pressing Esc to quit the application will not work immediately. It will be blocked until sleep returns. To solve this, one can use Tk's repeat() instead of sleep and Tk's after(), and cancel the repeat if necessary:
my $repeat_count = 10;
my $timer_id = $lala->repeat(1000, \&calculate );
MainLoop;
sub calculate() {
$lala->configure(-text=>"Current Status : $repeat_count");
if ( --$repeat_count == 0) {
$timer_id->cancel;
}
}
I have an application written with perl Tk, showing some data on a canvas. Now I would like to be able to generate a 3d view of the data with opengl. Is there any way to embed an OpenGL widget or window inside an Tk window?
I've seen some posts in perlmonks that use Tk and glpCreateWindow to create a new separated OpenGL window but I want the OpenGL "canvas" to be inside the main Tk window.
Here's an adaption of the tk_demo script which comes with the OpenGL perl module
https://metacpan.org/source/CHM/OpenGL-0.66/examples/tk_demo.pl
The script was changed so that the opengl drawing appears in a Frame widget, and not in a Toplevel/MainWindow widget, so other Tk widgets may be contained within the same Toplevel. It's even possible to resize the Tk window, the opengl drawing will adapt accordingly.
There's one flaw though: it seems that it's not possible to start the opengl drawing using afterIdle(); at this point the container frame does not seem to exist yet and a X11 error happens. It's also not possible to use waitVisibility() here. Hence the workaround using after(1000,...).
#!/usr/local/bin/perl
#
# This is an example of combining the tk module and opengl
# You have to have TK installed for this to work.
# this program opens a window and when you hit a key in
# the window a callback that does some opengl stuff is
# executed.
# Yes, this is a totally lame program, but its a proof
# of concept sort of thing.
# We'll get something better next time :-)
#
use lib ('blib');
use strict;
use Tk;
use OpenGL;
my $top = MainWindow->new();
$top->Label(-text => "Hello, OpenGL!")->pack;
my $f = $top->Frame(-bg => "green", -width => 200, -height => 200)->pack(-expand => 1, -fill => "both");
$top->Button(-text => "Exit", -command => sub { $top->destroy })->pack;
my $kid;
sub CreateKid {
my $par = shift;
my $id = hex($par->id);
print " window id: $id -> ", (sprintf '%#x', $id),"\n";
my ($w, $h) = ($par->Width, $par->Height);
my ($xbord, $ybord) = (int($w/8), int($h/8));
$kid = glpOpenWindow( x => $xbord, y => $ybord, width=> ($w-2*$xbord),
height=> ($h-2*$ybord),parent=>$id);
}
sub ResetKid {
return unless $kid;
my $par = shift;
my $w = $par->Width;
my $h = $par->Height;
my ($xbord, $ybord) = (int($w/8), int($h/8));
$w = $w-2*$xbord;
$h = $h-2*$ybord;
glpMoveResizeWindow($xbord,$ybord,$w,$h);
glViewport(0,0,$w,$h);
print "viewport $w x $h, origin $xbord, $ybord\n";
DrawKid();
}
my $pending = 0;
sub DrawKid {
return unless $kid;
return if $pending++;
$top->DoWhenIdle(\&DrawKid_do);
}
sub DrawKid_do {
return unless $kid;
$pending = 0;
print "Drawing...\n";
glClearColor(0,0,1,1);
glClear(GL_COLOR_BUFFER_BIT);
glOrtho(-1,1,-1,1,-1,1);
glColor3f(1,0,0);
glBegin(GL_POLYGON);
glVertex2f(-0.5,-0.5);
glVertex2f(-0.5, 0.5);
glVertex2f( 0.5, 0.5);
glVertex2f( 0.5,-0.5);
glEnd();
glFlush();
}
sub DrawKid1 {
return unless $kid;
print "Visibility change\n";
DrawKid;
}
sub DrawKid2 {
return unless $kid;
print "Expose change\n";
DrawKid;
}
sub DoKey
{
my $w = shift;
return if $kid;
CreateKid $w;
DrawKid;
}
sub DoMouse
{
shift;
my ($b,$p) = (shift,shift);
print "mouse-$b $p\n";
}
$f->after(1000, sub { DoKey($f) });
$f->bind("<Any-ButtonPress>",[\&DoMouse, Ev('b'), Ev('#')]);
$f->bind("<KeyPress-q>",[$top, 'destroy']);
$f->bind("<KeyPress-Escape>",[$top, 'destroy']);
$f->bind("<Configure>",\&ResetKid);
$f->bind("<Visibility>",\&DrawKid1);
$f->bind("<Expose>",\&DrawKid2);
Tk::MainLoop();
I'm trying to get the notepad to expand when dragging the main
window .... and suggestions? I have it to where it reads the screen size but it won't keep the changing size of the window. All my attempts of add a loop have failed... is there anyway to create a loop or a constant call back?
#!/usr/bin/perl -w
use strict;
use Tkx;
use strict;
use LWP::Simple;
use LWP::UserAgent;
use Cwd;
use Tkx;
Tkx::package_require("Tktable");
Tkx::package_require("tile");
Tkx::package_require("style");
Tkx::style__use("as", -priority => 70);
Tkx::package_require('widget::scrolledwindow');
Tkx::package_require("BWidget");
our $VERSION = "1.00";
(my $progname = $0) =~ s,.*[\\/],,;
my $mw = Tkx::widget->new(".");
$mw->g_wm_title("Wikiget");
$mw->g_wm_minsize(500, 200);
cow();
Tkx::MainLoop();
exit;
sub cow
{
my $sw = $mw->new_ScrolledWindow();
my $sf = $sw->new_ScrollableFrame();
$sw->g_pack(-fill => "both", -expand => 1); $sw->setwidget($sf);
my $printer_frame = Tkx::widget->new($sf->getframe());
Tkx::update('idletasks');
my $x = int((Tkx::winfo('width', $mw))- 10);
my $y = int((Tkx::winfo('height', $mw)) - 50);
my $nb = $printer_frame->new_ttk__notebook(-height => $y, -width => $x);
$nb->g_pack(-fill => "both", -expand => 1);
my $fm1 = $nb->new_ttk__frame;
my $fm2 = $nb->new_ttk__frame;
$fm1->new_label(-text => 'Test1Test1Test1')->g_pack(qw/-anchor nw/);
$fm2->new_label(-text => 'Test2Test2Test2')->g_pack(qw/-anchor nw/);
$nb->add($fm1, -text => 'One');
$nb->add($fm2, -text => 'Two');
}
How could I make "visible" the timer? This example returns (intependent from the sleep-time always) 2 (I expected something similar to the sleep-time).
#!/usr/local/bin/perl
use warnings;
use 5.014;
use AnyEvent;
my $c = 0;
my $cv = AnyEvent->condvar;
my $once_per_second = AnyEvent->timer (
after => 0,
interval => 1,
cb => sub {
$c++;
$cv->send;
},
);
sleep 5;
$cv->recv;
say $c;
There are at least two problems:
sleep 5 doesn't run the event loop.
Your callback triggers the cond. variable. If, for instance, you removed the sleep 5 statement, $c would only be 1.
Is this what you want?
my $c = 0;
my $cv = AnyEvent->condvar;
my $once_per_second = AnyEvent->timer(after => 0, interval => 1, cb => sub { $c++ });
my $five_seconds = AnyEvent->timer(after => 5, cb => sub { $cv->send });
$cv->recv;
say $c;
The event loop is not running (well nothing is running) while sleep is "active". So no event registered with AnyEvent can be triggered.
The rule: If you use AnyEvent (or any other ansynchronous framework), never use sleep.
See user5402's answer for the correct solution.