Purpose: Demonstrate an animated vertical tab scheme edit
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.
28 Aug, 2003 Added frame titles and tooltips as per
DKF's prompting, but it seems going beyond demonstrating the idea.
Mike Tuxford #!/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
}
# you can define the titles in the array above instead
for {set i 0} {$i < 6} {incr i} {
set vt($i,title) "This is frame #$i"
}
### 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
bind .g.v.vt$n <Any-Enter> "popBalloon $n"
bind .g.v.vt$n <Any-Leave> {destroy .vtinfo}
frame .g.f$n -bd 1
# change font at your own risk
label .g.f$n.top -relief solid -bd 1 -bg #eaeaea \
-text $vt($n,title) -font {Fixed 12} \
-height 1 -width [string length $vt($n,title)]
pack .g.f$n.top -side top -fill x -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)-[expr [lindex [font metrics {Fixed 12}] 5]+10]]
pack .g.f$n.c -side top -fill y -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 popBalloon {n} {
global vt
if {[winfo exists .vtinfo]} {
return
}
set p(x) [expr ([string length $vt($n,title)]*7) +20]
set p(y) 20
set p(relx) [expr [winfo rootx .g]+24]
set p(rely) [winfo pointery .g]
toplevel .vtinfo -bd 1 -bg #ffff00
.vtinfo configure -relief solid
wm overrideredirect .vtinfo 1
wm geometry .vtinfo $p(x)x$p(y)+$p(relx)+$p(rely)
label .vtinfo.txt \
-background #ffff00 -foreground #000000 \
-font {Helvetica 12} -height 1 \
-width [expr [string length $vt($n,title)]+6] \
-text $vt($n,title)
pack .vtinfo.txt
raise .vtinfo
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 .}FW: This doesn't work on my XP box, the text in the labels just mushes together into a circle-looking black block. - MT:There is no text in the buttons, see
MNO's comments below. One could add text by simply adding newline's between each char of the text string, but the idea was not to use any text but use a simple dot image thus allowing for many more tabs to be added that will still fit and look right as the packer will adjust the size of each and all to be the same regardless of the window size.
MNO: That's a bitmap of a dot (i.e. intentional) - see the "image create" and "-image dot" sections of the code.
MAK: That's kind of nifty, but pretty slow. My suggestion would be, rather than working in fixed X coordinate increments, select a fixed time (short -- maybe 0.5 - 1.5 seconds, maybe configurable) and calculate the offset each iteration based on (width/maxtime)*t. Possibly set a variable marking the time that expansion started, and use the event loop and
after to update the position as fast as the event loop triggers tell you to, moving to exactly the right position based on the elapsed time. - MT: Yes, you could do that and it also seems more appropriate for auto-adjusting to various sizes. The whole scheme went from conception to example in one sitting in a rather raw mode but I thought I'd share the idea since it seemed to be something new, at least to me. That was at least 6 months ago.
DKF: You've got a few issues left. Here are the ones I can spot straight off:
- Window stacking order; buttons should be over the slide-out windows
MT: Why? I don't understand the 'issue' here.
- Tab clipping; the slide out windows show next to the buttons!
MT: Why? I don't understand the issue here. These are not tabs in the normal sense but emulate how tabs are used. The slide-out frames being next to the buttons was by design but could be altered.
- Mouse cursor inheritance; the mouse pointer should not be set in the slide-outs, so don't set it on the overall window.
MT: Why? I don't understand the issue. There are no pointer assingments in the slide-out frames/canvases but why can't there be? and why can't there be on the toplevel?
- Need to have tooltips for the buttons if they are not labelled
MT: Could be done.
- Slide-outs should definitely be labelled
MT: Could be done.
- Checkbuttons (without indicator) instead of normal buttons on the left?
MT: Why? I don't understand the issue here and that seems more of a personal taste issue that you could apply instead of me in a generic concept demo. and could be done other ways.
Mike Tuxford It was only an example of an idea or scheme I had never seen before, and never meant as a full implementation or widget in itself. Again, this was something I put up 6 months ago or so and never did anymore with it. Feel free to delete.
DKF: Dont' delete! Enhance it! Make it better. Please take any and all comments constructively - if I didn't like it (or didn't care one way or the other), I'd say so or say nothing...
GPS: I would like to add that sometimes people don't add comments to a page, but not because they don't like something. A lot of the time people are busy and most of the people here seem to visit from work. I try to say thanks on pages, but alas I don't always. We are all here to learn or
troll so we might as well enjoy it. :)
escargo 28 Aug 2003 - I think this is cool. It reminds me of a feature with the implementation of Squeak
Smalltalk, which I believe are called
flaps. One minor misfeature about this example is that the sample GUI implements an
About menu choice, it does not do anything.
