home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / visual < prev    next >
Encoding:
Tcl/Tk script  |  1995-06-23  |  3.0 KB  |  81 lines
  1. #!/usr/local/bin/wish -f
  2. #
  3. # This script displays provides visual tests for many of Tk's features.
  4. # Each test displays a window with various information in it, along
  5. # with instructions about how the window should appear.  You can look
  6. # at the window to make sure it appears as expected.  Individual tests
  7. # are kept in separate ".tcl" files in this directory.
  8. #
  9. # @(#) visual 1.2 95/06/22 16:44:59
  10.  
  11. set auto_path ". $auto_path"
  12. wm title . "Visual Tests for Tk"
  13.  
  14. #-------------------------------------------------------
  15. # The code below create the main window, consisting of a
  16. # menu bar and a message explaining the basic operation
  17. # of the program.
  18. #-------------------------------------------------------
  19.  
  20. frame .menu -relief raised -borderwidth 1
  21. message .msg -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-*-* \
  22.     -relief raised -width 4i \
  23.     -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."
  24.  
  25. pack .menu -side top -fill x
  26. pack .msg -side bottom -expand yes -fill both
  27.  
  28. #-------------------------------------------------------
  29. # The code below creates all the menus, which invoke procedures
  30. # to create particular demonstrations of various widgets.
  31. #-------------------------------------------------------
  32.  
  33. menubutton .menu.file -text "File" -menu .menu.file.m
  34. menu .menu.file.m
  35. .menu.file.m add command -label "Quit" -command exit
  36.  
  37. menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
  38. menu .menu.group1.m
  39. .menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl}
  40. .menu.group1.m add command -label "Beveled borders in text widgets" \
  41.     -command {source bevel.tcl}
  42. .menu.group1.m add command -label "Colormap management" \
  43.     -command {source cmap.tcl}
  44. .menu.group1.m add command -label "Label/button geometry" \
  45.     -command {source butGeom.tcl}
  46.  
  47. menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
  48. menu .menu.ps.m
  49. .menu.ps.m add command -label "Rectangles and other graphics" \
  50.     -command {source canvPsGrph.tcl}
  51. .menu.ps.m add command -label "Text" \
  52.     -command {source canvPsText.tcl}
  53. .menu.ps.m add command -label "Bitmaps" \
  54.     -command {source canvPsBmap.tcl}
  55. .menu.ps.m add command -label "Arcs" \
  56.     -command {source canvPsArc.tcl}
  57.  
  58. pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
  59.  
  60. # Set up for keyboard-based menu traversal
  61.  
  62. bind . <Any-FocusIn> {
  63.     if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
  64.     focus .menu
  65.     }
  66. }
  67. tk_menuBar .menu .menu.file .menu.group1 .menu.ps
  68.  
  69. # The following procedure is invoked to print the contents of a canvas:
  70.  
  71. proc lpr c {
  72.     exec rm -f tmp.ps
  73.     $c postscript -file tmp.ps
  74.     exec lpr tmp.ps
  75. }
  76.  
  77. # Set up a class binding to allow objects to be deleted from a canvas
  78. # by clicking with mouse button 1:
  79.  
  80. bind Canvas <1> {%W delete [%W find closest %x %y]}
  81.