tk/tests/canvPsText.tcl

   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 # RCS: @(#) $Id$
   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 -font {Courier 24 italic} -stipple $stipple
  36 $c create rect 2.95i 0.95i 3.05i 1.05i -fill {} -outline black
  37 $c create text 3.0i 1.0i -text "Northwest Helvetica 24" \
  38         -anchor nw -tags text -font {Helvetica 24} -stipple $stipple
  39 $c create rect 2.95i 1.45i 3.05i 1.55i -fill {} -outline black
  40 $c create text 3.0i 1.5i -text "North Helvetica Oblique 12 " \
  41         -anchor n -tags text -font {Helvetica 12 italic} -stipple $stipple
  42 $c create rect 2.95i 1.95i 3.05i 2.05i -fill {} -outline blue
  43 $c create text 3.0i 2.0i -text "Northeast Helvetica Bold 24" \
  44         -anchor ne -tags text -font {Helvetica 24 bold} -stipple $stipple
  45 $c create rect 2.95i 2.45i 3.05i 2.55i -fill {} -outline black
  46 $c create text 3.0i 2.5i -text "East Helvetica Bold Oblique 18" \
  47         -anchor e -tags text -font {Helvetica 18 {bold italic}} -stipple $stipple
  48 $c create rect 2.95i 2.95i 3.05i 3.05i -fill {} -outline black
  49 $c create text 3.0i 3.0i -text "Southeast Times 10" \
  50         -anchor se -tags text -font {Times 10} -stipple $stipple
  51 $c create rect 2.95i 3.45i 3.05i 3.55i -fill {} -outline black
  52 $c create text 3.0i 3.5i -text "South Times Italic 24" \
  53         -anchor s -tags text -font {Times 24 italic} -stipple $stipple
  54 $c create rect 2.95i 3.95i 3.05i 4.05i -fill {} -outline black
  55 $c create text 3.0i 4.0i -text "Southwest Times Bold 18" \
  56         -anchor sw -tags text -font {Times 18 bold} -stipple $stipple
  57 $c create rect 2.95i 4.45i 3.05i 4.55i -fill {} -outline black
  58 $c create text 3.0i 4.5i -text "West Times Bold Italic 24"\
  59         -anchor w -tags text -font {Times 24 {bold italic}} -stipple $stipple
  60
  61 $c create rect 0.95i 5.20i 1.05i 5.30i -fill {} -outline black
  62 $c create text 1.0i 5.25i -width 1.9i -anchor c -justify left -tags text \
  63         -font {Times 18 bold} -stipple $stipple \
  64         -text "This is a sample text item to see how left justification works"
  65 $c create rect 2.95i 5.20i 3.05i 5.30i -fill {} -outline black
  66 $c create text 3.0i 5.25i -width 1.8i -anchor c -justify center -tags text \
  67         -font {Times 18 bold} -stipple $stipple \
  68         -text "This is a sample text item to see how center justification works"
  69 $c create rect 4.95i 5.20i 5.05i 5.30i -fill {} -outline black
  70 $c create text 5.0i 5.25i -width 1.8i -anchor c -justify right -tags text \
  71         -font {Times 18 bold} -stipple $stipple \
  72         -text "This is a sample text item to see how right justification works"
  73
  74 $c create text 3.0i 6.0i -width 5.0i -anchor n -justify right -tags text \
  75         -text "This text is\nright justified\nwith a line length equal to\n\
  76         the size of the enclosing rectangle.\nMake sure it prints right\
  77         justified as well."
  78 $c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black
  79
  80 proc setStipple c {
  81     global stipple
  82     $c itemconfigure text -stipple $stipple
  83 }
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96