| 1 | # ---------------------------------------------------------------------- |
|---|
| 2 | # COMPONENT: slideframes - collection of frames with headings |
|---|
| 3 | # |
|---|
| 4 | # This widget is similar to a tabbed notebook, but instead of having |
|---|
| 5 | # tabs on the side, it has headings inline with the content. Clicking |
|---|
| 6 | # on a heading brings up the frame beneath the heading. Only one |
|---|
| 7 | # frame can be packed at a time. |
|---|
| 8 | # ====================================================================== |
|---|
| 9 | # AUTHOR: Michael McLennan, Purdue University |
|---|
| 10 | # Copyright (c) 2004-2010 Purdue Research Foundation |
|---|
| 11 | # |
|---|
| 12 | # See the file "license.terms" for information on usage and |
|---|
| 13 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|---|
| 14 | # ====================================================================== |
|---|
| 15 | package require Itk |
|---|
| 16 | |
|---|
| 17 | option add *Slideframes.width 0 widgetDefault |
|---|
| 18 | option add *Slideframes.height 0 widgetDefault |
|---|
| 19 | option add *Slideframes.headingBackground gray widgetDefault |
|---|
| 20 | option add *Slideframes.headingForeground black widgetDefault |
|---|
| 21 | option add *Slideframes.headingBorderWidth 2 widgetDefault |
|---|
| 22 | option add *Slideframes.headingRelief raised widgetDefault |
|---|
| 23 | |
|---|
| 24 | itcl::class Rappture::Slideframes { |
|---|
| 25 | inherit itk::Widget |
|---|
| 26 | |
|---|
| 27 | itk_option define -width width Width 0 |
|---|
| 28 | itk_option define -height height Height 0 |
|---|
| 29 | itk_option define -animstartcommand animStartCommand AnimStartCommand "" |
|---|
| 30 | itk_option define -animendcommand animEndCommand AnimEndCommand "" |
|---|
| 31 | |
|---|
| 32 | constructor {args} { # defined below } |
|---|
| 33 | destructor { # defined below } |
|---|
| 34 | |
|---|
| 35 | public method insert {pos args} |
|---|
| 36 | public method delete {args} |
|---|
| 37 | public method index {name} |
|---|
| 38 | public method page {name} |
|---|
| 39 | public method current {args} |
|---|
| 40 | public method size {} { return [llength $_pages] } |
|---|
| 41 | |
|---|
| 42 | private method _fixSize {} |
|---|
| 43 | private method _fixLayout {args} |
|---|
| 44 | |
|---|
| 45 | private variable _count 0 ;# counter for unique names |
|---|
| 46 | private variable _pages "" ;# list of page frames |
|---|
| 47 | private variable _name2num ;# maps name => id num for heading/page |
|---|
| 48 | private variable _current "" ;# page currently shown |
|---|
| 49 | private variable _tweener "" ;# tweener object for animations |
|---|
| 50 | } |
|---|
| 51 | |
|---|
| 52 | itk::usual Slideframes { |
|---|
| 53 | keep -cursor -font |
|---|
| 54 | keep -headingbackground -headingforeground |
|---|
| 55 | keep -headingborderwidth -headingrelief |
|---|
| 56 | } |
|---|
| 57 | |
|---|
| 58 | # ---------------------------------------------------------------------- |
|---|
| 59 | # CONSTRUCTOR |
|---|
| 60 | # ---------------------------------------------------------------------- |
|---|
| 61 | itcl::body Rappture::Slideframes::constructor {args} { |
|---|
| 62 | itk_option add hull.width hull.height |
|---|
| 63 | pack propagate $itk_component(hull) no |
|---|
| 64 | |
|---|
| 65 | bind $itk_component(hull) <Configure> [itcl::code $this _fixLayout] |
|---|
| 66 | |
|---|
| 67 | set _tweener [Rappture::Tweener #auto] |
|---|
| 68 | |
|---|
| 69 | eval itk_initialize $args |
|---|
| 70 | } |
|---|
| 71 | |
|---|
| 72 | # ---------------------------------------------------------------------- |
|---|
| 73 | # DESTRUCTOR |
|---|
| 74 | # ---------------------------------------------------------------------- |
|---|
| 75 | itcl::body Rappture::Slideframes::destructor {} { |
|---|
| 76 | itcl::delete object $_tweener |
|---|
| 77 | } |
|---|
| 78 | |
|---|
| 79 | # ---------------------------------------------------------------------- |
|---|
| 80 | # USAGE: insert <pos> ?<name> <name>...? |
|---|
| 81 | # |
|---|
| 82 | # Used to insert one or more pages in the list of sliding frames. |
|---|
| 83 | # Each page is identified by its <name>. Returns the widget name |
|---|
| 84 | # for each page created. |
|---|
| 85 | # ---------------------------------------------------------------------- |
|---|
| 86 | itcl::body Rappture::Slideframes::insert {pos args} { |
|---|
| 87 | set rlist "" |
|---|
| 88 | foreach name $args { |
|---|
| 89 | if {[lsearch $_pages $name] >= 0} { |
|---|
| 90 | error "page \"$name\" already exists" |
|---|
| 91 | } |
|---|
| 92 | set id [incr _count] |
|---|
| 93 | |
|---|
| 94 | set hname "heading$id" |
|---|
| 95 | itk_component add $hname { |
|---|
| 96 | button $itk_interior.$hname -text $name -highlightthickness 0 \ |
|---|
| 97 | -anchor w -command [itcl::code $this current $name] |
|---|
| 98 | } { |
|---|
| 99 | usual |
|---|
| 100 | rename -background -headingbackground headingBackground Background |
|---|
| 101 | rename -foreground -headingforeground headingForeground Foreground |
|---|
| 102 | rename -borderwidth -headingborderwidth headingBorderWidth BorderWidth |
|---|
| 103 | rename -relief -headingrelief headingRelief Relief |
|---|
| 104 | ignore -highlightthickness |
|---|
| 105 | } |
|---|
| 106 | |
|---|
| 107 | set pname "page$id" |
|---|
| 108 | itk_component add $pname { |
|---|
| 109 | frame $itk_interior.$pname |
|---|
| 110 | } |
|---|
| 111 | bind $itk_component($pname) <Configure> [itcl::code $this _fixSize] |
|---|
| 112 | |
|---|
| 113 | if {[llength $_pages] == 0} { |
|---|
| 114 | # select first page by default |
|---|
| 115 | after idle [list catch [list $this current $name]] |
|---|
| 116 | } |
|---|
| 117 | set _pages [linsert $_pages $pos $name] |
|---|
| 118 | set _name2num($name) $id |
|---|
| 119 | |
|---|
| 120 | lappend rlist $itk_component($pname) |
|---|
| 121 | } |
|---|
| 122 | |
|---|
| 123 | return $rlist |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | # ---------------------------------------------------------------------- |
|---|
| 127 | # USAGE: delete -all |
|---|
| 128 | # USAGE: delete ?<name> <name>...? |
|---|
| 129 | # |
|---|
| 130 | # Used to delete one or more pages from the notebook. With the -all |
|---|
| 131 | # flag, it deletes all pages. Otherwise, it deletes each page |
|---|
| 132 | # by name. You can also delete a page by using an index of the |
|---|
| 133 | # form "@n". |
|---|
| 134 | # ---------------------------------------------------------------------- |
|---|
| 135 | itcl::body Rappture::Slideframes::delete {args} { |
|---|
| 136 | if {$args == "-all"} { |
|---|
| 137 | set args $_pages |
|---|
| 138 | } |
|---|
| 139 | foreach name $args { |
|---|
| 140 | set i [index $name] |
|---|
| 141 | set pname [lindex $_pages $i] |
|---|
| 142 | if {$pname != ""} { |
|---|
| 143 | set _pages [lreplace $_pages $i $i] |
|---|
| 144 | set id $_name2num($pname) |
|---|
| 145 | destroy $itk_component(heading$id) $itk_component(page$id) |
|---|
| 146 | unset _name2num($pname) |
|---|
| 147 | } |
|---|
| 148 | } |
|---|
| 149 | } |
|---|
| 150 | |
|---|
| 151 | # ---------------------------------------------------------------------- |
|---|
| 152 | # USAGE: index <name>|@n |
|---|
| 153 | # |
|---|
| 154 | # Used to convert a page <name> to its corresponding integer index. |
|---|
| 155 | # ---------------------------------------------------------------------- |
|---|
| 156 | itcl::body Rappture::Slideframes::index {name} { |
|---|
| 157 | set i [lsearch $_pages $name] |
|---|
| 158 | if {$i >= 0} { |
|---|
| 159 | return $i |
|---|
| 160 | } |
|---|
| 161 | if {[regexp {^@([0-9]+)$} $name match i]} { |
|---|
| 162 | return $i |
|---|
| 163 | } |
|---|
| 164 | error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]" |
|---|
| 165 | } |
|---|
| 166 | |
|---|
| 167 | # ---------------------------------------------------------------------- |
|---|
| 168 | # USAGE: page <name>|@n |
|---|
| 169 | # |
|---|
| 170 | # Used to convert a page <name> to its corresponding frame. |
|---|
| 171 | # ---------------------------------------------------------------------- |
|---|
| 172 | itcl::body Rappture::Slideframes::page {name} { |
|---|
| 173 | set i [index $name] |
|---|
| 174 | set name [lindex $_pages $i] |
|---|
| 175 | set id $_name2num($name) |
|---|
| 176 | return $itk_component(page$id) |
|---|
| 177 | } |
|---|
| 178 | |
|---|
| 179 | # ---------------------------------------------------------------------- |
|---|
| 180 | # USAGE: current ?<name>? |
|---|
| 181 | # |
|---|
| 182 | # Used to query/set the current page in the notebook. With no args, |
|---|
| 183 | # it returns the name of the current page. Otherwise, it sets the |
|---|
| 184 | # current page. |
|---|
| 185 | # ---------------------------------------------------------------------- |
|---|
| 186 | itcl::body Rappture::Slideframes::current {args} { |
|---|
| 187 | switch -- [llength $args] { |
|---|
| 188 | 0 { |
|---|
| 189 | return $_current |
|---|
| 190 | } |
|---|
| 191 | 1 { |
|---|
| 192 | set name [lindex $args 0] |
|---|
| 193 | set index [lsearch -exact $_pages $name] |
|---|
| 194 | if {$index < 0} { |
|---|
| 195 | error "can't find page \"$name\"" |
|---|
| 196 | } |
|---|
| 197 | |
|---|
| 198 | set prev $_current |
|---|
| 199 | set _current [lindex $_pages $index] |
|---|
| 200 | |
|---|
| 201 | if {$prev != $_current} { |
|---|
| 202 | $_tweener configure -from 0 -to 1 -duration 50 -steps 10 \ |
|---|
| 203 | -command [itcl::code $this _fixLayout $_current $prev %v] \ |
|---|
| 204 | -finalize [itcl::code $this _fixLayout end] |
|---|
| 205 | } else { |
|---|
| 206 | _fixLayout |
|---|
| 207 | } |
|---|
| 208 | } |
|---|
| 209 | default { |
|---|
| 210 | error "wrong # args: should be \"current ?name?\"" |
|---|
| 211 | } |
|---|
| 212 | } |
|---|
| 213 | } |
|---|
| 214 | |
|---|
| 215 | # ---------------------------------------------------------------------- |
|---|
| 216 | # USAGE: _fixSize |
|---|
| 217 | # |
|---|
| 218 | # Used to handle the requested size for this widget. If -width or |
|---|
| 219 | # -height is 0, then the size is computed based on the requested |
|---|
| 220 | # sizes of internal pages. |
|---|
| 221 | # ---------------------------------------------------------------------- |
|---|
| 222 | itcl::body Rappture::Slideframes::_fixSize {} { |
|---|
| 223 | if {"0" == $itk_option(-width)} { |
|---|
| 224 | set wd 0 |
|---|
| 225 | foreach pname $_pages { |
|---|
| 226 | set id $_name2num($pname) |
|---|
| 227 | set w [winfo reqwidth $itk_component(page$id)] |
|---|
| 228 | if {$w > $wd} { set wd $w } |
|---|
| 229 | } |
|---|
| 230 | component hull configure -width $wd |
|---|
| 231 | } else { |
|---|
| 232 | component hull configure -width $itk_option(-width) |
|---|
| 233 | } |
|---|
| 234 | |
|---|
| 235 | if {"0" == $itk_option(-height)} { |
|---|
| 236 | set headht 0 |
|---|
| 237 | set pageht 0 |
|---|
| 238 | foreach pname $_pages { |
|---|
| 239 | set id $_name2num($pname) |
|---|
| 240 | set h [winfo reqheight $itk_component(heading$id)] |
|---|
| 241 | set headht [expr {$headht + $h}] |
|---|
| 242 | |
|---|
| 243 | set h [winfo reqheight $itk_component(page$id)] |
|---|
| 244 | if {$h > $pageht} { set pageht $h } |
|---|
| 245 | } |
|---|
| 246 | component hull configure -height [expr {$headht+$pageht}] |
|---|
| 247 | } else { |
|---|
| 248 | component hull configure -height $itk_option(-height) |
|---|
| 249 | } |
|---|
| 250 | } |
|---|
| 251 | |
|---|
| 252 | # ---------------------------------------------------------------------- |
|---|
| 253 | # USAGE: _fixLayout ?<toName>? ?<fromName>? ?<frac>? |
|---|
| 254 | # |
|---|
| 255 | # Updates the layout of pages within this widget. With no args, it |
|---|
| 256 | # updates the layout based on the current page. This is good for |
|---|
| 257 | # resize operations. The extra args let us animate from the layout |
|---|
| 258 | # with one ID to the layout with another according to a fraction |
|---|
| 259 | # <frac> from 0 to 1. |
|---|
| 260 | # ---------------------------------------------------------------------- |
|---|
| 261 | itcl::body Rappture::Slideframes::_fixLayout {args} { |
|---|
| 262 | set atend 0 |
|---|
| 263 | if {$args == "end"} { |
|---|
| 264 | set atend 1 |
|---|
| 265 | set args "" |
|---|
| 266 | } |
|---|
| 267 | |
|---|
| 268 | set toName $_current |
|---|
| 269 | set fromName "" |
|---|
| 270 | set frac 1 |
|---|
| 271 | if {[llength $args] >= 1} { set toName [lindex $args 0] } |
|---|
| 272 | if {[llength $args] >= 2} { set fromName [lindex $args 1] } |
|---|
| 273 | if {[llength $args] >= 3} { set frac [lindex $args 2] } |
|---|
| 274 | if {[llength $args] > 3} { |
|---|
| 275 | error "wrong # args: should be \"_fixLayout ?id? ?previd? ?frac?\"" |
|---|
| 276 | } |
|---|
| 277 | |
|---|
| 278 | if {$frac == 0 && [string length $itk_option(-animstartcommand)] > 0} { |
|---|
| 279 | if {[catch [list uplevel #0 $itk_option(-animstartcommand)] err]} { |
|---|
| 280 | bgerror $err |
|---|
| 281 | } |
|---|
| 282 | } |
|---|
| 283 | |
|---|
| 284 | set fromid "" |
|---|
| 285 | if {[info exists _name2num($fromName)]} { |
|---|
| 286 | set fromid $_name2num($fromName) |
|---|
| 287 | } |
|---|
| 288 | |
|---|
| 289 | set toid "" |
|---|
| 290 | if {[info exists _name2num($toName)]} { |
|---|
| 291 | set toid $_name2num($toName) |
|---|
| 292 | } |
|---|
| 293 | |
|---|
| 294 | set w [winfo width $itk_component(hull)] |
|---|
| 295 | set h [winfo height $itk_component(hull)] |
|---|
| 296 | |
|---|
| 297 | # figure out the overall size of title buttons and space left over |
|---|
| 298 | set titlemax 0 |
|---|
| 299 | foreach pname $_pages { |
|---|
| 300 | set id $_name2num($pname) |
|---|
| 301 | set titleh [winfo reqheight $itk_component(heading$id)] |
|---|
| 302 | set titlemax [expr {$titlemax + $titleh}] |
|---|
| 303 | } |
|---|
| 304 | |
|---|
| 305 | set extra [expr {$h - $titlemax}] |
|---|
| 306 | if {$extra < 0} { set extra 0 } |
|---|
| 307 | |
|---|
| 308 | if {$toid != ""} { |
|---|
| 309 | set pageht1 [winfo reqheight $itk_component(page$toid)] |
|---|
| 310 | } else { |
|---|
| 311 | set pageht1 0 |
|---|
| 312 | } |
|---|
| 313 | if {$fromid != ""} { |
|---|
| 314 | set pageht2 [winfo reqheight $itk_component(page$fromid)] |
|---|
| 315 | } else { |
|---|
| 316 | set pageht2 0 |
|---|
| 317 | } |
|---|
| 318 | set pageht [expr {$frac*$pageht1 + (1-$frac)*$pageht2}] |
|---|
| 319 | if {$pageht < $extra} { |
|---|
| 320 | set extra $pageht |
|---|
| 321 | } |
|---|
| 322 | |
|---|
| 323 | # scan through all buttons and place them, along with the pages beneath |
|---|
| 324 | set ypos 0 |
|---|
| 325 | foreach pname $_pages { |
|---|
| 326 | set id $_name2num($pname) |
|---|
| 327 | set titleh [winfo reqheight $itk_component(heading$id)] |
|---|
| 328 | |
|---|
| 329 | # place the heading button |
|---|
| 330 | place $itk_component(heading$id) -x 0 -y $ypos -anchor nw \ |
|---|
| 331 | -width $w -height $titleh |
|---|
| 332 | set ypos [expr {$ypos + $titleh}] |
|---|
| 333 | |
|---|
| 334 | set pageht [winfo reqheight $itk_component(page$id)] |
|---|
| 335 | if {$id == $fromid || $id == $toid} { |
|---|
| 336 | if {$id == $toid} { |
|---|
| 337 | set ht [expr {round($extra * $frac)}] |
|---|
| 338 | } else { |
|---|
| 339 | set ht [expr {round($extra * (1-$frac))}] |
|---|
| 340 | } |
|---|
| 341 | if {$ht > $pageht} { set ht $pageht } |
|---|
| 342 | if {$ht > 0} { |
|---|
| 343 | place $itk_component(page$id) -x 0 -y $ypos -anchor nw \ |
|---|
| 344 | -width $w -height $ht |
|---|
| 345 | set ypos [expr {$ypos + $ht}] |
|---|
| 346 | } else { |
|---|
| 347 | place forget $itk_component(page$id) |
|---|
| 348 | } |
|---|
| 349 | } else { |
|---|
| 350 | place forget $itk_component(page$id) |
|---|
| 351 | } |
|---|
| 352 | } |
|---|
| 353 | |
|---|
| 354 | if {$atend && [string length $itk_option(-animendcommand)] > 0} { |
|---|
| 355 | if {[catch [list uplevel #0 $itk_option(-animendcommand)] err]} { |
|---|
| 356 | bgerror $err |
|---|
| 357 | } |
|---|
| 358 | } |
|---|
| 359 | } |
|---|
| 360 | |
|---|
| 361 | # ---------------------------------------------------------------------- |
|---|
| 362 | # OPTION: -width, -height |
|---|
| 363 | # ---------------------------------------------------------------------- |
|---|
| 364 | itcl::configbody Rappture::Slideframes::width { |
|---|
| 365 | _fixSize |
|---|
| 366 | } |
|---|
| 367 | itcl::configbody Rappture::Slideframes::height { |
|---|
| 368 | _fixSize |
|---|
| 369 | } |
|---|
