| 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
|---|
| 2 | #!/bin/sh |
|---|
| 3 | # ---------------------------------------------------------------------- |
|---|
| 4 | # USER INTERFACE DRIVER |
|---|
| 5 | # |
|---|
| 6 | # This driver program loads a tool description from a tool.xml file, |
|---|
| 7 | # and produces a user interface automatically to drive an application. |
|---|
| 8 | # The user can set up input, click and button to launch a tool, and |
|---|
| 9 | # browse through output. |
|---|
| 10 | # |
|---|
| 11 | # RUN AS FOLLOWS: |
|---|
| 12 | # wish main.tcl ?-tool <toolfile>? |
|---|
| 13 | # |
|---|
| 14 | # If the <toolfile> is not specified, it defaults to "tool.xml" in |
|---|
| 15 | # the current working directory. |
|---|
| 16 | # |
|---|
| 17 | # ====================================================================== |
|---|
| 18 | # AUTHOR: Michael McLennan, Purdue University |
|---|
| 19 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
|---|
| 20 | # |
|---|
| 21 | # See the file "license.terms" for information on usage and |
|---|
| 22 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|---|
| 23 | # ====================================================================== |
|---|
| 24 | |
|---|
| 25 | # take the main window down for now, so we can avoid a flash on the screen |
|---|
| 26 | wm withdraw . |
|---|
| 27 | |
|---|
| 28 | package require Itcl |
|---|
| 29 | package require Img |
|---|
| 30 | package require Rappture |
|---|
| 31 | package require RapptureGUI |
|---|
| 32 | |
|---|
| 33 | option add *MainWin.mode desktop startupFile |
|---|
| 34 | option add *MainWin.borderWidth 0 startupFile |
|---|
| 35 | option add *MainWin.anchor fill startupFile |
|---|
| 36 | |
|---|
| 37 | # "web site" look |
|---|
| 38 | option add *MainWin.bgScript { |
|---|
| 39 | rectangle 0 0 200 <h> -outline "" -fill #5880BB |
|---|
| 40 | rectangle 200 0 300 <h> -outline "" -fill #425F8B |
|---|
| 41 | rectangle 300 0 <w> <h> -outline "" -fill #324565 |
|---|
| 42 | } startupFile |
|---|
| 43 | |
|---|
| 44 | # "clean" look |
|---|
| 45 | option add *MainWin.bgScript "" startupFile |
|---|
| 46 | option add *MainWin.bgColor white startupFile |
|---|
| 47 | option add *Tooltip.background white |
|---|
| 48 | option add *Editor.background white |
|---|
| 49 | option add *Gauge.textBackground white |
|---|
| 50 | option add *TemperatureGauge.textBackground white |
|---|
| 51 | option add *Switch.textBackground white |
|---|
| 52 | option add *Progress.barColor #ffffcc |
|---|
| 53 | option add *Balloon.titleBackground #6666cc |
|---|
| 54 | option add *Balloon.titleForeground white |
|---|
| 55 | option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-12-* |
|---|
| 56 | option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-12-* |
|---|
| 57 | option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-12-* |
|---|
| 58 | option add *ResultSelector.controlbarBackground #6666cc |
|---|
| 59 | option add *ResultSelector.controlbarForeground white |
|---|
| 60 | option add *ResultSelector.activeControlBackground #ccccff |
|---|
| 61 | option add *ResultSelector.activeControlForeground black |
|---|
| 62 | option add *Radiodial.length 3i |
|---|
| 63 | option add *BugReport*banner*foreground white |
|---|
| 64 | option add *BugReport*banner*background #a9a9a9 |
|---|
| 65 | option add *BugReport*banner*highlightBackground #a9a9a9 |
|---|
| 66 | option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-18-* |
|---|
| 67 | option add *hubcntls*Button.padX 0 widgetDefault |
|---|
| 68 | option add *hubcntls*Button.padY 0 widgetDefault |
|---|
| 69 | option add *hubcntls*Button.relief flat widgetDefault |
|---|
| 70 | option add *hubcntls*Button.overRelief raised widgetDefault |
|---|
| 71 | option add *hubcntls*Button.borderWidth 1 widgetDefault |
|---|
| 72 | option add *hubcntls*Button.font \ |
|---|
| 73 | -*-helvetica-medium-r-normal-*-8-* widgetDefault |
|---|
| 74 | |
|---|
| 75 | switch $tcl_platform(platform) { |
|---|
| 76 | unix - windows { |
|---|
| 77 | event add <<PopupMenu>> <ButtonPress-3> |
|---|
| 78 | } |
|---|
| 79 | macintosh { |
|---|
| 80 | event add <<PopupMenu>> <Control-ButtonPress-1> |
|---|
| 81 | } |
|---|
| 82 | } |
|---|
| 83 | |
|---|
| 84 | # install a better bug handler |
|---|
| 85 | Rappture::bugreport::install |
|---|
| 86 | # fix the "grab" command to support a stack of grab windows |
|---|
| 87 | Rappture::grab::init |
|---|
| 88 | |
|---|
| 89 | # |
|---|
| 90 | # Process command line args to get the names of files to load... |
|---|
| 91 | # |
|---|
| 92 | Rappture::getopts argv params { |
|---|
| 93 | value -tool tool.xml |
|---|
| 94 | list -load "" |
|---|
| 95 | value -input "" |
|---|
| 96 | value -nosim 0 |
|---|
| 97 | } |
|---|
| 98 | |
|---|
| 99 | set loadobjs {} |
|---|
| 100 | foreach runfile $params(-load) { |
|---|
| 101 | if {![file exists $runfile]} { |
|---|
| 102 | puts stderr "can't find run: \"$runfile\"" |
|---|
| 103 | exit 1 |
|---|
| 104 | } |
|---|
| 105 | set status [catch {Rappture::library $runfile} result] |
|---|
| 106 | lappend loadobjs $result |
|---|
| 107 | } |
|---|
| 108 | |
|---|
| 109 | set inputobj {} |
|---|
| 110 | if {$params(-input) ne ""} { |
|---|
| 111 | if {![file exists $params(-input)]} { |
|---|
| 112 | puts stderr "can't find input file: \"$params(-input)\"" |
|---|
| 113 | exit 1 |
|---|
| 114 | } |
|---|
| 115 | if {[catch {Rappture::library $params(-input)} result] == 0} { |
|---|
| 116 | set inputobj $result |
|---|
| 117 | } |
|---|
| 118 | } |
|---|
| 119 | |
|---|
| 120 | # open the XML file containing the tool parameters |
|---|
| 121 | if {![file exists $params(-tool)]} { |
|---|
| 122 | # check to see if the user specified any run.xml files to load. |
|---|
| 123 | # if so, we can use that as the tool.xml. if we can find where |
|---|
| 124 | # the original application was installed using the xml tag |
|---|
| 125 | # tool.version.application.directory(top), the user can |
|---|
| 126 | # run new simulations, otherwise they can only revisualize the |
|---|
| 127 | # run.xml files they are loading. |
|---|
| 128 | set pseudotool "" |
|---|
| 129 | if {[llength $loadobjs] == 0 && $inputobj eq ""} { |
|---|
| 130 | puts stderr "can't find tool \"$params(-tool)\"" |
|---|
| 131 | exit 1 |
|---|
| 132 | } |
|---|
| 133 | # search the loadfiles for the install location |
|---|
| 134 | # we could just use run.xml files as tool.xml, but |
|---|
| 135 | # if there are loaders or notes, they will still need |
|---|
| 136 | # examples/ and docs/ dirs from the install location |
|---|
| 137 | set check [concat $loadobjs $inputobj] |
|---|
| 138 | foreach runobj $check { |
|---|
| 139 | set tdir \ |
|---|
| 140 | [string trim [$runobj get tool.version.application.directory(tool)]] |
|---|
| 141 | if {[file isdirectory $tdir] && \ |
|---|
| 142 | [file exists $tdir/tool.xml]} { |
|---|
| 143 | set pseudotool $tdir/tool.xml |
|---|
| 144 | break |
|---|
| 145 | } |
|---|
| 146 | } |
|---|
| 147 | if {![file exists $pseudotool]} { |
|---|
| 148 | # we didn't find a tool.xml file, |
|---|
| 149 | # use info from a runfile to build gui |
|---|
| 150 | # disable simulation, because no tool.xml |
|---|
| 151 | set pseudotool [lindex $params(-load) 0] |
|---|
| 152 | array set params [list -nosim true] |
|---|
| 153 | } |
|---|
| 154 | if {![file exists $pseudotool]} { |
|---|
| 155 | puts stderr "can't find tool \"$params(-tool)\"" |
|---|
| 156 | exit 1 |
|---|
| 157 | } |
|---|
| 158 | array set params [list -tool $pseudotool] |
|---|
| 159 | } |
|---|
| 160 | |
|---|
| 161 | set xmlobj [Rappture::library $params(-tool)] |
|---|
| 162 | |
|---|
| 163 | set installdir [file normalize [file dirname $params(-tool)]] |
|---|
| 164 | $xmlobj put tool.version.application.directory(tool) $installdir |
|---|
| 165 | |
|---|
| 166 | set tool [Rappture::Tool ::#auto $xmlobj $installdir] |
|---|
| 167 | |
|---|
| 168 | # ---------------------------------------------------------------------- |
|---|
| 169 | # CHECK JOB FAILURE REPORTING |
|---|
| 170 | # |
|---|
| 171 | # If this tool might fail when it launches jobs (i.e., Rappture |
|---|
| 172 | # can't check some inputs, such as strings), then disable the |
|---|
| 173 | # automatic ticket submission for job failures |
|---|
| 174 | # ---------------------------------------------------------------------- |
|---|
| 175 | set val [string trim [$tool xml get tool.reportJobFailures]] |
|---|
| 176 | if { "" != $val} { |
|---|
| 177 | if {[catch {Rappture::bugreport::shouldReport jobfailures $val} result]} { |
|---|
| 178 | puts stderr "WARNING for reportJobFailures: $result" |
|---|
| 179 | } |
|---|
| 180 | } |
|---|
| 181 | |
|---|
| 182 | # ---------------------------------------------------------------------- |
|---|
| 183 | # LOAD RESOURCE SETTINGS |
|---|
| 184 | # |
|---|
| 185 | # Try to load the $SESSIONDIR/resources file, which contains |
|---|
| 186 | # middleware settings, such as the application name and the |
|---|
| 187 | # filexfer settings. |
|---|
| 188 | # ---------------------------------------------------------------------- |
|---|
| 189 | Rappture::resources::load |
|---|
| 190 | |
|---|
| 191 | # ---------------------------------------------------------------------- |
|---|
| 192 | # START LOGGING |
|---|
| 193 | # |
|---|
| 194 | # If the $RAPPTURE_LOG directory is set to a directory used for |
|---|
| 195 | # logging, then open a log file and start logging. |
|---|
| 196 | # ---------------------------------------------------------------------- |
|---|
| 197 | Rappture::Logger::init |
|---|
| 198 | |
|---|
| 199 | # ---------------------------------------------------------------------- |
|---|
| 200 | # INITIALIZE THE DESKTOP CONNECTION |
|---|
| 201 | # |
|---|
| 202 | # If there's a SESSION ID, then this must be running within the |
|---|
| 203 | # nanoHUB. Try to initialize the server handling the desktop |
|---|
| 204 | # connection. |
|---|
| 205 | # ---------------------------------------------------------------------- |
|---|
| 206 | Rappture::filexfer::init |
|---|
| 207 | |
|---|
| 208 | # ---------------------------------------------------------------------- |
|---|
| 209 | # MAIN WINDOW |
|---|
| 210 | # ---------------------------------------------------------------------- |
|---|
| 211 | Rappture::MainWin .main -borderwidth 0 |
|---|
| 212 | .main configure -title [string trim [$tool xml get tool.title]] |
|---|
| 213 | wm withdraw .main |
|---|
| 214 | wm protocol .main WM_DELETE_WINDOW {Rappture::Logger::cleanup; exit} |
|---|
| 215 | |
|---|
| 216 | # if the FULLSCREEN variable is set, then nanoHUB wants us to go full screen |
|---|
| 217 | if {[info exists env(FULLSCREEN)]} { |
|---|
| 218 | .main configure -mode web |
|---|
| 219 | } |
|---|
| 220 | |
|---|
| 221 | # |
|---|
| 222 | # The main window has a pager that acts as a notebook for the |
|---|
| 223 | # various parts. This notebook as at least two pages--an input |
|---|
| 224 | # page and an output (analysis) page. If there are <phase>'s |
|---|
| 225 | # for input, then there are more pages in the notebook. |
|---|
| 226 | # |
|---|
| 227 | set win [.main component app] |
|---|
| 228 | Rappture::Postern $win.postern |
|---|
| 229 | pack $win.postern -side bottom -fill x |
|---|
| 230 | |
|---|
| 231 | Rappture::Pager $win.pager |
|---|
| 232 | pack $win.pager -expand yes -fill both |
|---|
| 233 | |
|---|
| 234 | # |
|---|
| 235 | # Add a place for about/questions in the breadcrumbs area of this pager. |
|---|
| 236 | # |
|---|
| 237 | set app [string trim [$tool xml get tool.id]] |
|---|
| 238 | set url [Rappture::Tool::resources -huburl] |
|---|
| 239 | if {"" != $url && "" != $app} { |
|---|
| 240 | set f [$win.pager component breadcrumbarea] |
|---|
| 241 | frame $f.hubcntls |
|---|
| 242 | pack $f.hubcntls -side right -padx 4 |
|---|
| 243 | label $f.hubcntls.icon -image [Rappture::icon ask] -highlightthickness 0 |
|---|
| 244 | pack $f.hubcntls.icon -side left |
|---|
| 245 | button $f.hubcntls.about -text "About this tool" -command " |
|---|
| 246 | [list Rappture::filexfer::webpage $url/tools/$app] |
|---|
| 247 | Rappture::Logger::log help about |
|---|
| 248 | " |
|---|
| 249 | pack $f.hubcntls.about -side top -anchor w |
|---|
| 250 | button $f.hubcntls.questions -text Questions? -command " |
|---|
| 251 | [list Rappture::filexfer::webpage $url/resources/$app/questions] |
|---|
| 252 | Rappture::Logger::log help questions |
|---|
| 253 | " |
|---|
| 254 | pack $f.hubcntls.questions -side top -anchor w |
|---|
| 255 | } |
|---|
| 256 | |
|---|
| 257 | # |
|---|
| 258 | # Load up the components in the various phases of input. |
|---|
| 259 | # |
|---|
| 260 | set phases [$tool xml children -type phase input] |
|---|
| 261 | if {[llength $phases] > 0} { |
|---|
| 262 | set plist "" |
|---|
| 263 | foreach name $phases { |
|---|
| 264 | lappend plist input.$name |
|---|
| 265 | } |
|---|
| 266 | set phases $plist |
|---|
| 267 | } else { |
|---|
| 268 | set phases input |
|---|
| 269 | } |
|---|
| 270 | |
|---|
| 271 | foreach comp $phases { |
|---|
| 272 | set title [string trim [$tool xml get $comp.about.label]] |
|---|
| 273 | if {$title == ""} { |
|---|
| 274 | set title "Input #auto" |
|---|
| 275 | } |
|---|
| 276 | $win.pager insert end -name $comp -title $title |
|---|
| 277 | |
|---|
| 278 | # |
|---|
| 279 | # Build the page of input controls for this phase. |
|---|
| 280 | # |
|---|
| 281 | set f [$win.pager page $comp] |
|---|
| 282 | Rappture::Page $f.cntls $tool $comp |
|---|
| 283 | pack $f.cntls -expand yes -fill both |
|---|
| 284 | } |
|---|
| 285 | |
|---|
| 286 | # let components (loaders) in the newly created pages settle |
|---|
| 287 | update |
|---|
| 288 | |
|---|
| 289 | # ---------------------------------------------------------------------- |
|---|
| 290 | # OUTPUT AREA |
|---|
| 291 | # ---------------------------------------------------------------------- |
|---|
| 292 | |
|---|
| 293 | # adjust the title of the page here. |
|---|
| 294 | # to adjust the button text, look in analyzer.tcl |
|---|
| 295 | set simtxt [string trim [$xmlobj get tool.action.label]] |
|---|
| 296 | if {"" == $simtxt} { |
|---|
| 297 | set simtxt "Simulate" |
|---|
| 298 | } |
|---|
| 299 | $win.pager insert end -name analyzer -title $simtxt |
|---|
| 300 | set f [$win.pager page analyzer] |
|---|
| 301 | $win.pager page analyzer -command [subst { |
|---|
| 302 | if { !$params(-nosim) } { |
|---|
| 303 | $win.pager busy yes |
|---|
| 304 | update |
|---|
| 305 | $f.analyze simulate -ifneeded |
|---|
| 306 | $win.pager busy no |
|---|
| 307 | } |
|---|
| 308 | }] |
|---|
| 309 | |
|---|
| 310 | Rappture::Analyzer $f.analyze $tool -simcontrol auto -notebookpage about |
|---|
| 311 | pack $f.analyze -expand yes -fill both |
|---|
| 312 | |
|---|
| 313 | $tool notify add analyzer * [list $f.analyze reset] |
|---|
| 314 | |
|---|
| 315 | # ---------------------------------------------------------------------- |
|---|
| 316 | # Finalize the arrangement |
|---|
| 317 | # ---------------------------------------------------------------------- |
|---|
| 318 | if {[llength [$win.pager page]] > 2} { |
|---|
| 319 | # We have phases, so we shouldn't allow the "Simulate" button. |
|---|
| 320 | # If it pops up, there are two ways to push simulate and duplicate |
|---|
| 321 | # links for "About" and "Questions?". |
|---|
| 322 | $f.analyze configure -simcontrol off |
|---|
| 323 | } elseif {[llength [$win.pager page]] == 2} { |
|---|
| 324 | set style [string trim [$xmlobj get tool.layout]] |
|---|
| 325 | set screenw [winfo screenwidth .] |
|---|
| 326 | |
|---|
| 327 | update idletasks |
|---|
| 328 | set w0 [winfo reqwidth [$win.pager page @0]] |
|---|
| 329 | set w1 [winfo reqwidth [$win.pager page @1]] |
|---|
| 330 | |
|---|
| 331 | if { $style != "wizard" } { |
|---|
| 332 | # If only two windows and they're small enough, put them up |
|---|
| 333 | # side-by-side |
|---|
| 334 | if {$w0+$w1 < $screenw } { |
|---|
| 335 | $win.pager configure -arrangement side-by-side |
|---|
| 336 | $f.analyze configure -holdwindow [$win.pager page @0] |
|---|
| 337 | } |
|---|
| 338 | } |
|---|
| 339 | set type [string trim [$tool xml get tool.control]] |
|---|
| 340 | if {$type == ""} { |
|---|
| 341 | set type [string trim [$tool xml get tool.control.type]] |
|---|
| 342 | } |
|---|
| 343 | set arrangement [$win.pager cget -arrangement] |
|---|
| 344 | if { $type == "" } { |
|---|
| 345 | if { $arrangement != "side-by-side" } { |
|---|
| 346 | set type auto |
|---|
| 347 | } |
|---|
| 348 | } |
|---|
| 349 | if { $arrangement != "side-by-side" && |
|---|
| 350 | ($type == "manual" || $type == "manual-resim" || |
|---|
| 351 | $type == "auto" || $style == "wizard") } { |
|---|
| 352 | # in "auto" mode, we don't need a simulate button |
|---|
| 353 | $f.analyze configure -simcontrol off |
|---|
| 354 | } else { |
|---|
| 355 | # not in "auto" mode but side-by-side, we always need the button |
|---|
| 356 | $f.analyze configure -simcontrol on |
|---|
| 357 | } |
|---|
| 358 | } |
|---|
| 359 | |
|---|
| 360 | # load previous xml runfiles |
|---|
| 361 | if {[llength $params(-load)] > 0} { |
|---|
| 362 | foreach runobj $loadobjs { |
|---|
| 363 | $f.analyze load $runobj |
|---|
| 364 | } |
|---|
| 365 | # load the inputs for the very last run |
|---|
| 366 | $tool load $runobj |
|---|
| 367 | |
|---|
| 368 | # don't need simulate button if we cannot simulate |
|---|
| 369 | if {$params(-nosim)} { |
|---|
| 370 | $f.analyze configure -simcontrol off |
|---|
| 371 | } |
|---|
| 372 | $f.analyze configure -notebookpage analyze |
|---|
| 373 | $win.pager current analyzer |
|---|
| 374 | } elseif {$params(-input) ne ""} { |
|---|
| 375 | $tool load $inputobj |
|---|
| 376 | } |
|---|
| 377 | |
|---|
| 378 | # let components (loaders) settle after the newly loaded runs |
|---|
| 379 | update |
|---|
| 380 | |
|---|
| 381 | foreach path [array names ::Rappture::parameters] { |
|---|
| 382 | set fname $::Rappture::parameters($path) |
|---|
| 383 | if {[catch { |
|---|
| 384 | set fid [open $fname r] |
|---|
| 385 | set info [read $fid] |
|---|
| 386 | close $fid}] == 0} { |
|---|
| 387 | |
|---|
| 388 | set w [$tool widgetfor $path] |
|---|
| 389 | if {$w ne ""} { |
|---|
| 390 | if {[catch {$w value [string trim $info]} result]} { |
|---|
| 391 | puts stderr "WARNING: bad tool parameter value for \"$path\"" |
|---|
| 392 | puts stderr " $result" |
|---|
| 393 | } |
|---|
| 394 | } else { |
|---|
| 395 | puts stderr "WARNING: can't find control for tool parameter: $path" |
|---|
| 396 | } |
|---|
| 397 | } |
|---|
| 398 | } |
|---|
| 399 | |
|---|
| 400 | wm deiconify .main |
|---|
