* Purpose: Demonstrate an animated vertical tab scheme

This provides a vertical column of buttons on the lefthand side of the screen. Click a button and a frame and associated widgets slides out. Click it again and the frame slides back in. Click an alternate button and the currently displayed frame slides back and the new frame slides out.

I wrote this in one sitting and have not actually used it in any app yet, so if you see any problems with the concept or have other ideas of how to implement this, please feel free to add to the page. I don't know if I am reinventing a wheel here but didn't find a similar page.

 #!/bin/bash
 # the next line restarts using wish \
   exec /usr/bin/wish "$0" "$@"
 #
 # by Mike Tuxford
 #################################
 # GLOBALS
 #
 array set opt {
   "gui,x" 640 "gui,y" 480
 }
 array set vt {
   "0,bg" "#deb887" "1,bg" "#000000" "2,bg" "#ff0000"
   "3,bg" "#00ff00" "4,bg" "#0000ff" "5,bg" "#ffffff"
   "current" -1
 }
 ### Begin Bitmaps ###
 array set bmp {
 "dot" "#define dot11_width 11 #define dot11_height 11
 static unsigned char dot11_bits[] = {
    0x00, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe, 0x03, 0xfe, 0x03, 0xfe, 0x03,
    0xfe, 0x03, 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00, 0x00, 0x00};"
 }
 ### end Bitmaps ###
 image create bitmap dot -data $bmp(dot)
 #################################
 # PROCEDURES
 #
 proc buildTab {n} {
   global colors opt vt
   button .g.v.vt$n \
     -activebackground #c6e2ff -bg #eaeaea -fg #000000 -image dot \
     -bd 3 -relief raised -command "animate $n"
   pack .g.v.vt$n -in .g.v -side top -fill y -expand 1
   frame .g.f$n -bd 1
   label .g.f$n.top -relief solid -bd 1 -bg #eaeaea -image dot \
     -height 13 -width [expr $opt(gui,x) - 22]
   pack .g.f$n.top -side top -expand 1
   canvas .g.f$n.c -bd 1 -relief solid -bg $vt($n,bg) \
     -width [expr $opt(gui,x) - 22] -height [expr $opt(gui,y) - 31]
   pack .g.f$n.c -side top -expand 1
   return
 }
 
 proc animate {n} {
   global opt vt
   if {$vt(current) >= 0} {
       for {set i 0} {$i >= [expr 20 - $opt(gui,x)]} {incr i -10} {
       place .g.f$vt(current) -in .g -x $i -y 0
       update
       after 10
     }
   }
   if {$vt(current) == $n} {
     set vt(current) -1
   } else {
     for {set i [expr 20 - $opt(gui,x)]} {$i <= 20} {incr i 10} {
       place .g.f$n -in .g -x $i -y 0
       update
       after 10
     }
     set vt(current) $n
   }
   return
 }
 
 proc GUI {} {
   global opt
   set w .g
   toplevel $w
   wm focusmodel $w passive
   wm geometry $w $opt(gui,x)x$opt(gui,y)
   wm minsize $w $opt(gui,x) $opt(gui,y)
   wm maxsize $w $opt(gui,x) $opt(gui,y)
   wm deiconify $w
   wm title $w "Vertical Tabs Test"
   wm withdraw .
 ########################
 # MAIN MENU
 #
   menu $w.main -tearoff 0
   $w.main configure -font {Helvetica 10}
   set ma $w.main.net
   menu $ma -tearoff 0
   $ma configure -font {Helvetica 10}
   $w.main add cascade -label "File" -menu $ma -underline 0
     $ma add command -label "Exit" -command {destroy . .g}
   set mz $w.main.help
   menu $mz -tearoff 0
   $mz configure -font {Helvetica 10}
   $w.main add cascade -label "Help" -menu $mz -underline 0
     $mz add command -label "About"
     $mz add command -label "Item 2"
 #
   $w configure -cursor draft_small
   $w configure -menu $w.main
 # END MAIN MENU
 ####################
 ####################
 # WIDGETS
 #
 frame $w.v -height $opt(gui,y)
 for {set i 0} {$i < 6} {incr i} {
   buildTab $i
 }
 place $w.v -in $w -relheight 1.0 -x 0 -y 0
 # END GUI
 ####################
 }
 GUI
 # key bindings
 bind .g <Control-c> {destroy .}


[Mike Tuxford]

[FW]: This doesn't work on my XP box, the text in the labels just mushes together into a circle-looking black blog.