Subversion Repositories or1k

#!/usr/local/bin/wish -f

#

# This script displays provides visual tests for many of Tk's features.

# Each test displays a window with various information in it, along

# with instructions about how the window should appear.  You can look

# at the window to make sure it appears as expected.  Individual tests

# are kept in separate ".tcl" files in this directory.

#

# RCS: @(#) $Id: visual,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $

set auto_path ". $auto_path"

wm title . "Visual Tests for Tk"

#-------------------------------------------------------

# The code below create the main window, consisting of a

# menu bar and a message explaining the basic operation

# of the program.

#-------------------------------------------------------

frame .menu -relief raised -borderwidth 1

message .msg -font {Times 18} -relief raised -width 4i \

        -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."

pack .menu -side top -fill x

pack .msg -side bottom -expand yes -fill both

#-------------------------------------------------------

# The code below creates all the menus, which invoke procedures

# to create particular demonstrations of various widgets.

#-------------------------------------------------------

menubutton .menu.file -text "File" -menu .menu.file.m

menu .menu.file.m

.menu.file.m add command -label "Quit" -command exit

menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m

menu .menu.group1.m

.menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl}

.menu.group1.m add command -label "Beveled borders in text widgets" \

        -command {source bevel.tcl}

.menu.group1.m add command -label "Colormap management" \

        -command {source cmap.tcl}

.menu.group1.m add command -label "Label/button geometry" \

        -command {source butGeom.tcl}

.menu.group1.m add command -label "Label/button colors" \

        -command {source butGeom2.tcl}

menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m

menu .menu.ps.m

.menu.ps.m add command -label "Rectangles and other graphics" \

        -command {source canvPsGrph.tcl}

.menu.ps.m add command -label "Text" \

        -command {source canvPsText.tcl}

.menu.ps.m add command -label "Bitmaps" \

        -command {source canvPsBmap.tcl}

.menu.ps.m add command -label "Arcs" \

        -command {source canvPsArc.tcl}

pack .menu.file .menu.group1 .menu.ps -side left -padx 1m

# Set up for keyboard-based menu traversal

bind .  {

    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {

        focus .menu

    }

}

tk_menuBar .menu .menu.file .menu.group1 .menu.ps

# The following procedure is invoked to print the contents of a canvas:

proc lpr c {

    exec rm -f tmp.ps

    $c postscript -file tmp.ps

    exec lpr tmp.ps

}

# Set up a class binding to allow objects to be deleted from a canvas

# by clicking with mouse button 1:

bind Canvas <1> {%W delete [%W find closest %x %y]}