Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Zinc;

#minimum 8 buttons 
my $numberbuttons = 8;
my $motion_flag = 1;
my $delay = 10;

my $width = 25*$numberbuttons;
my $height = 100;
my %bgroup;
my $textmessage = 'How\'s the scroll working? Right Click Blue stops s
+croll.';


my $iconb64 =
'R0lGODdhEAAQAKUAAAAAAC8wL72+vcK8sOCxWfioFeqtO+6sMO6sMuSvTY6Ojt6yXv+lA
+F5fXu6r 
L0BAAP/SAA8PD///AP/oAIBSAK+CL0dHR5aAVkApAL+/AP+8AHN0c6ysrM64jvymCcC9s9
+qzau2s 
NOauR+auSOSvTtuyZ15eXsK8rcS8rP////////////////////////////////////////
+////// 
/////////////////////////////////////////////ywAAAAAEAAQAAAGb0CAUBgQDA
+RIQWDI 
LBIKhgMioWQKFQuGdrtoWIvbsENgbWTDWzITi05bhQ8IBK0eRgAPiV4yoVTqABYXFBh7Eh
+lvAGZb 
GnIPiRtnbRxlknRlHW0MY28CHm0dXlYCHyAhIiMkJYBDJkgnAigCCktDQQA7';


my $mw = MainWindow->new;
$mw->geometry($width.'x'.$height.'-15-15'); # lower right hand corner 
$mw->configure(-background => 'black');
$mw->resizable(0,0);
$mw->overrideredirect(1);

#bottombaricon setup 
my $mwicon = MainWindow->new;
$mwicon->geometry('16x16-80-0'); # lower right hand corner 
$mwicon->resizable(0,0);
$mwicon->configure(-background => 'black', -cursor => 'hand2');
$mwicon->overrideredirect(1);
my $icon = $mwicon->Photo(-data => $iconb64);
$mwicon->Label(-image => $icon)->pack(-expand => 1, -fill => 'both');
$mwicon->Tk::bind("<Button-1>",sub{$mw->deiconify} );
################### 
my $zinc = $mw->Zinc(-width => $width, -height => 100,
                -backcolor => 'black',
                -borderwidth => 0,
                -relief => 'sunken',
                -cursor => "top_left_arrow",
                )->pack;


# Then we create a wide line, in which we will display messages. 
my $messagebox = $zinc-> add('curve', 1, [15,60,$width-15,60],
                            -linewidth => 20,
                            -linepattern => "AlphaStipple7",
                            -linecolor => "red",
                            -visible => 1,
                            -priority => 1,
                            );

#make group for scrolling text 
my $textgroup = $zinc->add('group',1,-visible=> 1);
$zinc->translate($textgroup, $width/2, 60);

my $text = $zinc->add('text', $textgroup,
                      -position => [0,0],
                      -visible => 0,
                      -anchor => 'w',
                      -color => 'ivory',
                      -font => '-mozilla-arial-bold-r-normal--18-90-10
+0-100-p-93-iso8859-1',
                      #default is -adobe-helvetica-bold-r-normal--*-12
+0-*-*-*-*-*-* 
                      -priority => 1
                      );

#make button help text 
my $texthelp = $zinc->add('text', 1,
                      -position => [$width/2,85],
                      -visible => 0,
                      -anchor => 'center',
                      -color => 'cyan',
                      -priority => 2,
                      );


#make buttons 
my $bgset = $zinc->add('group',1,-visible=> 1);
$zinc->translate($bgset,-10,18);
$zinc->rotate($bgset,.2,15,15);

for (1..$numberbuttons){
$bgroup{'button'.$_}{'name'} = $zinc->clone($bgset);

#create top of button 
$bgroup{'button'.$_}{'top'} = $zinc->add('arc',
                                 $bgroup{'button'.$_}{'name'}, [-10,-1
+0,10,20],
                  -fillcolor => "orange",
                  -filled => 1,
                  -linewidth => 2,
                  -linecolor => 'gray',
                  -visible => 1,
                  -extent => 180,
                  -startangle => 180,
                  -pieslice => 1,
                  -priority => 2,  # sets it on top layer  
                  -tags => "top$_");

$bgroup{'button'.$_}{'subtop'} = "bsubtop$_";
my $id = $bgroup{'button'.$_}{'top'};
my $sub = $bgroup{'button'.$_}{'subtop'};


$zinc->bind($id,"<Enter>", sub{$zinc->configure(-cursor => 'hand2')});
$zinc->bind($id,"<Button 1>", [\&$sub,$_] );
$zinc->bind($id,"<Leave>", sub{$zinc->configure(-cursor => 'top_left_a
+rrow')});

#created bottom of button 
$bgroup{'button'.$_}{'bottom'} = $zinc->add('arc',
                                   $bgroup{'button'.$_}{'name'}, [-10,
+-5,10,25],
                  -fillcolor => "orange",
                  -filled => 1,
                  -linewidth => 2,
                  -linecolor => 'gray',
                  -visible => 1,
                  -extent => 180,
                  -startangle => 360,
                  -pieslice => 1,
                  -priority => 2,  # sets it on top layer  
                  -tags => "bottom$_");

$bgroup{'button'.$_}{'subbottom'} = "bsubbottom$_";
$id = $bgroup{'button'.$_}{'bottom'};
$sub = $bgroup{'button'.$_}{'subbottom'};
$zinc->bind($id,"<Enter>", sub{$zinc->configure(-cursor => 'hand2')});
$zinc->bind($id,"<Button 1>", [\&$sub,$_] );
$zinc->bind($id,"<Leave>", sub{$zinc->configure(-cursor => 'top_left_a
+rrow')});

#make an on-off indicator 
 $bgroup{'button'.$_}{'indicator'} = $zinc->add('arc',
                      $bgroup{'button'.$_}{'name'}, [-6,0,6,12],
                  -fillcolor => "yellow",
                  -filled => 1);

#number the buttons 
my $ident = $zinc->add('text',$bgroup{'button'.$_}{'name'},
                       -position => [-2,24],
                       -text => $_,
                       -priority => 3,
                       -color => 'green',
                       );

$zinc->translate($bgroup{'button'.$_}{'name'},25*$_,0);
$zinc->pack();
}


#exit button 
my $exitgroup = $zinc->add('group',1,-visible=> 1);
$zinc->translate($exitgroup, $width-15, 85);

my $arc1 = $zinc->add('arc', $exitgroup, [-10,10,10,-10],
                          -fillcolor => "gray",
                          -filled => 1,
                          -tags => ' ',
                          -priority => 1
                          );

my $arc2 = $zinc->clone($arc1);
$zinc->itemconfigure($arc2,-fillcolor =>'red', -tags => 'exit', -prior
+ity => 2);
$zinc->scale($arc2,.8,.8);
$zinc->bind($arc2,"<Enter>", sub{
                                $zinc->configure(-cursor => 'hand2');
                                $zinc->itemconfigure($texthelp,
                                          -visible=> 1,
                                          -text => 'Exit');
                                });

$zinc->bind('exit', '<Button 1>', sub {z_exit()});
$zinc->bind($arc2,"<Leave>", sub{
                                $zinc->configure(-cursor => 'top_left_
+arrow');
                                $zinc->itemconfigure($texthelp,
                                          -visible=> 0);
                                  });

#blue button 
my $icongroup = $zinc->add('group',1,-visible=> 1);
$zinc->translate($icongroup, $width-40 ,85);

my $arc3 = $zinc->add('arc', $icongroup, [-10,10,10,-10],
                          -fillcolor => "gray",
                          -filled => 1,
                          -tags => ' ',
                          -priority => 1
                          );

my $arc4 = $zinc->clone($arc3);
$zinc->itemconfigure($arc4,-fillcolor =>'blue', -tags => 'blue', -prio
+rity => 2);
$zinc->scale($arc4,.8,.8);
$zinc->bind($arc4,"<Enter>", sub{
                                 $zinc->configure(-cursor => 'hand2');
                                 $zinc->itemconfigure($texthelp,
                                          -visible=> 1,
                                          -text => 'Scroll Control');
                                       });


$zinc->bind('blue', '<Button 1>', sub {scroll($textmessage,'yellow')})
+;
$zinc->bind($arc4,"<Leave>", sub{
                                $zinc->configure(-cursor => 'top_left_
+arrow');
                                $zinc->itemconfigure($texthelp,
                                          -visible=> 0);
                                    });


#iconify down triangle 
my $iconify = $zinc->add('curve', 1,
                     [5,80,30,80,18,95], #(x1,y1,x2,y2,x3,y3)   
                     -closed => 1,
                     -filled => 1, #will be transparent without this l
+ine  
                     -fillcolor => 'green',
                     -visible => 1,
                     -tags => 'icon'
                     );
$zinc->bind($iconify,"<Enter>", sub{
                                  $zinc->configure(-cursor => 'hand2')
+;
                                  $zinc->itemconfigure($texthelp,
                                          -visible=> 1,
                                          -text => 'Iconify');
                                        });

                                        
$zinc->bind('icon', '<Button 1>', sub {$mw->withdraw});
$zinc->bind($iconify,"<Leave>", sub{
                                  $zinc->configure(-cursor => 'top_lef
+t_arrow');
                                  $zinc->itemconfigure($texthelp,
                                          -visible=> 0);
                                  });


######################################################################
+######## 
# Display comment 
&comment("Press Blue");

MainLoop;

# Just display comment  
sub comment {
    $zinc->itemconfigure($messagebox, -visible => 1);

    my $string = shift;
    $zinc->itemconfigure($text, -visible => 1,
                                -anchor => 'center',
                                -text => $string,
                                -color => 'white',
                                -font => '-adobe-courier-bold-o-normal
+--14-100-100-100-m-9',
                                );
}

sub scroll {
    my $scroll_id;
    $motion_flag =1;
    $zinc->bind('blue', '<Button 3>', sub {$motion_flag = 0}); #stops 
+scroller 
    $zinc->bind('blue', '<Button 1>', sub {}); #stops multiple presses
+ 
    $zinc->itemconfigure($messagebox,-visible => 1);
    my $string = shift;
    my $color = shift;
    $string = '......' . $string . '.....';
    my $strlen = length($string);
        $zinc->translate($textgroup,$width/2,0);
    $zinc->itemconfigure($text, -visible => 1,
                                -anchor => 'w',
                                -text => $string,
                                -font => '-mozilla-arial-bold-r-normal
+--18-90-100-100-p-93',
                                -color => $color,
                                );

                                
   $scroll_id =  $mw->repeat($delay,sub {
                           if($motion_flag == 0){$scroll_id->cancel; s
+top_scroll()}
                           $zinc->translate($textgroup,-1,0);
                           my @pos = $zinc->bbox($text); #(corner coor
+ds x,y,x1,y1) 
                           if($pos[2] < 0){
                            $zinc->itemconfigure($text, -visible => 0)
+;
                            $zinc->translate($textgroup, (-$pos[0] + $
+width) ,0);
                            $zinc->itemconfigure($text, -visible => 1)
+;
                           }
                       }
                );

return;
}

sub stop_scroll{
     $zinc->itemconfigure($text, -visible => 0);
     $zinc->bind('blue', '<Button 1>', sub {scroll($textmessage,'yello
+w')});
     $zinc->treset($textgroup);
     $zinc->translate($textgroup, $width/2, 60);
     &comment("Press Blue");
 }

sub toggle_on{my $button = shift;
              $zinc->itemconfigure($bgroup{'button'.$button}{'indicato
+r'},
                     -fillcolor => 'green');}


sub toggle_off{my $button = shift;
               $zinc->itemconfigure($bgroup{'button'.$button}{'indicat
+or'},
                     -fillcolor => 'red');}


sub z_exit{Tk::exit}

########################################################## 
sub bsubtop1 {
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop2{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop3{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop4{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop5 {
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop6{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop7{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubtop8{
shift;
my $button = shift;
print "\007";
toggle_on($button);
}

sub bsubbottom1{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom2{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom3{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom4{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom5{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom6{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom7{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

sub bsubbottom8{
shift;
my $button = shift;
print "\007";
toggle_off($button);
}

[download]

In reply to Scrolling-text-launchbar with Tk::Zinc by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others goofing around in the Monastery: (9)
As of 2024-04-19 09:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found