tk/tests/cmap.tcl

   1 # This file creates a visual test for colormaps and the WM_COLORMAP_WINDOWS
   2 # property.  It is part of the Tk visual test suite, which is invoked
   3 # via the "visual" script.
   4 #
   5 # RCS: @(#) $Id$
   6
   7 catch {destroy .t}
   8 toplevel .t -colormap new
   9 wm title .t "Visual Test for Colormaps"
  10 wm iconname .t "Colormaps"
  11 wm geom .t +0+0
  12
  13 # The following procedure creates a whole bunch of frames within a
  14 # window, in order to eat up all the colors in a colormap.
  15
  16 proc colors {w redInc greenInc blueInc} {
  17     set red 0
  18     set green 0
  19     set blue 0
  20     for {set y 0} {$y < 8} {incr y} {
  21         for {set x 0} {$x < 8} {incr x} {
  22             frame $w.f$x,$y -width 40 -height 40 -bd 2 -relief raised \
  23                     -bg [format #%02x%02x%02x $red $green $blue]
  24             place $w.f$x,$y -x [expr 40*$x] -y [expr 40*$y]
  25             incr red $redInc
  26             incr green $greenInc
  27             incr blue $blueInc
  28         }
  29     }
  30 }
  31
  32 message .t.m -width 6i -text {This window displays two nested frames, each with a whole bunch of subwindows that eat up a lot of colors.  The toplevel window has its own colormap, which is inherited by the outer frame.  The inner frame has its own colormap.  As you move the mouse around, the colors in the frames should change back and forth.}
  33 pack .t.m -side top -fill x
  34
  35 button .t.quit -text Quit -command {destroy .t}
  36 pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2
  37
  38 frame .t.f -width 700 -height 450 -relief raised -bd 2
  39 pack .t.f -side top -padx 1c -pady 1c
  40 colors .t.f 4 0 0
  41 frame .t.f.f -width 350 -height 350 -colormap new -bd 2 -relief raised
  42 place .t.f.f -relx 1.0 -rely 0 -anchor ne
  43 colors .t.f.f 0 4 0
  44 bind .t.f.f <Enter> {wm colormapwindows .t {.t.f.f .t}}
  45 bind .t.f.f <Leave> {wm colormapwindows .t {.t .t.f.f}}
  46
  47 catch {destroy .t2}
  48 toplevel .t2
  49 wm title .t2 "Visual Test for Colormaps"
  50 wm iconname .t2 "Colormaps"
  51 wm geom .t2 +0-0
  52
  53 message .t2.m -width 6i -text {This window just eats up most of the colors in the default colormap.}
  54 pack .t2.m -side top -fill x
  55
  56 button .t2.quit -text Quit -command {destroy .t2}
  57 pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2
  58
  59 frame .t2.f -height 320 -width 320
  60 pack .t2.f -side bottom
  61 colors .t2.f 0 0 4
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74