home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / canvPsText.tcl < prev    next >
Encoding:
Text File  |  1994-08-10  |  4.2 KB  |  92 lines
  1. # This file creates a screen to exercise Postscript generation
  2. # for text in canvases.  It is part of the Tk visual test suite,
  3. # which is invoked via the "visual" script.
  4. #
  5. # @(#) canvPsText.tcl 1.1 94/08/10 15:49:42
  6.  
  7. catch {destroy .t}
  8. toplevel .t
  9. wm title .t "Postscript Tests for Canvases"
  10. wm iconname .t "Postscript"
  11. wm geom .t +0+0
  12. wm minsize .t 1 1
  13.  
  14. set c .t.c
  15.  
  16. message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for text.  Click on "Print" to print the canvas to your default printer.  The "Stipple" button can be used to turn stippling on and off for the text, but beware:  many Postscript printers cannot handle stippled text.  You can click on items in the canvas to delete them.} -width 6i
  17. pack .t.m -side top -fill both
  18.  
  19. set stipple {}
  20. checkbutton .t.stipple -text Stippling -variable stipple -onvalue gray50 \
  21.     -offvalue {} -command "setStipple $c" -relief flat
  22. pack .t.stipple -side top -pady 2m -expand 1 -anchor w
  23.  
  24. frame .t.bot
  25. pack .t.bot -side bottom -fill both
  26. button .t.bot.quit -text Quit -command {destroy .t}
  27. button .t.bot.print -text Print -command "lpr $c"
  28. pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
  29.  
  30. canvas $c -width 6i -height 7i -bd 2 -relief sunken
  31. pack $c -expand yes -fill both -padx 2m -pady 2m
  32.  
  33. $c create rect 2.95i 0.45i 3.05i 0.55i -fill {} -outline black
  34. $c create text 3.0i 0.5i -text "Center Courier Oblique 24" \
  35.     -anchor center -tags text \
  36.     -font -Adobe-courier-medium-o-*--*-240-* -stipple $stipple
  37. $c create rect 2.95i 0.95i 3.05i 1.05i -fill {} -outline black
  38. $c create text 3.0i 1.0i -text "Northwest Helvetica 24" \
  39.     -anchor nw -tags text \
  40.     -font -Adobe-helvetica-medium-r-*--*-240-* -stipple $stipple
  41. $c create rect 2.95i 1.45i 3.05i 1.55i -fill {} -outline black
  42. $c create text 3.0i 1.5i -text "North Helvetica Oblique 12 " \
  43.     -anchor n -tags text \
  44.     -font -Adobe-helvetica-medium-o-*--*-120-* -stipple $stipple
  45. $c create rect 2.95i 1.95i 3.05i 2.05i -fill {} -outline blue
  46. $c create text 3.0i 2.0i -text "Northeast Helvetica Bold 24" \
  47.     -anchor ne -tags text \
  48.     -font -Adobe-helvetica-bold-r-*--*-240-* -stipple $stipple
  49. $c create rect 2.95i 2.45i 3.05i 2.55i -fill {} -outline black
  50. $c create text 3.0i 2.5i -text "East Helvetica Bold Oblique 18" \
  51.     -anchor e -tags text \
  52.     -font -Adobe-helvetica-bold-o-*--*-180-* -stipple $stipple
  53. $c create rect 2.95i 2.95i 3.05i 3.05i -fill {} -outline black
  54. $c create text 3.0i 3.0i -text "Southeast Times 10" \
  55.     -anchor se -tags text \
  56.     -font -Adobe-times-medium-r-*--*-100-* -stipple $stipple
  57. $c create rect 2.95i 3.45i 3.05i 3.55i -fill {} -outline black
  58. $c create text 3.0i 3.5i -text "South Times Italic 24" -anchor s -tags text \
  59.     -font -Adobe-times-medium-i-*--*-240-* -stipple $stipple
  60. $c create rect 2.95i 3.95i 3.05i 4.05i -fill {} -outline black
  61. $c create text 3.0i 4.0i -text "Southwest Times Bold 18" \
  62.     -anchor sw -tags text \
  63.     -font -Adobe-times-bold-r-*--*-180-* -stipple $stipple
  64. $c create rect 2.95i 4.45i 3.05i 4.55i -fill {} -outline black
  65. $c create text 3.0i 4.5i -text "West Times Bold Italic 24"\
  66.     -anchor w -tags text \
  67.     -font -Adobe-times-bold-i-*--*-240-* -stipple $stipple
  68.  
  69. $c create rect 0.95i 5.20i 1.05i 5.30i -fill {} -outline black
  70. $c create text 1.0i 5.25i -width 1.9i -anchor c -justify left -tags text \
  71.     -font -Adobe-times-bold-r-*--*-180-* -stipple $stipple \
  72.     -text "This is a sample text item to see how left justification works"
  73. $c create rect 2.95i 5.20i 3.05i 5.30i -fill {} -outline black
  74. $c create text 3.0i 5.25i -width 1.8i -anchor c -justify center -tags text \
  75.     -font -Adobe-times-bold-r-*--*-180-* -stipple $stipple \
  76.     -text "This is a sample text item to see how center justification works"
  77. $c create rect 4.95i 5.20i 5.05i 5.30i -fill {} -outline black
  78. $c create text 5.0i 5.25i -width 1.8i -anchor c -justify right -tags text \
  79.     -font -Adobe-times-bold-r-*--*-180-* -stipple $stipple \
  80.     -text "This is a sample text item to see how right justification works"
  81.  
  82. $c create text 3.0i 6.0i -width 5.0i -anchor n -justify right -tags text \
  83.     -text "This text is\nright justified\nwith a line length equal to\n\
  84.     the size of the enclosing rectangle.\nMake sure it prints right\
  85.     justified as well."
  86. $c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black
  87.  
  88. proc setStipple c {
  89.     global stipple
  90.     $c itemconfigure text -stipple $stipple
  91. }
  92.