OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [library/] [demos/] [widget] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
#!/bin/sh
2
# the next line restarts using wish \
3
exec wish "$0" "$@"
4
 
5
# widget --
6
# This script demonstrates the various widgets provided by Tk,
7
# along with many of the features of the Tk toolkit.  This file
8
# only contains code to generate the main window for the
9
# application, which invokes individual demonstrations.  The
10
# code for the actual demonstrations is contained in separate
11
# ".tcl" files is this directory, which are sourced by this script
12
# as needed.
13
#
14
# SCCS: @(#) widget 1.35 97/07/19 15:42:22
15
 
16
eval destroy [winfo child .]
17
wm title . "Widget Demonstration"
18
set widgetDemo 1
19
 
20
#----------------------------------------------------------------
21
# The code below create the main window, consisting of a menu bar
22
# and a text widget that explains how to use the program, plus lists
23
# all of the demos as hypertext items.
24
#----------------------------------------------------------------
25
 
26
set font {Helvetica 14}
27
menu .menuBar -tearoff 0
28
.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
29
menu .menuBar.file -tearoff 0
30
 
31
# On the Mac use the specia .apple menu for the about item
32
if {$tcl_platform(platform) == "macintosh"} {
33
    .menuBar add cascade -menu .menuBar.apple
34
    menu .menuBar.apple -tearoff 0
35
    .menuBar.apple add command -label "About..." -command "aboutBox"
36
} else {
37
    .menuBar.file add command -label "About..." -command "aboutBox" \
38
        -underline 0 -accelerator ""
39
    .menuBar.file add sep
40
}
41
 
42
.menuBar.file add command -label "Quit" -command "exit" -underline 0 \
43
    -accelerator "Meta-Q"
44
. configure -menu .menuBar
45
bind .  aboutBox
46
 
47
frame .statusBar
48
label .statusBar.lab -text "   " -relief sunken -bd 1 \
49
    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
50
label .statusBar.foo -width 8 -relief sunken -bd 1 \
51
    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
52
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
53
pack .statusBar.foo -side left -padx 2
54
pack .statusBar -side bottom -fill x -pady 2
55
 
56
frame .textFrame
57
scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
58
    -takefocus 1
59
pack .s -in .textFrame -side right -fill y
60
text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
61
    -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
62
pack .t -in .textFrame -expand y -fill both -padx 1
63
pack  .textFrame -expand yes -fill both
64
 
65
# Create a bunch of tags to use in the text widget, such as those for
66
# section titles and demo descriptions.  Also define the bindings for
67
# tags.
68
 
69
.t tag configure title -font {Helvetica 18 bold}
70
 
71
# We put some "space" characters to the left and right of each demo description
72
# so that the descriptions are highlighted only when the mouse cursor
73
# is right over them (but not when the cursor is to their left or right)
74
#
75
.t tag configure demospace -lmargin1 1c -lmargin2 1c
76
 
77
 
78
if {[winfo depth .] == 1} {
79
    .t tag configure demo -lmargin1 1c -lmargin2 1c \
80
        -underline 1
81
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
82
        -underline 1
83
    .t tag configure hot -background black -foreground white
84
} else {
85
    .t tag configure demo -lmargin1 1c -lmargin2 1c \
86
        -foreground blue -underline 1
87
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
88
        -foreground #303080 -underline 1
89
    .t tag configure hot -foreground red -underline 1
90
}
91
.t tag bind demo  {
92
    invoke [.t index {@%x,%y}]
93
}
94
set lastLine ""
95
.t tag bind demo  {
96
    set lastLine [.t index {@%x,%y linestart}]
97
    .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
98
    .t config -cursor hand2
99
    showStatus [.t index {@%x,%y}]
100
}
101
.t tag bind demo  {
102
    .t tag remove hot 1.0 end
103
    .t config -cursor xterm
104
    .statusBar.lab config -text ""
105
}
106
.t tag bind demo  {
107
    set newLine [.t index {@%x,%y linestart}]
108
    if {[string compare $newLine $lastLine] != 0} {
109
        .t tag remove hot 1.0 end
110
        set lastLine $newLine
111
 
112
        set tags [.t tag names {@%x,%y}]
113
        set i [lsearch -glob $tags demo-*]
114
        if {$i >= 0} {
115
            .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
116
        }
117
    }
118
    showStatus [.t index {@%x,%y}]
119
}
120
 
121
# Create the text for the text widget.
122
 
123
.t insert end "Tk Widget Demonstrations\n" title
124
.t insert end {
125
This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets.  Each of the numbered lines below describes a demonstration;  you can click on it to invoke the demonstration.  Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration.  If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
126
 
127
}
128
.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title
129
.t insert end " \n " {demospace}
130
.t insert end "1. Labels (text and bitmaps)." {demo demo-label}
131
.t insert end " \n " {demospace}
132
.t insert end "2. Buttons." {demo demo-button}
133
.t insert end " \n " {demospace}
134
.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check}
135
.t insert end " \n " {demospace}
136
.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio}
137
.t insert end " \n " {demospace}
138
.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle}
139
.t insert end " \n " {demospace}
140
.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon}
141
.t insert end " \n " {demospace}
142
.t insert end "7. Two labels displaying images." {demo demo-image1}
143
.t insert end " \n " {demospace}
144
.t insert end "8. A simple user interface for viewing images." \
145
    {demo demo-image2}
146
.t insert end " \n " {demospace}
147
 
148
.t insert end \n {} "Listboxes" title
149
.t insert end " \n " {demospace}
150
.t insert end "1. 50 states." {demo demo-states}
151
.t insert end " \n " {demospace}
152
.t insert end "2. Colors: change the color scheme for the application." \
153
        {demo demo-colors}
154
.t insert end " \n " {demospace}
155
.t insert end "3. A collection of famous sayings." {demo demo-sayings}
156
.t insert end " \n " {demospace}
157
 
158
.t insert end \n {} "Entries" title
159
.t insert end " \n " {demospace}
160
.t insert end "1. Without scrollbars." {demo demo-entry1}
161
.t insert end " \n " {demospace}
162
.t insert end "2. With scrollbars." {demo demo-entry2}
163
.t insert end " \n " {demospace}
164
.t insert end "3. Simple Rolodex-like form." {demo demo-form}
165
.t insert end " \n " {demospace}
166
 
167
.t insert end \n {} "Text" title
168
.t insert end " \n " {demospace}
169
.t insert end "1. Basic editable text." {demo demo-text}
170
.t insert end " \n " {demospace}
171
.t insert end "2. Text display styles." {demo demo-style}
172
.t insert end " \n " {demospace}
173
.t insert end "3. Hypertext (tag bindings)." {demo demo-bind}
174
.t insert end " \n " {demospace}
175
.t insert end "4. A text widget with embedded windows." {demo demo-twind}
176
.t insert end " \n " {demospace}
177
.t insert end "5. A search tool built with a text widget." {demo demo-search}
178
.t insert end " \n " {demospace}
179
 
180
.t insert end \n {} "Canvases" title
181
.t insert end " \n " {demospace}
182
.t insert end "1. The canvas item types." {demo demo-items}
183
.t insert end " \n " {demospace}
184
.t insert end "2. A simple 2-D plot." {demo demo-plot}
185
.t insert end " \n " {demospace}
186
.t insert end "3. Text items in canvases." {demo demo-ctext}
187
.t insert end " \n " {demospace}
188
.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow}
189
.t insert end " \n " {demospace}
190
.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler}
191
.t insert end " \n " {demospace}
192
.t insert end "6. A building floor plan." {demo demo-floor}
193
.t insert end " \n " {demospace}
194
.t insert end "7. A simple scrollable canvas." {demo demo-cscroll}
195
.t insert end " \n " {demospace}
196
 
197
.t insert end \n {} "Scales" title
198
.t insert end " \n " {demospace}
199
.t insert end "1. Vertical scale." {demo demo-vscale}
200
.t insert end " \n " {demospace}
201
.t insert end "2. Horizontal scale." {demo demo-hscale}
202
.t insert end " \n " {demospace}
203
 
204
.t insert end \n {} "Menus" title
205
.t insert end " \n " {demospace}
206
.t insert end "1. Menus and cascades." \
207
        {demo demo-menu}
208
.t insert end " \n " {demospace}
209
.t insert end "2. Menubuttons"\
210
        {demo demo-menubu}
211
.t insert end " \n " {demospace}
212
 
213
.t insert end \n {} "Common Dialogs" title
214
.t insert end " \n " {demospace}
215
.t insert end "1. Message boxes." {demo demo-msgbox}
216
.t insert end " \n " {demospace}
217
.t insert end "2. File selection dialog." {demo demo-filebox}
218
.t insert end " \n " {demospace}
219
.t insert end "3. Color picker." {demo demo-clrpick}
220
.t insert end " \n " {demospace}
221
 
222
.t insert end \n {} "Miscellaneous" title
223
.t insert end " \n " {demospace}
224
.t insert end "1. The built-in bitmaps." {demo demo-bitmap}
225
.t insert end " \n " {demospace}
226
.t insert end "2. A dialog box with a local grab." {demo demo-dialog1}
227
.t insert end " \n " {demospace}
228
.t insert end "3. A dialog box with a global grab." {demo demo-dialog2}
229
.t insert end " \n " {demospace}
230
 
231
.t configure -state disabled
232
focus .s
233
 
234
# positionWindow --
235
# This procedure is invoked by most of the demos to position a
236
# new demo window.
237
#
238
# Arguments:
239
# w -           The name of the window to position.
240
 
241
proc positionWindow w {
242
    wm geometry $w +300+300
243
}
244
 
245
# showVars --
246
# Displays the values of one or more variables in a window, and
247
# updates the display whenever any of the variables changes.
248
#
249
# Arguments:
250
# w -           Name of new window to create for display.
251
# args -        Any number of names of variables.
252
 
253
proc showVars {w args} {
254
    catch {destroy $w}
255
    toplevel $w
256
    wm title $w "Variable values"
257
    label $w.title -text "Variable values:" -width 20 -anchor center \
258
            -font {Helvetica 18}
259
    pack $w.title -side top -fill x
260
    set len 1
261
    foreach i $args {
262
        if {[string length $i] > $len} {
263
            set len [string length $i]
264
        }
265
    }
266
    foreach i $args {
267
        frame $w.$i
268
        label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
269
        label $w.$i.value -textvar $i -anchor w
270
        pack $w.$i.name -side left
271
        pack $w.$i.value -side left -expand 1 -fill x
272
        pack $w.$i -side top -anchor w -fill x
273
    }
274
    button $w.ok -text OK -command "destroy $w" -default active
275
    bind $w  "tkButtonInvoke $w.ok"
276
    pack $w.ok -side bottom -pady 2
277
}
278
 
279
# invoke --
280
# This procedure is called when the user clicks on a demo description.
281
# It is responsible for invoking the demonstration.
282
#
283
# Arguments:
284
# index -       The index of the character that the user clicked on.
285
 
286
proc invoke index {
287
    global tk_library
288
    set tags [.t tag names $index]
289
    set i [lsearch -glob $tags demo-*]
290
    if {$i < 0} {
291
        return
292
    }
293
    set cursor [.t cget -cursor]
294
    .t configure -cursor watch
295
    update
296
    set demo [string range [lindex $tags $i] 5 end]
297
    uplevel [list source [file join $tk_library demos $demo.tcl]]
298
    update
299
    .t configure -cursor $cursor
300
 
301
    .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
302
}
303
 
304
# showStatus --
305
#
306
#       Show the name of the demo program in the status bar. This procedure
307
#       is called when the user moves the cursor over a demo description.
308
#
309
proc showStatus index {
310
    global tk_library
311
    set tags [.t tag names $index]
312
    set i [lsearch -glob $tags demo-*]
313
    set cursor [.t cget -cursor]
314
    if {$i < 0} {
315
        .statusBar.lab config -text " "
316
        set newcursor xterm
317
    } else {
318
        set demo [string range [lindex $tags $i] 5 end]
319
        .statusBar.lab config -text "Run the \"$demo\" sample program"
320
        set newcursor hand2
321
    }
322
    if [string compare $cursor $newcursor] {
323
        .t config -cursor $newcursor
324
    }
325
}
326
 
327
 
328
# showCode --
329
# This procedure creates a toplevel window that displays the code for
330
# a demonstration and allows it to be edited and reinvoked.
331
#
332
# Arguments:
333
# w -           The name of the demonstration's window, which can be
334
#               used to derive the name of the file containing its code.
335
 
336
proc showCode w {
337
    global tk_library
338
    set file [string range $w 1 end].tcl
339
    if ![winfo exists .code] {
340
        toplevel .code
341
        frame .code.buttons
342
        pack .code.buttons -side bottom -fill x
343
        button .code.buttons.dismiss -text Dismiss \
344
            -default active -command "destroy .code"
345
        button .code.buttons.rerun -text "Rerun Demo" -command {
346
            eval [.code.text get 1.0 end]
347
        }
348
        pack .code.buttons.dismiss .code.buttons.rerun -side left \
349
            -expand 1 -pady 2
350
        frame .code.frame
351
        pack  .code.frame -expand yes -fill both -padx 1 -pady 1
352
        text .code.text -height 40 -wrap word\
353
            -xscrollcommand ".code.xscroll set" \
354
            -yscrollcommand ".code.yscroll set" \
355
            -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
356
        scrollbar .code.xscroll -command ".code.text xview" \
357
            -highlightthickness 0 -orient horizontal
358
        scrollbar .code.yscroll -command ".code.text yview" \
359
            -highlightthickness 0 -orient vertical
360
 
361
        grid .code.text -in .code.frame -padx 1 -pady 1 \
362
            -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
363
        grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
364
            -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
365
#       grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
366
#           -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
367
        grid rowconfig    .code.frame 0 -weight 1 -minsize 0
368
        grid columnconfig .code.frame 0 -weight 1 -minsize 0
369
    } else {
370
        wm deiconify .code
371
        raise .code
372
    }
373
    wm title .code "Demo code: [file join $tk_library demos $file]"
374
    wm iconname .code $file
375
    set id [open [file join $tk_library demos $file]]
376
    .code.text delete 1.0 end
377
    .code.text insert 1.0 [read $id]
378
    .code.text mark set insert 1.0
379
    close $id
380
}
381
 
382
# aboutBox --
383
#
384
#       Pops up a message box with an "about" message
385
#
386
proc aboutBox {} {
387
    tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
388
"Tk widget demonstration\n\n\
389
Copyright (c) 1996-1997 Sun Microsystems, Inc."
390
}
391
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.