mingw/lib/tk8.4/demos/twind.tcl

   1 # twind.tcl --
   2 #
   3 # This demonstration script creates a text widget with a bunch of
   4 # embedded windows.
   5 #
   6 # RCS: @(#) $Id: twind.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
   7
   8 if {![info exists widgetDemo]} {
   9     error "This script should be run from the \"widget\" demo."
  10 }
  11
  12 set w .twind
  13 catch {destroy $w}
  14 toplevel $w
  15 wm title $w "Text Demonstration - Embedded Windows"
  16 wm iconname $w "Embedded Windows"
  17 positionWindow $w
  18
  19 frame $w.buttons
  20 pack $w.buttons -side bottom -fill x -pady 2m
  21 button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  22 button $w.buttons.code -text "See Code" -command "showCode $w"
  23 pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  24
  25 frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken
  26 set t $w.f.text
  27 text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
  28         -height 35 -wrap word -highlightthickness 0 -borderwidth 0
  29 pack $t -expand  yes -fill both
  30 scrollbar $w.scroll -command "$t yview"
  31 pack $w.scroll -side right -fill y
  32 pack $w.f -expand yes -fill both
  33 $t tag configure center -justify center -spacing1 5m -spacing3 5m
  34 $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
  35         -spacing1 3m -spacing2 0 -spacing3 0
  36
  37 button $t.on -text "Turn On" -command "textWindOn $w" \
  38         -cursor top_left_arrow
  39 button $t.off -text "Turn Off" -command "textWindOff $w" \
  40         -cursor top_left_arrow
  41 button $t.click -text "Click Here" -command "textWindPlot $t" \
  42         -cursor top_left_arrow
  43 button $t.delete -text "Delete" -command "textWindDel $w" \
  44         -cursor top_left_arrow
  45
  46 $t insert end "A text widget can contain other widgets embedded "
  47 $t insert end "it.  These are called \"embedded windows\", "
  48 $t insert end "and they can consist of arbitrary widgets.  "
  49 $t insert end "For example, here are two embedded button "
  50 $t insert end "widgets.  You can click on the first button to "
  51 $t window create end -window $t.on
  52 $t insert end " horizontal scrolling, which also turns off "
  53 $t insert end "word wrapping.  Or, you can click on the second "
  54 $t insert end "button to\n"
  55 $t window create end -window $t.off
  56 $t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
  57
  58 $t insert end "Or, here is another example.  If you "
  59 $t window create end -window $t.click
  60 $t insert end " a canvas displaying an x-y plot will appear right here."
  61 $t mark set plot insert
  62 $t mark gravity plot left
  63 $t insert end "  You can drag the data points around with the mouse, "
  64 $t insert end "or you can click here to "
  65 $t window create end -window $t.delete
  66 $t insert end " the plot again.\n\n"
  67
  68 $t insert end "You may also find it useful to put embedded windows in "
  69 $t insert end "a text without any actual text.  In this case the "
  70 $t insert end "text widget acts like a geometry manager.  For "
  71 $t insert end "example, here is a collection of buttons laid out "
  72 $t insert end "neatly into rows by the text widget.  These buttons "
  73 $t insert end "can be used to change the background color of the "
  74 $t insert end "text widget (\"Default\" restores the color to "
  75 $t insert end "its default).  If you click on the button labeled "
  76 $t insert end "\"Short\", it changes to a longer string so that "
  77 $t insert end "you can see how the text widget automatically "
  78 $t insert end "changes the layout.  Click on the button again "
  79 $t insert end "to restore the short string.\n"
  80
  81 button $t.default -text Default -command "embDefBg $t" \
  82         -cursor top_left_arrow
  83 $t window create end -window $t.default -padx 3
  84 global embToggle
  85 set embToggle Short
  86 checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
  87         -variable embToggle -onvalue "A much longer string" \
  88         -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
  89 $t window create end -window $t.toggle -padx 3 -pady 2
  90 set i 1
  91 foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
  92         SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
  93         DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
  94         Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
  95     button $t.color$i -text $color -cursor top_left_arrow -command \
  96             "$t configure -bg $color"
  97     $t window create end -window $t.color$i -padx 3 -pady 2
  98     incr i
  99 }
 100 $t tag add buttons $t.default end
 101
 102 proc textWindOn w {
 103     catch {destroy $w.scroll2}
 104     set t $w.f.text
 105     scrollbar $w.scroll2 -orient horizontal -command "$t xview"
 106     pack $w.scroll2 -after $w.buttons -side bottom -fill x
 107     $t configure -xscrollcommand "$w.scroll2 set" -wrap none
 108 }
 109
 110 proc textWindOff w {
 111     catch {destroy $w.scroll2}
 112     set t $w.f.text
 113     $t configure -xscrollcommand {} -wrap word
 114 }
 115
 116 proc textWindPlot t {
 117     set c $t.c
 118     if {[winfo exists $c]} {
 119         return
 120     }
 121     canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
 122
 123     set font {Helvetica 18}
 124
 125     $c create line 100 250 400 250 -width 2
 126     $c create line 100 250 100 50 -width 2
 127     $c create text 225 20 -text "A Simple Plot" -font $font -fill brown
 128
 129     for {set i 0} {$i <= 10} {incr i} {
 130         set x [expr {100 + ($i*30)}]
 131         $c create line $x 250 $x 245 -width 2
 132         $c create text $x 254 -text [expr {10*$i}] -anchor n -font $font
 133     }
 134     for {set i 0} {$i <= 5} {incr i} {
 135         set y [expr {250 - ($i*40)}]
 136         $c create line 100 $y 105 $y -width 2
 137         $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font
 138     }
 139
 140     foreach point {
 141         {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
 142     } {
 143         set x [expr {100 + (3*[lindex $point 0])}]
 144         set y [expr {250 - (4*[lindex $point 1])/5}]
 145         set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
 146                 [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
 147                 -fill SkyBlue2]
 148         $c addtag point withtag $item
 149     }
 150
 151     $c bind point <Any-Enter> "$c itemconfig current -fill red"
 152     $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2"
 153     $c bind point <1> "embPlotDown $c %x %y"
 154     $c bind point <ButtonRelease-1> "$c dtag selected"
 155     bind $c <B1-Motion> "embPlotMove $c %x %y"
 156     while {[string first [$t get plot] " \t\n"] >= 0} {
 157         $t delete plot
 158     }
 159     $t insert plot "\n"
 160     $t window create plot -window $c
 161     $t tag add center plot
 162     $t insert plot "\n"
 163 }
 164
 165 set embPlot(lastX) 0
 166 set embPlot(lastY) 0
 167
 168 proc embPlotDown {w x y} {
 169     global embPlot
 170     $w dtag selected
 171     $w addtag selected withtag current
 172     $w raise current
 173     set embPlot(lastX) $x
 174     set embPlot(lastY) $y
 175 }
 176
 177 proc embPlotMove {w x y} {
 178     global embPlot
 179     $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}]
 180     set embPlot(lastX) $x
 181     set embPlot(lastY) $y
 182 }
 183
 184 proc textWindDel w {
 185     set t $w.f.text
 186     if {[winfo exists $t.c]} {
 187         $t delete $t.c
 188         while {[string first [$t get plot] " \t\n"] >= 0} {
 189             $t delete plot
 190         }
 191         $t insert plot "  "
 192     }
 193 }
 194
 195 proc embDefBg t {
 196     $t configure -background [lindex [$t configure -background] 3]
 197 }