[37] | 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.2 1998/09/14 18:23:30 stanton 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 {{12 56} {20 94} {33 98} {32 120} {61 180} |
---|
| 141 | {75 160} {98 223}} { |
---|
| 142 | set x [expr {100 + (3*[lindex $point 0])}] |
---|
| 143 | set y [expr {250 - (4*[lindex $point 1])/5}] |
---|
| 144 | set item [$c create oval [expr $x-6] [expr $y-6] \ |
---|
| 145 | [expr $x+6] [expr $y+6] -width 1 -outline black \ |
---|
| 146 | -fill SkyBlue2] |
---|
| 147 | $c addtag point withtag $item |
---|
| 148 | } |
---|
| 149 | |
---|
| 150 | $c bind point <Any-Enter> "$c itemconfig current -fill red" |
---|
| 151 | $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2" |
---|
| 152 | $c bind point <1> "embPlotDown $c %x %y" |
---|
| 153 | $c bind point <ButtonRelease-1> "$c dtag selected" |
---|
| 154 | bind $c <B1-Motion> "embPlotMove $c %x %y" |
---|
| 155 | while {[string first [$t get plot] " \t\n"] >= 0} { |
---|
| 156 | $t delete plot |
---|
| 157 | } |
---|
| 158 | $t insert plot "\n" |
---|
| 159 | $t window create plot -window $c |
---|
| 160 | $t tag add center plot |
---|
| 161 | $t insert plot "\n" |
---|
| 162 | } |
---|
| 163 | |
---|
| 164 | set embPlot(lastX) 0 |
---|
| 165 | set embPlot(lastY) 0 |
---|
| 166 | |
---|
| 167 | proc embPlotDown {w x y} { |
---|
| 168 | global embPlot |
---|
| 169 | $w dtag selected |
---|
| 170 | $w addtag selected withtag current |
---|
| 171 | $w raise current |
---|
| 172 | set embPlot(lastX) $x |
---|
| 173 | set embPlot(lastY) $y |
---|
| 174 | } |
---|
| 175 | |
---|
| 176 | proc embPlotMove {w x y} { |
---|
| 177 | global embPlot |
---|
| 178 | $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)] |
---|
| 179 | set embPlot(lastX) $x |
---|
| 180 | set embPlot(lastY) $y |
---|
| 181 | } |
---|
| 182 | |
---|
| 183 | proc textWindDel w { |
---|
| 184 | set t $w.f.text |
---|
| 185 | if [winfo exists $t.c] { |
---|
| 186 | $t delete $t.c |
---|
| 187 | while {[string first [$t get plot] " \t\n"] >= 0} { |
---|
| 188 | $t delete plot |
---|
| 189 | } |
---|
| 190 | $t insert plot " " |
---|
| 191 | } |
---|
| 192 | } |
---|
| 193 | |
---|
| 194 | proc embDefBg t { |
---|
| 195 | $t configure -background [lindex [$t configure -background] 3] |
---|
| 196 | } |
---|