← Back to branch summary

~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to demos/demos/widget_lib/mkCanvText.pl

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
http://bugs.debian.org/237942
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
demos/demos/widget_lib/mkCanvText.pl
1
 
 
2
 
sub mkTextConfig;
3
 
sub textBs;
4
 
sub textB1Move;
5
 
sub textB1Press;
6
 
sub textEnter;
7
 
 
8
 
sub mkCanvText {
9
 
 
10
 
    # Create a window containing a canvas displaying a text string and allowing the string to be edited and re-anchored.
11
 
 
12
 
    $mkCanvText->destroy if Exists($mkCanvText);
13
 
    $mkCanvText = $top->Toplevel();
14
 
    my $w = $mkCanvText;
15
 
    dpos $w;
16
 
    $w->title('Canvas Text Demonstration');
17
 
    $w->iconname('Text');
18
 
 
19
 
    my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '5i',
20
 
                           -justify => 'left', -text => 'This window displays a string of text to demonstrate the text ' .
21
 
                           'facilities of canvas widgets.  You can point, click, and type.  You can also select and then ' .
22
 
                           'delete with Control-d.  You can copy the selection with Control-v.  You can click in the boxes ' .
23
 
                           'to adjust the position of the text relative to its positioning point or change its justification.');
24
 
    my $c = $w->Canvas(-relief => 'flat', -bd => 0, -width => '500', -height => '400');
25
 
    my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
26
 
    $w_msg->pack(-side => 'top', -fill => 'both');
27
 
    $c->pack(-side => 'top', -expand => 'yes', -fill => 'both');
28
 
    $w_ok->pack(-side => 'bottom', -pady => '5', -anchor => 'center');
29
 
 
30
 
    $font = '-Adobe-helvetica-medium-r-normal--*-240-*-*-*-*-*-*';
31
 
 
32
 
    $c->create(qw(rectangle 245 195 255 205 -outline black -fill red));
33
 
 
34
 
    # First, create the text item and give it bindings so it can be edited.
35
 
        
36
 
    $c->addtag('text', 'withtag', $c->create('text', 250, 200, -text => 'This is just a string of text to demonstrate the ' .
37
 
                                             'text facilities of canvas widgets. You can point, click, and type.  You can ' .
38
 
                                             'also select and then delete with Control-d.', -width => 440, -anchor => 'n',
39
 
                                             -font => $font, -justify => 'left'));
40
 
    $c->bind('text', '<1>' => sub {textB1Press(@_)});
41
 
    $c->bind('text', '<B1-Motion>' => sub {textB1Move(@_)});
42
 
    $c->bind('text', '<Shift-1>' => sub {
43
 
        my($c) = @_;
44
 
        my $e = $c->XEvent;
45
 
        my($x, $y) = ($e->x, $e->y);
46
 
        $c->select('adjust', 'current', "\@$x,$y");
47
 
    });
48
 
    $c->bind('text', '<Shift-B1-Motion>' => sub {textB1Move(@_)});
49
 
    $c->bind('text', '<KeyPress>' => sub {
50
 
        my($c) = @_;
51
 
        my $e = $c->XEvent;
52
 
        my $A = $e->A;
53
 
        $c->insert('text', 'insert', "$A");
54
 
    });
55
 
    $c->bind('text', '<Shift-KeyPress>' => sub {
56
 
        my($c) = @_;
57
 
        my $e = $c->XEvent;
58
 
        my $A = $e->A;
59
 
        $c->insert('text', 'insert', "$A");
60
 
    });
61
 
    $c->bind('text', '<Return>' => sub {
62
 
        my($c) = @_;
63
 
        my $e = $c->XEvent;
64
 
        $c->insert('text', 'insert', "\\n");
65
 
    });
66
 
    $c->bind('text', '<Control-h>' => sub {textBs(@_)});
67
 
    $c->bind('text', '<Delete>' => sub {textBs(@_)});
68
 
    $c->bind('text', '<Control-d>' => sub {
69
 
        my($c, $e) = @_;
70
 
        my $e = $c->XEvent;
71
 
        $c->dchars('text', 'sel.first', 'sel.last');
72
 
    });
73
 
    $c->bind('text', '<Control-v>' => sub {
74
 
        my($c, $e) = @_;
75
 
        my $e = $c->XEvent;
76
 
        $c->insert('text', 'insert', Tk::selection('get'));
77
 
    });
78
 
 
79
 
    # Next, create some items that allow the text's anchor position to be edited.
80
 
 
81
 
    my($x, $y, $color) = (50, 50, 'LightSkyBlue1');
82
 
    mkTextConfig $c, $x,    $y,    -anchor => 'se',      $color;
83
 
    mkTextConfig $c, $x+30, $y,    -anchor => 's',       $color;
84
 
    mkTextConfig $c, $x+60, $y,    -anchor => 'sw',      $color;
85
 
    mkTextConfig $c, $x,    $y+30, -anchor => 'e',       $color;
86
 
    mkTextConfig $c, $x+30, $y+30, -anchor => 'center',  $color;
87
 
    mkTextConfig $c, $x+60, $y+30, -anchor => 'w',       $color;
88
 
    mkTextConfig $c, $x,    $y+60, -anchor => 'ne',      $color;
89
 
    mkTextConfig $c, $x+30, $y+60, -anchor => 'n',       $color;
90
 
    mkTextConfig $c, $x+60, $y+60, -anchor => 'nw',      $color;
91
 
    my $item = $c->create('rectangle', $x+40, $y+40, $x+50, $y+50, -outline => 'black', -fill => 'red');
92
 
    $c->bind($item, '<1>' => sub {
93
 
        my($c, $e) = @_;
94
 
        my $e = $c->XEvent;
95
 
        $c->itemconfigure('text', -anchor => 'center');
96
 
    });
97
 
    $c->create('text', $x+45, $y-5, -text => 'Text Position', -anchor => 's',
98
 
               -font => '-Adobe-times-medium-r-normal--*-240-*-*-*-*-*-*', -fill => 'brown');
99
 
 
100
 
    # Lastly, create some items that allow the text's justification to be changed.
101
 
    
102
 
    $x = 350; $y = 50; $color = 'SeaGreen2';
103
 
    mkTextConfig $c, $x,    $y,    -justify => 'left',   $color;
104
 
    mkTextConfig $c, $x+30, $y,    -justify => 'center', $color;
105
 
    mkTextConfig $c, $x+60, $y,    -justify => 'right',  $color;
106
 
    $c->create('text', $x+45, $y-5, -text => 'Justification', -anchor => 's',
107
 
               -font => '-Adobe-times-medium-r-normal--*-240-*-*-*-*-*-*', -fill => 'brown');
108
 
 
109
 
    $c->bind('config', '<Enter>' =>  sub {textEnter(@_)});
110
 
    $c->bind('config', '<Leave>' => sub {
111
 
        my($c, $e) = @_;
112
 
        my $e = $c->XEvent;
113
 
        $c->itemconfigure('current', -fill => $mkCanvText::textConfigFill);
114
 
    });
115
 
 
116
 
} # end mkCanvText
117
 
 
118
 
 
119
 
sub mkTextConfig {
120
 
 
121
 
    my($w, $x, $y, $option, $value, $color) = @_;
122
 
 
123
 
    my $item = $w->create('rectangle', $x, $y, $x+30, $y+30, -outline => 'black', -fill => $color, -width => 1);
124
 
    $w->bind($item, '<1>', [sub {
125
 
        my($w, $option, $value, $e) = @_;
126
 
        my $e = $w->XEvent;
127
 
 
128
 
        $w->itemconfigure('text', $option => $value);
129
 
    }, $option, $value]);
130
 
    $w->addtag('config', 'withtag', $item);
131
 
 
132
 
} # end mkTextConfig
133
 
 
134
 
$mkCanvText::textConfigFill = 'purple';
135
 
 
136
 
sub textEnter {
137
 
 
138
 
    my($w) = @_;
139
 
    my $e = $w->XEvent;
140
 
 
141
 
    $mkCanvText::textConfigFill =  ($w->itemconfigure('current', -fill))[4];
142
 
    $w->itemconfigure('current', -fill => 'black');
143
 
 
144
 
} # end textEnter
145
 
 
146
 
 
147
 
sub textB1Press {
148
 
 
149
 
    my($w) = @_;
150
 
    my $e = $w->XEvent;
151
 
 
152
 
    my($x, $y) = ($e->x, $e->y);
153
 
    $w->icursor('current', "\@$x,$y");
154
 
    $w->focus('current');
155
 
    $w->Tk::focus;
156
 
    $w->select('from', 'current', "\@$x,$y");
157
 
 
158
 
} # end textB1Press
159
 
 
160
 
 
161
 
sub textB1Move {
162
 
 
163
 
    my($w) = @_;
164
 
    my $e = $w->XEvent;
165
 
 
166
 
    my($x, $y) = ($e->x, $e->y);
167
 
    $w->select('to', 'current', "\@$x,$y");
168
 
 
169
 
} # end textB1Move
170
 
 
171
 
 
172
 
sub textBs {
173
 
 
174
 
    my($w) = @_;
175
 
    my $w = $c->XEvent;
176
 
 
177
 
    my $char = $w->index('text', 'insert') - 1;
178
 
    $w->dchar('text', $char) if $char >= 0;
179
 
 
180
 
} # end textBs
181
 
 
182
 
 
183
 
1;
184
 
 
185