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# 6# RCS: @(#) $Id: ctext.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ 7 8if {![info exists widgetDemo]} { 9 error "This script should be run from the \"widget\" demo." 10} 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. 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 30frame $w.buttons 31pack $w.buttons -side bottom -fill x -pady 2m 32button $w.buttons.dismiss -text Dismiss -command "destroy $w" 33button $w.buttons.code -text "See Code" -command "showCode $w" 34pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 35 36canvas $c -relief flat -borderwidth 0 -width 500 -height 350 37pack $w.c -side top -expand yes -fill both 38 39set textFont {Helvetica 24} 40 41$c create rectangle 245 195 255 205 -outline black -fill red 42 43# First, create the text item and give it bindings so it can be edited. 44 45$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 been defined to support editing (see above)." -width 440 -anchor n -font {Helvetica 24} -justify left] 46$c bind text <1> "textB1Press $c %x %y" 47$c bind text <B1-Motion> "textB1Move $c %x %y" 48$c bind text <Shift-1> "$c select adjust current @%x,%y" 49$c bind text <Shift-B1-Motion> "textB1Move $c %x %y" 50$c bind text <KeyPress> "textInsert $c %A" 51$c bind text <Return> "textInsert $c \\n" 52$c bind text <Control-h> "textBs $c" 53$c bind text <BackSpace> "textBs $c" 54$c bind text <Delete> "textDel $c" 55$c bind text <2> "textPaste $c @%x,%y" 56 57# Next, create some items that allow the text's anchor position 58# to be edited. 59 60proc mkTextConfig {w x y option value color} { 61 set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \ 62 -outline black -fill $color -width 1] 63 $w bind $item <1> "$w itemconf text $option $value" 64 $w addtag config withtag $item 65} 66 67set x 50 68set y 50 69set color LightSkyBlue1 70mkTextConfig $c $x $y -anchor se $color 71mkTextConfig $c [expr {$x+30}] [expr {$y }] -anchor s $color 72mkTextConfig $c [expr {$x+60}] [expr {$y }] -anchor sw $color 73mkTextConfig $c [expr {$x }] [expr {$y+30}] -anchor e $color 74mkTextConfig $c [expr {$x+30}] [expr {$y+30}] -anchor center $color 75mkTextConfig $c [expr {$x+60}] [expr {$y+30}] -anchor w $color 76mkTextConfig $c [expr {$x }] [expr {$y+60}] -anchor ne $color 77mkTextConfig $c [expr {$x+30}] [expr {$y+60}] -anchor n $color 78mkTextConfig $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color 79set item [$c create rect \ 80 [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \ 81 -outline black -fill red] 82$c bind $item <1> "$c itemconf text -anchor center" 83$c create text [expr {$x+45}] [expr {$y-5}] \ 84 -text {Text Position} -anchor s -font {Times 24} -fill brown 85 86# Lastly, create some items that allow the text's justification to be 87# changed. 88 89set x 350 90set y 50 91set color SeaGreen2 92mkTextConfig $c $x $y -justify left $color 93mkTextConfig $c [expr {$x+30}] $y -justify center $color 94mkTextConfig $c [expr {$x+60}] $y -justify right $color 95$c create text [expr {$x+45}] [expr {$y-5}] \ 96 -text {Justification} -anchor s -font {Times 24} -fill brown 97 98$c bind config <Enter> "textEnter $c" 99$c bind config <Leave> "$c itemconf current -fill \$textConfigFill" 100 101set textConfigFill {} 102 103proc textEnter {w} { 104 global textConfigFill 105 set textConfigFill [lindex [$w itemconfig current -fill] 4] 106 $w itemconfig current -fill black 107} 108 109proc textInsert {w string} { 110 if {$string == ""} { 111 return 112 } 113 catch {$w dchars text sel.first sel.last} 114 $w insert text insert $string 115} 116 117proc textPaste {w pos} { 118 catch { 119 $w insert text $pos [selection get] 120 } 121} 122 123proc textB1Press {w x y} { 124 $w icursor current @$x,$y 125 $w focus current 126 focus $w 127 $w select from current @$x,$y 128} 129 130proc textB1Move {w x y} { 131 $w select to current @$x,$y 132} 133 134proc textBs {w} { 135 if {![catch {$w dchars text sel.first sel.last}]} { 136 return 137 } 138 set char [expr {[$w index text insert] - 1}] 139 if {$char >= 0} {$w dchar text $char} 140} 141 142proc textDel {w} { 143 if {![catch {$w dchars text sel.first sel.last}]} { 144 return 145 } 146 $w dchars text insert 147} 148