util/X86LINUX64/lib/tk8.6/demos/ctext.tcl

   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 if {![info exists widgetDemo]} {
   7     error "This script should be run from the \"widget\" demo."
   8 }
   9
  10 package require Tk
  11
  12 set w .ctext
  13 catch {destroy $w}
  14 toplevel $w
  15 wm title $w "Canvas Text Demonstration"
  16 wm iconname $w "Text"
  17 positionWindow $w
  18 set c $w.c
  19
  20 label $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."
  28 pack $w.msg -side top
  29
  30 ## See Code / Dismiss buttons
  31 set btns [addSeeDismiss $w.buttons $w]
  32 pack $btns -side bottom -fill x
  33
  34 canvas $c -relief flat -borderwidth 0 -width 500 -height 350
  35 pack $w.c -side top -expand yes -fill both
  36
  37 set 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 been defined to support editing (see above)." -width 440 -anchor n -font $textFont -justify left]
  44 $c bind text <1> "textB1Press $c %x %y"
  45 $c bind text <B1-Motion> "textB1Move $c %x %y"
  46 $c bind text <Shift-1> "$c select adjust current @%x,%y"
  47 $c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
  48 $c bind text <KeyPress> "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"
  53 $c bind text <2> "textPaste $c @%x,%y"
  54
  55 # Next, create some items that allow the text's anchor position
  56 # to be edited.
  57
  58 proc mkTextConfigBox {w x y option value color} {
  59     set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \
  60             -outline black -fill $color -width 1]
  61     $w bind $item <1> "$w itemconf text $option $value"
  62     $w addtag config withtag $item
  63 }
  64 proc mkTextConfigPie {w x y a option value color} {
  65     set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \
  66             -start [expr {$a-15}] -extent 30 -outline black -fill $color \
  67             -width 1]
  68     $w bind $item <1> "$w itemconf text $option $value"
  69     $w addtag config withtag $item
  70 }
  71
  72 set x 50
  73 set y 50
  74 set color LightSkyBlue1
  75 mkTextConfigBox $c $x $y -anchor se $color
  76 mkTextConfigBox $c [expr {$x+30}] [expr {$y   }] -anchor s      $color
  77 mkTextConfigBox $c [expr {$x+60}] [expr {$y   }] -anchor sw     $color
  78 mkTextConfigBox $c [expr {$x   }] [expr {$y+30}] -anchor e      $color
  79 mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color
  80 mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w      $color
  81 mkTextConfigBox $c [expr {$x   }] [expr {$y+60}] -anchor ne     $color
  82 mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n      $color
  83 mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw     $color
  84 set item [$c create rect \
  85         [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \
  86         -outline black -fill red]
  87 $c bind $item <1> "$c itemconf text -anchor center"
  88 $c create text [expr {$x+45}] [expr {$y-5}] \
  89         -text {Text Position}  -anchor s  -font {Times 20}  -fill brown
  90
  91 # Now create some items that allow the text's angle to be changed.
  92
  93 set x 205
  94 set y 50
  95 set color Yellow
  96 mkTextConfigPie $c $x $y   0 -angle  90 $color
  97 mkTextConfigPie $c $x $y  30 -angle 120 $color
  98 mkTextConfigPie $c $x $y  60 -angle 150 $color
  99 mkTextConfigPie $c $x $y  90 -angle 180 $color
 100 mkTextConfigPie $c $x $y 120 -angle 210 $color
 101 mkTextConfigPie $c $x $y 150 -angle 240 $color
 102 mkTextConfigPie $c $x $y 180 -angle 270 $color
 103 mkTextConfigPie $c $x $y 210 -angle 300 $color
 104 mkTextConfigPie $c $x $y 240 -angle 330 $color
 105 mkTextConfigPie $c $x $y 270 -angle   0 $color
 106 mkTextConfigPie $c $x $y 300 -angle  30 $color
 107 mkTextConfigPie $c $x $y 330 -angle  60 $color
 108 $c create text [expr {$x+45}] [expr {$y-5}] \
 109         -text {Text Angle}  -anchor s  -font {Times 20}  -fill brown
 110
 111 # Lastly, create some items that allow the text's justification to be
 112 # changed.
 113
 114 set x 350
 115 set y 50
 116 set color SeaGreen2
 117 mkTextConfigBox $c $x $y -justify left $color
 118 mkTextConfigBox $c [expr {$x+30}] $y -justify center $color
 119 mkTextConfigBox $c [expr {$x+60}] $y -justify right $color
 120 $c create text [expr {$x+45}] [expr {$y-5}] \
 121         -text {Justification}  -anchor s  -font {Times 20}  -fill brown
 122
 123 $c bind config <Enter> "textEnter $c"
 124 $c bind config <Leave> "$c itemconf current -fill \$textConfigFill"
 125
 126 set textConfigFill {}
 127
 128 proc textEnter {w} {
 129     global textConfigFill
 130     set textConfigFill [lindex [$w itemconfig current -fill] 4]
 131     $w itemconfig current -fill black
 132 }
 133
 134 proc textInsert {w string} {
 135     if {$string == ""} {
 136         return
 137     }
 138     catch {$w dchars text sel.first sel.last}
 139     $w insert text insert $string
 140 }
 141
 142 proc textPaste {w pos} {
 143     catch {
 144         $w insert text $pos [selection get]
 145     }
 146 }
 147
 148 proc textB1Press {w x y} {
 149     $w icursor current @$x,$y
 150     $w focus current
 151     focus $w
 152     $w select from current @$x,$y
 153 }
 154
 155 proc textB1Move {w x y} {
 156     $w select to current @$x,$y
 157 }
 158
 159 proc textBs {w} {
 160     if {![catch {$w dchars text sel.first sel.last}]} {
 161         return
 162     }
 163     set char [expr {[$w index text insert] - 1}]
 164     if {$char >= 0} {$w dchar text $char}
 165 }
 166
 167 proc textDel {w} {
 168     if {![catch {$w dchars text sel.first sel.last}]} {
 169         return
 170     }
 171     $w dchars text insert
 172 }