Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widget_lib / mkCanvText.pl

sub mkTextConfig;
sub textBs;
sub textB1Move;
sub textB1Press;
sub textEnter;

sub mkCanvText {

    # Create a window containing a canvas displaying a text string and allowing the string to be edited and re-anchored.

    $mkCanvText->destroy if Exists($mkCanvText);
    $mkCanvText = $top->Toplevel();
    my $w = $mkCanvText;
    dpos $w;
    $w->title('Canvas Text Demonstration');
    $w->iconname('Text');
 
    my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '5i',
			   -justify => 'left', -text => 'This window displays a string of text to demonstrate the text ' .
			   'facilities of canvas widgets.  You can point, click, and type.  You can also select and then ' .
			   'delete with Control-d.  You can copy the selection with Control-v.  You can click in the boxes ' .
			   'to adjust the position of the text relative to its positioning point or change its justification.');
    my $c = $w->Canvas(-relief => 'flat', -bd => 0, -width => '500', -height => '400');
    my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
    $w_msg->pack(-side => 'top', -fill => 'both');
    $c->pack(-side => 'top', -expand => 'yes', -fill => 'both');
    $w_ok->pack(-side => 'bottom', -pady => '5', -anchor => 'center');

    $font = '-Adobe-helvetica-medium-r-normal--*-240-*-*-*-*-*-*';

    $c->create(qw(rectangle 245 195 255 205 -outline black -fill red));

    # First, create the text item and give it bindings so it can be edited.
	
    $c->addtag('text', 'withtag', $c->create('text', 250, 200, -text => 'This is just a string of text to demonstrate the ' .
					     'text facilities of canvas widgets. You can point, click, and type.  You can ' .
					     'also select and then delete with Control-d.', -width => 440, -anchor => 'n',
					     -font => $font, -justify => 'left'));
    $c->bind('text', '<1>' => sub {textB1Press(@_)});
    $c->bind('text', '<B1-Motion>' => sub {textB1Move(@_)});
    $c->bind('text', '<Shift-1>' => sub {
	my($c) = @_;
        my $e = $c->XEvent;
	my($x, $y) = ($e->x, $e->y);
	$c->select('adjust', 'current', "\@$x,$y");
    });
    $c->bind('text', '<Shift-B1-Motion>' => sub {textB1Move(@_)});
    $c->bind('text', '<KeyPress>' => sub {
	my($c) = @_;
        my $e = $c->XEvent;
	my $A = $e->A;
	$c->insert('text', 'insert', "$A");
    });
    $c->bind('text', '<Shift-KeyPress>' => sub {
	my($c) = @_;
        my $e = $c->XEvent;
	my $A = $e->A;
	$c->insert('text', 'insert', "$A");
    });
    $c->bind('text', '<Return>' => sub {
	my($c) = @_;
        my $e = $c->XEvent;
	$c->insert('text', 'insert', "\\n");
    });
    $c->bind('text', '<Control-h>' => sub {textBs(@_)});
    $c->bind('text', '<Delete>' => sub {textBs(@_)});
    $c->bind('text', '<Control-d>' => sub {
	my($c, $e) = @_;
        my $e = $c->XEvent;
	$c->dchars('text', 'sel.first', 'sel.last');
    });
    $c->bind('text', '<Control-v>' => sub {
	my($c, $e) = @_;
        my $e = $c->XEvent;
	$c->insert('text', 'insert', Tk::selection('get'));
    });

    # Next, create some items that allow the text's anchor position to be edited.

    my($x, $y, $color) = (50, 50, 'LightSkyBlue1');
    mkTextConfig $c, $x,    $y,    -anchor => 'se',      $color;
    mkTextConfig $c, $x+30, $y,    -anchor => 's',       $color;
    mkTextConfig $c, $x+60, $y,    -anchor => 'sw',      $color;
    mkTextConfig $c, $x,    $y+30, -anchor => 'e',       $color;
    mkTextConfig $c, $x+30, $y+30, -anchor => 'center',  $color;
    mkTextConfig $c, $x+60, $y+30, -anchor => 'w',       $color;
    mkTextConfig $c, $x,    $y+60, -anchor => 'ne',      $color;
    mkTextConfig $c, $x+30, $y+60, -anchor => 'n',       $color;
    mkTextConfig $c, $x+60, $y+60, -anchor => 'nw',      $color;
    my $item = $c->create('rectangle', $x+40, $y+40, $x+50, $y+50, -outline => 'black', -fill => 'red');
    $c->bind($item, '<1>' => sub {
	my($c, $e) = @_;
        my $e = $c->XEvent;
	$c->itemconfigure('text', -anchor => 'center');
    });
    $c->create('text', $x+45, $y-5, -text => 'Text Position', -anchor => 's',
	       -font => '-Adobe-times-medium-r-normal--*-240-*-*-*-*-*-*', -fill => 'brown');

    # Lastly, create some items that allow the text's justification to be changed.
    
    $x = 350; $y = 50; $color = 'SeaGreen2';
    mkTextConfig $c, $x,    $y,    -justify => 'left',   $color;
    mkTextConfig $c, $x+30, $y,    -justify => 'center', $color;
    mkTextConfig $c, $x+60, $y,    -justify => 'right',  $color;
    $c->create('text', $x+45, $y-5, -text => 'Justification', -anchor => 's',
	       -font => '-Adobe-times-medium-r-normal--*-240-*-*-*-*-*-*', -fill => 'brown');

    $c->bind('config', '<Enter>' =>  sub {textEnter(@_)});
    $c->bind('config', '<Leave>' => sub {
	my($c, $e) = @_;
        my $e = $c->XEvent;
	$c->itemconfigure('current', -fill => $mkCanvText::textConfigFill);
    });

} # end mkCanvText


sub mkTextConfig {

    my($w, $x, $y, $option, $value, $color) = @_;

    my $item = $w->create('rectangle', $x, $y, $x+30, $y+30, -outline => 'black', -fill => $color, -width => 1);
    $w->bind($item, '<1>', [sub {
	my($w, $option, $value, $e) = @_;
        my $e = $w->XEvent;

	$w->itemconfigure('text', $option => $value);
    }, $option, $value]);
    $w->addtag('config', 'withtag', $item);

} # end mkTextConfig

$mkCanvText::textConfigFill = 'purple';

sub textEnter {

    my($w) = @_;
    my $e = $w->XEvent;

    $mkCanvText::textConfigFill =  ($w->itemconfigure('current', -fill))[4];
    $w->itemconfigure('current', -fill => 'black');

} # end textEnter


sub textB1Press {

    my($w) = @_;
    my $e = $w->XEvent;

    my($x, $y) = ($e->x, $e->y);
    $w->icursor('current', "\@$x,$y");
    $w->focus('current');
    $w->Tk::focus;
    $w->select('from', 'current', "\@$x,$y");

} # end textB1Press


sub textB1Move {

    my($w) = @_;
    my $e = $w->XEvent;

    my($x, $y) = ($e->x, $e->y);
    $w->select('to', 'current', "\@$x,$y");

} # end textB1Move


sub textBs {

    my($w) = @_;
    my $w = $c->XEvent;

    my $char = $w->index('text', 'insert') - 1;
    $w->dchar('text', $char) if $char >= 0;

} # end textBs


1;