1# ctext.tcl --
2#
3# This demonstration script creates a canvas widget with a text
4# item that can be edited and reconfigured in various ways.
5
6if {![info exists widgetDemo]} {
7    error "This script should be run from the \"widget\" demo."
8}
9
10package require Tk
11
12set w .ctext
13catch {destroy $w}
14toplevel $w
15wm title $w "Canvas Text Demonstration"
16wm iconname $w "Text"
17positionWindow $w
18set c $w.c
19
20label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets.  You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification, and on a pie slice to change its angle.  The text also supports the following simple bindings for editing:
21  1. You can point, click, and type.
22  2. You can also select with button 1.
23  3. You can copy the selection to the mouse position with button 2.
24  4. Backspace and Control+h delete the selection if there is one;
25     otherwise they delete the character just before the insertion cursor.
26  5. Delete deletes the selection if there is one; otherwise it deletes
27     the character just after the insertion cursor."
28pack $w.msg -side top
29
30## See Code / Dismiss buttons
31set btns [addSeeDismiss $w.buttons $w]
32pack $btns -side bottom -fill x
33
34canvas $c -relief flat -borderwidth 0 -width 500 -height 350
35pack $w.c -side top -expand yes -fill both
36
37set textFont {Helvetica 24}
38
39$c create rectangle 245 195 255 205 -outline black -fill red
40
41# First, create the text item and give it bindings so it can be edited.
42
43$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. Bindings have been defined to support editing (see above)." -width 440 -anchor n -font $textFont -justify left]
44$c bind text <Button-1> "textB1Press $c %x %y"
45$c bind text <B1-Motion> "textB1Move $c %x %y"
46$c bind text <Shift-Button-1> "$c select adjust current @%x,%y"
47$c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
48$c bind text <Key> "textInsert $c %A"
49$c bind text <Return> "textInsert $c \\n"
50$c bind text <Control-h> "textBs $c"
51$c bind text <BackSpace> "textBs $c"
52$c bind text <Delete> "textDel $c"
53if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
54    $c bind text <Button-3> "textPaste $c @%x,%y"
55} else {
56    $c bind text <Button-2> "textPaste $c @%x,%y"
57}
58
59# Next, create some items that allow the text's anchor position
60# to be edited.
61
62proc mkTextConfigBox {w x y option value color} {
63    set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \
64	    -outline black -fill $color -width 1]
65    $w bind $item <Button-1> "$w itemconf text $option $value"
66    $w addtag config withtag $item
67}
68proc mkTextConfigPie {w x y a option value color} {
69    set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \
70	    -start [expr {$a-15}] -extent 30 -outline black -fill $color \
71	    -width 1]
72    $w bind $item <Button-1> "$w itemconf text $option $value"
73    $w addtag config withtag $item
74}
75
76set x 50
77set y 50
78set color LightSkyBlue1
79mkTextConfigBox $c $x $y -anchor se $color
80mkTextConfigBox $c [expr {$x+30}] [expr {$y   }] -anchor s      $color
81mkTextConfigBox $c [expr {$x+60}] [expr {$y   }] -anchor sw     $color
82mkTextConfigBox $c [expr {$x   }] [expr {$y+30}] -anchor e      $color
83mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color
84mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w      $color
85mkTextConfigBox $c [expr {$x   }] [expr {$y+60}] -anchor ne     $color
86mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n      $color
87mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw     $color
88set item [$c create rect \
89	[expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \
90	-outline black -fill red]
91$c bind $item <Button-1> "$c itemconf text -anchor center"
92$c create text [expr {$x+45}] [expr {$y-5}] \
93	-text {Text Position}  -anchor s  -font {Times 20}  -fill brown
94
95# Now create some items that allow the text's angle to be changed.
96
97set x 205
98set y 50
99set color Yellow
100mkTextConfigPie $c $x $y   0 -angle  90 $color
101mkTextConfigPie $c $x $y  30 -angle 120 $color
102mkTextConfigPie $c $x $y  60 -angle 150 $color
103mkTextConfigPie $c $x $y  90 -angle 180 $color
104mkTextConfigPie $c $x $y 120 -angle 210 $color
105mkTextConfigPie $c $x $y 150 -angle 240 $color
106mkTextConfigPie $c $x $y 180 -angle 270 $color
107mkTextConfigPie $c $x $y 210 -angle 300 $color
108mkTextConfigPie $c $x $y 240 -angle 330 $color
109mkTextConfigPie $c $x $y 270 -angle   0 $color
110mkTextConfigPie $c $x $y 300 -angle  30 $color
111mkTextConfigPie $c $x $y 330 -angle  60 $color
112$c create text [expr {$x+45}] [expr {$y-5}] \
113	-text {Text Angle}  -anchor s  -font {Times 20}  -fill brown
114
115# Lastly, create some items that allow the text's justification to be
116# changed.
117
118set x 350
119set y 50
120set color SeaGreen2
121mkTextConfigBox $c $x $y -justify left $color
122mkTextConfigBox $c [expr {$x+30}] $y -justify center $color
123mkTextConfigBox $c [expr {$x+60}] $y -justify right $color
124$c create text [expr {$x+45}] [expr {$y-5}] \
125	-text {Justification}  -anchor s  -font {Times 20}  -fill brown
126
127$c bind config <Enter> "textEnter $c"
128$c bind config <Leave> "$c itemconf current -fill \$textConfigFill"
129
130set textConfigFill {}
131
132proc textEnter {w} {
133    global textConfigFill
134    set textConfigFill [lindex [$w itemconfig current -fill] 4]
135    $w itemconfig current -fill black
136}
137
138proc textInsert {w string} {
139    if {$string == ""} {
140	return
141    }
142    catch {$w dchars text sel.first sel.last}
143    $w insert text insert $string
144}
145
146proc textPaste {w pos} {
147    catch {
148	$w insert text $pos [selection get]
149    }
150}
151
152proc textB1Press {w x y} {
153    $w icursor current @$x,$y
154    $w focus current
155    focus $w
156    $w select from current @$x,$y
157}
158
159proc textB1Move {w x y} {
160    $w select to current @$x,$y
161}
162
163proc textBs {w} {
164    if {![catch {$w dchars text sel.first sel.last}]} {
165	return
166    }
167    set char [expr {[$w index text insert] - 1}]
168    if {$char >= 0} {$w dchar text $char}
169}
170
171proc textDel {w} {
172    if {![catch {$w dchars text sel.first sel.last}]} {
173	return
174    }
175    $w dchars text insert
176}
177