Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Scrolling-text-launchbar with Tk::Zinc

by zentara (Archbishop)
on Nov 25, 2003 at 20:06 UTC ( [id://310044]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info zentara
Description: I originally started out to see how I could use the moving group feature of Zinc to make scrolling text. Then I added some rotated button groups, with indicator lights. Each button has a top and bottom sub associated with it, and a red-green indicator. The scrolled text was easy, but there is a subtle trick. You would think that you can get the length of the scrolled text with length($string), but in X, the pixel width varies, so you need to use bbox on the $text. Otherwise scrolling is simple...just move the entire group to the left, and when bbox is zero, reset the group position. Screenshot at scroller bar There is a min of 8 buttons, only so the texthelp won't mask the buttons, but if you change to balloons for help that wouldn't be a problem. I just tried to cram as many features as possible in a small space. :-)

There are just beeps in the subs now, but you can use your imagination....fork&exec some apps, import text into the scrollbar from a socket.....I'm still working on it. :-) 

#!/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);
}
Replies are listed 'Best First'.
Re: Scrolling-text-launchbar with Tk::Zinc
by christopheM (Beadle) on Nov 28, 2003 at 12:28 UTC
    Hello Zentara,

    Nice to have such piece of Tk::Zinc code here. But for this example, I think it could have be done easily with Tk::Canvas (this should be verified). It is obvioulsy not the case for your next sample : Oval xterm which really use Tk::Zinc clipping at windowing level.

[reply]
Re: Scrolling-text-launchbar with Tk::Zinc
by smackdab (Pilgrim) on Dec 13, 2003 at 07:33 UTC
    Looks like fun to try. I went to the web site to download it but since I am on Win32, it doesn't look lik pTk is supported...Are you on Win32 or have you tried it?
[reply]
      I hardly use win32 anymore, and I've read there are some bugs getting Zinc to run on win32. This particular app could have been done without Zinc, but Zinc sure made it easier with the groups and group rotations.
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

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

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://310044]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2024-04-26 08:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found