| 1 | # ---------------------------------------------------------------------- |
|---|
| 2 | # COMPONENT: page - single page of widgets |
|---|
| 3 | # |
|---|
| 4 | # This widget is a smart frame. It takes the XML description for |
|---|
| 5 | # a Rappture <input> or an <input><phase> and decides how to lay |
|---|
| 6 | # out the widgets for the controls within it. It uses various |
|---|
| 7 | # heuristics to achieve a decent layout under a variety of |
|---|
| 8 | # circumstances. |
|---|
| 9 | # ====================================================================== |
|---|
| 10 | # AUTHOR: Michael McLennan, Purdue University |
|---|
| 11 | # Copyright (c) 2004-2005 Purdue Research Foundation |
|---|
| 12 | # |
|---|
| 13 | # See the file "license.terms" for information on usage and |
|---|
| 14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|---|
| 15 | # ====================================================================== |
|---|
| 16 | package require Itk |
|---|
| 17 | |
|---|
| 18 | itcl::class Rappture::Page { |
|---|
| 19 | inherit itk::Widget |
|---|
| 20 | |
|---|
| 21 | constructor {owner path args} { # defined below } |
|---|
| 22 | |
|---|
| 23 | protected method _buildGroup {frame xmlobj path} |
|---|
| 24 | protected method _link {xmlobj path widget path2} |
|---|
| 25 | |
|---|
| 26 | private variable _owner "" ;# thing managing this page |
|---|
| 27 | } |
|---|
| 28 | |
|---|
| 29 | itk::usual Page { |
|---|
| 30 | } |
|---|
| 31 | |
|---|
| 32 | # ---------------------------------------------------------------------- |
|---|
| 33 | # CONSTRUCTOR |
|---|
| 34 | # ---------------------------------------------------------------------- |
|---|
| 35 | itcl::body Rappture::Page::constructor {owner path args} { |
|---|
| 36 | if {[catch {$owner isa Rappture::ControlOwner} valid] || !$valid} { |
|---|
| 37 | error "object \"$owner\" is not a Rappture::ControlOwner" |
|---|
| 38 | } |
|---|
| 39 | set _owner $owner |
|---|
| 40 | set xmlobj [$owner xml object] |
|---|
| 41 | |
|---|
| 42 | set type [$xmlobj element -as type $path] |
|---|
| 43 | if {$type != "input" && $type != "phase"} { |
|---|
| 44 | error "bad path \"$path\" in $xmlobj: should be <input> or <input><phase>" |
|---|
| 45 | } |
|---|
| 46 | |
|---|
| 47 | eval itk_initialize $args |
|---|
| 48 | |
|---|
| 49 | # build all of the controls for this page |
|---|
| 50 | _buildGroup $itk_interior $xmlobj $path |
|---|
| 51 | } |
|---|
| 52 | |
|---|
| 53 | # ---------------------------------------------------------------------- |
|---|
| 54 | # USAGE: _buildGroup <frame> <xmlobj> <path> |
|---|
| 55 | # |
|---|
| 56 | # Used internally when this page is being constructed to build the |
|---|
| 57 | # controls within the group at the specified <path> in the <xmlobj>. |
|---|
| 58 | # The controls are added to the given <frame>. |
|---|
| 59 | # ---------------------------------------------------------------------- |
|---|
| 60 | itcl::body Rappture::Page::_buildGroup {frame xmlobj path} { |
|---|
| 61 | frame $frame.results |
|---|
| 62 | pack $frame.results -side right -fill y |
|---|
| 63 | |
|---|
| 64 | set deveditor "" |
|---|
| 65 | |
|---|
| 66 | # |
|---|
| 67 | # Scan through all remaining input elements. If there is an |
|---|
| 68 | # ambient group, then add its children to the device editor, |
|---|
| 69 | # if there is one. |
|---|
| 70 | # |
|---|
| 71 | set num 0 |
|---|
| 72 | set clist [$xmlobj children $path] |
|---|
| 73 | while {[llength $clist] > 0} { |
|---|
| 74 | set cname [lindex $clist 0] |
|---|
| 75 | set clist [lrange $clist 1 end] |
|---|
| 76 | |
|---|
| 77 | set type [$xmlobj element -as type $path.$cname] |
|---|
| 78 | if {$type == "about"} { |
|---|
| 79 | continue |
|---|
| 80 | } |
|---|
| 81 | |
|---|
| 82 | if {$type == "loader"} { |
|---|
| 83 | # |
|---|
| 84 | # Add <loader>'s at the top of the page. |
|---|
| 85 | # |
|---|
| 86 | if {![winfo exists $frame.loaders]} { |
|---|
| 87 | frame $frame.loaders |
|---|
| 88 | pack $frame.loaders -side top -fill x |
|---|
| 89 | |
|---|
| 90 | frame $frame.loaders.sep -height 2 \ |
|---|
| 91 | -borderwidth 1 -relief sunken |
|---|
| 92 | pack $frame.loaders.sep -side bottom -fill x -pady 4 |
|---|
| 93 | } |
|---|
| 94 | set w "$frame.loaders.l[incr num]" |
|---|
| 95 | Rappture::Controls $w $_owner |
|---|
| 96 | pack $w -fill x |
|---|
| 97 | $w insert end $path.$cname |
|---|
| 98 | } elseif {$type == "structure"} { |
|---|
| 99 | # |
|---|
| 100 | # Add <structure>'s as the central element of the page. |
|---|
| 101 | # |
|---|
| 102 | set w "$frame.device[incr num]" |
|---|
| 103 | Rappture::DeviceEditor ::$w $_owner@$path.$cname.current |
|---|
| 104 | pack $w -expand yes -fill both |
|---|
| 105 | $_owner widgetfor $path.$cname $w |
|---|
| 106 | bind $w <<Value>> [list $_owner changed $path.$cname] |
|---|
| 107 | |
|---|
| 108 | if {"" == $deveditor} { |
|---|
| 109 | set deveditor $w |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | # if there's a default value, load it now |
|---|
| 113 | if {"" != [$xmlobj element -as type $path.$cname.current]} { |
|---|
| 114 | set elem $path.$cname.current |
|---|
| 115 | } else { |
|---|
| 116 | set elem $path.$cname.default |
|---|
| 117 | } |
|---|
| 118 | if {"" != [$xmlobj element -as type $elem]} { |
|---|
| 119 | set val [$xmlobj get $elem] |
|---|
| 120 | if {[string length $val] > 0} { |
|---|
| 121 | $w value $val |
|---|
| 122 | $xmlobj put $path.$cname.current $val |
|---|
| 123 | } else { |
|---|
| 124 | set obj [$xmlobj element -as object $elem] |
|---|
| 125 | $w value $obj |
|---|
| 126 | $xmlobj put $path.$cname.current $obj |
|---|
| 127 | } |
|---|
| 128 | } |
|---|
| 129 | |
|---|
| 130 | # if there's a link, then set up a callback to load from it |
|---|
| 131 | set link [$xmlobj get $path.$cname.link] |
|---|
| 132 | if {"" != $link} { |
|---|
| 133 | $_owner notify add $this $link \ |
|---|
| 134 | [itcl::code $this _link $xmlobj $link $w $path.$cname] |
|---|
| 135 | } |
|---|
| 136 | } elseif {$type == "drawing"} { |
|---|
| 137 | # |
|---|
| 138 | # Add <drawing>'s as the central element of the page. |
|---|
| 139 | # |
|---|
| 140 | set w "$frame.drawing[incr num]" |
|---|
| 141 | Rappture::DrawingEntry ::$w $_owner $path.$cname.current |
|---|
| 142 | pack $w -expand yes -fill both |
|---|
| 143 | $_owner widgetfor $path.$cname $w |
|---|
| 144 | bind $w <<Value>> [list $_owner changed $path.$cname] |
|---|
| 145 | |
|---|
| 146 | # if there's a default value, load it now |
|---|
| 147 | if {"" != [$xmlobj element -as type $path.$cname.current]} { |
|---|
| 148 | set elem $path.$cname.current |
|---|
| 149 | } else { |
|---|
| 150 | set elem $path.$cname.default |
|---|
| 151 | } |
|---|
| 152 | if {"" != [$xmlobj element -as type $elem]} { |
|---|
| 153 | set val [$xmlobj get $elem] |
|---|
| 154 | if {[string length $val] > 0} { |
|---|
| 155 | $w value $val |
|---|
| 156 | $xmlobj put $path.$cname.current $val |
|---|
| 157 | } else { |
|---|
| 158 | set obj [$xmlobj element -as object $elem] |
|---|
| 159 | $w value $obj |
|---|
| 160 | $xmlobj put $path.$cname.current $obj |
|---|
| 161 | } |
|---|
| 162 | } |
|---|
| 163 | } elseif {$type == "tool"} { |
|---|
| 164 | set service [Rappture::Service ::#auto $_owner $path.$cname] |
|---|
| 165 | # |
|---|
| 166 | # Scan through all extra inputs associated with this subtool |
|---|
| 167 | # and create corresponding inputs in the top-level tool. |
|---|
| 168 | # Then, add the input names to the list being processed here, |
|---|
| 169 | # so that we'll create the controls during subsequent passes |
|---|
| 170 | # through the loop. |
|---|
| 171 | # |
|---|
| 172 | set extra "" |
|---|
| 173 | foreach obj [$service input] { |
|---|
| 174 | set cname [$obj element] |
|---|
| 175 | $xmlobj copy $path.$cname from $obj "" |
|---|
| 176 | lappend extra $cname |
|---|
| 177 | } |
|---|
| 178 | |
|---|
| 179 | # |
|---|
| 180 | # If there's a control for this service, then add it |
|---|
| 181 | # to the end of the extra controls added above. |
|---|
| 182 | # |
|---|
| 183 | foreach obj [$service control] { |
|---|
| 184 | set cname [$obj element] |
|---|
| 185 | $xmlobj copy $path.$cname from $obj "" |
|---|
| 186 | $xmlobj put $path.$cname.service $service |
|---|
| 187 | lappend extra $cname |
|---|
| 188 | } |
|---|
| 189 | if {[llength $extra] > 0} { |
|---|
| 190 | set clist [eval linsert [list $clist] 0 $extra] |
|---|
| 191 | } |
|---|
| 192 | |
|---|
| 193 | # |
|---|
| 194 | # Scan through all outputs associated with this subtool |
|---|
| 195 | # and create any corresponding feedback widgets. |
|---|
| 196 | # |
|---|
| 197 | foreach obj [$service output] { |
|---|
| 198 | set cname [$obj element] |
|---|
| 199 | $xmlobj copy $cname from $obj "" |
|---|
| 200 | |
|---|
| 201 | # pick a good size based on output type |
|---|
| 202 | set w $frame.results.result[incr num] |
|---|
| 203 | set type [$obj element -as type] |
|---|
| 204 | switch -- $type { |
|---|
| 205 | number - integer - boolean - choice { |
|---|
| 206 | Rappture::ResultViewer $w -width 0 -height 0 |
|---|
| 207 | pack $w -fill x -padx 4 -pady 4 |
|---|
| 208 | } |
|---|
| 209 | default { |
|---|
| 210 | Rappture::ResultViewer $w -width 4i -height 4i |
|---|
| 211 | pack $w -expand yes -fill both -padx 4 -pady 4 |
|---|
| 212 | } |
|---|
| 213 | } |
|---|
| 214 | $service output for $obj $w |
|---|
| 215 | } |
|---|
| 216 | } elseif {$type == "current"} { |
|---|
| 217 | # Don't do anything. |
|---|
| 218 | } else { |
|---|
| 219 | # create a control panel, if necessary |
|---|
| 220 | if {![winfo exists $frame.cntls]} { |
|---|
| 221 | Rappture::Controls $frame.cntls $_owner |
|---|
| 222 | pack $frame.cntls -expand yes -fill both -pady 4 |
|---|
| 223 | } |
|---|
| 224 | |
|---|
| 225 | # if this is a group, then build that group |
|---|
| 226 | if {[$xmlobj element -as type $path.$cname] == "group"} { |
|---|
| 227 | if {[$xmlobj element -as id $path.$cname] == "ambient" |
|---|
| 228 | && $deveditor != ""} { |
|---|
| 229 | set w [$deveditor component top] |
|---|
| 230 | } else { |
|---|
| 231 | if {[catch {$frame.cntls insert end $path.$cname} c]} { |
|---|
| 232 | global errorInfo |
|---|
| 233 | error $c "$c\n$errorInfo\n (while building control for $path.$cname)" |
|---|
| 234 | } else { |
|---|
| 235 | set gentry [$frame.cntls control $c] |
|---|
| 236 | set w [$gentry component inner] |
|---|
| 237 | } |
|---|
| 238 | } |
|---|
| 239 | _buildGroup $w $xmlobj $path.$cname |
|---|
| 240 | } else { |
|---|
| 241 | if {[catch {$frame.cntls insert end $path.$cname} c]} { |
|---|
| 242 | global errorInfo |
|---|
| 243 | error $c "$c\n$errorInfo\n (while building control for $path.$cname)" |
|---|
| 244 | } |
|---|
| 245 | } |
|---|
| 246 | } |
|---|
| 247 | } |
|---|
| 248 | } |
|---|
| 249 | |
|---|
| 250 | itcl::body Rappture::Page::_link {xmlobj path w path2} { |
|---|
| 251 | if {"" != [$xmlobj element -as type $path.current]} { |
|---|
| 252 | set val [$xmlobj get $path.current] |
|---|
| 253 | if {[string length $val] > 0} { |
|---|
| 254 | $w value $val |
|---|
| 255 | $xmlobj put $path.current $val |
|---|
| 256 | } else { |
|---|
| 257 | set obj [$xmlobj element -as object $path.current] |
|---|
| 258 | $w value $obj |
|---|
| 259 | $xmlobj put $path.current $obj |
|---|
| 260 | } |
|---|
| 261 | } |
|---|
| 262 | $_owner changed $path2 |
|---|
| 263 | } |
|---|
