| 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 -nosim 0 |
|---|
| 96 | } |
|---|
| 97 | |
|---|
| 98 | proc ReadToolParameters { numTries } { |
|---|
| 99 | incr numTries -1 |
|---|
| 100 | if { $numTries < 0 } { |
|---|
| 101 | return |
|---|
| 102 | } |
|---|
| 103 | global env |
|---|
| 104 | set paramsFile $env(TOOL_PARAMETERS) |
|---|
| 105 | if { ![file readable $paramsFile] } { |
|---|
| 106 | after 500 ReadToolParmeters $numTries |
|---|
| 107 | return |
|---|
| 108 | } |
|---|
| 109 | catch { |
|---|
| 110 | set f [open $paramsFile "r"] |
|---|
| 111 | set contents [read $f] |
|---|
| 112 | close $f |
|---|
| 113 | set pattern {^file\((.*)\):(.*)$} |
|---|
| 114 | foreach line [split $contents "\n"] { |
|---|
| 115 | if { [regexp $pattern $line match path rest] } { |
|---|
| 116 | set ::Rappture::parameters($path) $rest |
|---|
| 117 | } |
|---|
| 118 | } |
|---|
| 119 | } |
|---|
| 120 | } |
|---|
| 121 | |
|---|
| 122 | if { [info exists env(TOOL_PARAMETERS)] } { |
|---|
| 123 | ReadToolParameters 10 |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | set loadobjs {} |
|---|
| 127 | foreach runfile $params(-load) { |
|---|
| 128 | if {![file exists $runfile]} { |
|---|
| 129 | puts stderr "can't find run: \"$runfile\"" |
|---|
| 130 | exit 1 |
|---|
| 131 | } |
|---|
| 132 | set status [catch {Rappture::library $runfile} result] |
|---|
| 133 | lappend loadobjs $result |
|---|
| 134 | } |
|---|
| 135 | |
|---|
| 136 | # open the XML file containing the tool parameters |
|---|
| 137 | if {![file exists $params(-tool)]} { |
|---|
| 138 | # check to see if the user specified any run.xml files to load. |
|---|
| 139 | # if so, we can use that as the tool.xml. if we can find where |
|---|
| 140 | # the original application was installed using the xml tag |
|---|
| 141 | # tool.version.application.directory(top), the user can |
|---|
| 142 | # run new simulations, otherwise they can only revisualize the |
|---|
| 143 | # run.xml files they are loading. |
|---|
| 144 | set pseudotool "" |
|---|
| 145 | if {0 == [llength $loadobjs]} { |
|---|
| 146 | puts stderr "can't find tool \"$params(-tool)\"" |
|---|
| 147 | exit 1 |
|---|
| 148 | } |
|---|
| 149 | # search the loadfiles for the install location |
|---|
| 150 | # we could just use run.xml files as tool.xml, but |
|---|
| 151 | # if there are loaders or notes, they will still need |
|---|
| 152 | # examples/ and docs/ dirs from the install location |
|---|
| 153 | foreach runobj $loadobjs { |
|---|
| 154 | set tdir \ |
|---|
| 155 | [string trim [$runobj get tool.version.application.directory(tool)]] |
|---|
| 156 | if {[file isdirectory $tdir] && \ |
|---|
| 157 | [file exists $tdir/tool.xml]} { |
|---|
| 158 | set pseudotool $tdir/tool.xml |
|---|
| 159 | break |
|---|
| 160 | } |
|---|
| 161 | } |
|---|
| 162 | if {![file exists $pseudotool]} { |
|---|
| 163 | # we didn't find a tool.xml file, |
|---|
| 164 | # use info from a runfile to build gui |
|---|
| 165 | # disable simulation, because no tool.xml |
|---|
| 166 | set pseudotool [lindex $params(-load) 0] |
|---|
| 167 | array set params [list -nosim true] |
|---|
| 168 | } |
|---|
| 169 | if {![file exists $pseudotool]} { |
|---|
| 170 | puts stderr "can't find tool \"$params(-tool)\"" |
|---|
| 171 | exit 1 |
|---|
| 172 | } |
|---|
| 173 | array set params [list -tool $pseudotool] |
|---|
| 174 | } |
|---|
| 175 | |
|---|
| 176 | set xmlobj [Rappture::library $params(-tool)] |
|---|
| 177 | |
|---|
| 178 | set installdir [file normalize [file dirname $params(-tool)]] |
|---|
| 179 | $xmlobj put tool.version.application.directory(tool) $installdir |
|---|
| 180 | |
|---|
| 181 | set tool [Rappture::Tool ::#auto $xmlobj $installdir] |
|---|
| 182 | |
|---|
| 183 | # ---------------------------------------------------------------------- |
|---|
| 184 | # CHECK JOB FAILURE REPORTING |
|---|
| 185 | # |
|---|
| 186 | # If this tool might fail when it launches jobs (i.e., Rappture |
|---|
| 187 | # can't check some inputs, such as strings), then disable the |
|---|
| 188 | # automatic ticket submission for job failures |
|---|
| 189 | # ---------------------------------------------------------------------- |
|---|
| 190 | set val [string trim [$tool xml get tool.reportJobFailures]] |
|---|
| 191 | if { "" != $val} { |
|---|
| 192 | if {[catch {Rappture::bugreport::shouldReport jobfailures $val} result]} { |
|---|
| 193 | puts stderr "WARNING for reportJobFailures: $result" |
|---|
| 194 | } |
|---|
| 195 | } |
|---|
| 196 | |
|---|
| 197 | # ---------------------------------------------------------------------- |
|---|
| 198 | # LOAD RESOURCE SETTINGS |
|---|
| 199 | # |
|---|
| 200 | # Try to load the $SESSIONDIR/resources file, which contains |
|---|
| 201 | # middleware settings, such as the application name and the |
|---|
| 202 | # filexfer settings. |
|---|
| 203 | # ---------------------------------------------------------------------- |
|---|
| 204 | Rappture::resources::load |
|---|
| 205 | |
|---|
| 206 | # ---------------------------------------------------------------------- |
|---|
| 207 | # START LOGGING |
|---|
| 208 | # |
|---|
| 209 | # If the $RAPPTURE_LOG directory is set to a directory used for |
|---|
| 210 | # logging, then open a log file and start logging. |
|---|
| 211 | # ---------------------------------------------------------------------- |
|---|
| 212 | Rappture::Logger::init |
|---|
| 213 | |
|---|
| 214 | # ---------------------------------------------------------------------- |
|---|
| 215 | # INITIALIZE THE DESKTOP CONNECTION |
|---|
| 216 | # |
|---|
| 217 | # If there's a SESSION ID, then this must be running within the |
|---|
| 218 | # nanoHUB. Try to initialize the server handling the desktop |
|---|
| 219 | # connection. |
|---|
| 220 | # ---------------------------------------------------------------------- |
|---|
| 221 | Rappture::filexfer::init |
|---|
| 222 | |
|---|
| 223 | # ---------------------------------------------------------------------- |
|---|
| 224 | # MAIN WINDOW |
|---|
| 225 | # ---------------------------------------------------------------------- |
|---|
| 226 | Rappture::MainWin .main -borderwidth 0 |
|---|
| 227 | .main configure -title [string trim [$tool xml get tool.title]] |
|---|
| 228 | wm withdraw .main |
|---|
| 229 | wm protocol .main WM_DELETE_WINDOW {Rappture::Logger::cleanup; exit} |
|---|
| 230 | |
|---|
| 231 | # if the FULLSCREEN variable is set, then nanoHUB wants us to go full screen |
|---|
| 232 | if {[info exists env(FULLSCREEN)]} { |
|---|
| 233 | .main configure -mode web |
|---|
| 234 | } |
|---|
| 235 | |
|---|
| 236 | # |
|---|
| 237 | # The main window has a pager that acts as a notebook for the |
|---|
| 238 | # various parts. This notebook as at least two pages--an input |
|---|
| 239 | # page and an output (analysis) page. If there are <phase>'s |
|---|
| 240 | # for input, then there are more pages in the notebook. |
|---|
| 241 | # |
|---|
| 242 | set win [.main component app] |
|---|
| 243 | Rappture::Postern $win.postern |
|---|
| 244 | pack $win.postern -side bottom -fill x |
|---|
| 245 | |
|---|
| 246 | Rappture::Pager $win.pager |
|---|
| 247 | pack $win.pager -expand yes -fill both |
|---|
| 248 | |
|---|
| 249 | # |
|---|
| 250 | # Add a place for about/questions in the breadcrumbs area of this pager. |
|---|
| 251 | # |
|---|
| 252 | set app [string trim [$tool xml get tool.id]] |
|---|
| 253 | set url [Rappture::Tool::resources -huburl] |
|---|
| 254 | if {"" != $url && "" != $app} { |
|---|
| 255 | set f [$win.pager component breadcrumbarea] |
|---|
| 256 | frame $f.hubcntls |
|---|
| 257 | pack $f.hubcntls -side right -padx 4 |
|---|
| 258 | label $f.hubcntls.icon -image [Rappture::icon ask] -highlightthickness 0 |
|---|
| 259 | pack $f.hubcntls.icon -side left |
|---|
| 260 | button $f.hubcntls.about -text "About this tool" -command " |
|---|
| 261 | [list Rappture::filexfer::webpage $url/tools/$app] |
|---|
| 262 | Rappture::Logger::log help about |
|---|
| 263 | " |
|---|
| 264 | pack $f.hubcntls.about -side top -anchor w |
|---|
| 265 | button $f.hubcntls.questions -text Questions? -command " |
|---|
| 266 | [list Rappture::filexfer::webpage $url/resources/$app/questions] |
|---|
| 267 | Rappture::Logger::log help questions |
|---|
| 268 | " |
|---|
| 269 | pack $f.hubcntls.questions -side top -anchor w |
|---|
| 270 | } |
|---|
| 271 | |
|---|
| 272 | # |
|---|
| 273 | # Load up the components in the various phases of input. |
|---|
| 274 | # |
|---|
| 275 | set phases [$tool xml children -type phase input] |
|---|
| 276 | if {[llength $phases] > 0} { |
|---|
| 277 | set plist "" |
|---|
| 278 | foreach name $phases { |
|---|
| 279 | lappend plist input.$name |
|---|
| 280 | } |
|---|
| 281 | set phases $plist |
|---|
| 282 | } else { |
|---|
| 283 | set phases input |
|---|
| 284 | } |
|---|
| 285 | |
|---|
| 286 | foreach comp $phases { |
|---|
| 287 | set title [string trim [$tool xml get $comp.about.label]] |
|---|
| 288 | if {$title == ""} { |
|---|
| 289 | set title "Input #auto" |
|---|
| 290 | } |
|---|
| 291 | $win.pager insert end -name $comp -title $title |
|---|
| 292 | |
|---|
| 293 | # |
|---|
| 294 | # Build the page of input controls for this phase. |
|---|
| 295 | # |
|---|
| 296 | set f [$win.pager page $comp] |
|---|
| 297 | Rappture::Page $f.cntls $tool $comp |
|---|
| 298 | pack $f.cntls -expand yes -fill both |
|---|
| 299 | } |
|---|
| 300 | |
|---|
| 301 | # let components (loaders) in the newly created pages settle |
|---|
| 302 | update |
|---|
| 303 | |
|---|
| 304 | # ---------------------------------------------------------------------- |
|---|
| 305 | # OUTPUT AREA |
|---|
| 306 | # ---------------------------------------------------------------------- |
|---|
| 307 | |
|---|
| 308 | # adjust the title of the page here. |
|---|
| 309 | # to adjust the button text, look in analyzer.tcl |
|---|
| 310 | set simtxt [string trim [$xmlobj get tool.action.label]] |
|---|
| 311 | if {"" == $simtxt} { |
|---|
| 312 | set simtxt "Simulate" |
|---|
| 313 | } |
|---|
| 314 | $win.pager insert end -name analyzer -title $simtxt |
|---|
| 315 | set f [$win.pager page analyzer] |
|---|
| 316 | $win.pager page analyzer -command [subst { |
|---|
| 317 | if { !$params(-nosim) } { |
|---|
| 318 | $win.pager busy yes |
|---|
| 319 | update |
|---|
| 320 | $f.analyze simulate -ifneeded |
|---|
| 321 | $win.pager busy no |
|---|
| 322 | } |
|---|
| 323 | }] |
|---|
| 324 | |
|---|
| 325 | Rappture::Analyzer $f.analyze $tool -simcontrol auto -notebookpage about |
|---|
| 326 | pack $f.analyze -expand yes -fill both |
|---|
| 327 | |
|---|
| 328 | $tool notify add analyzer * [list $f.analyze reset] |
|---|
| 329 | |
|---|
| 330 | # ---------------------------------------------------------------------- |
|---|
| 331 | # Finalize the arrangement |
|---|
| 332 | # ---------------------------------------------------------------------- |
|---|
| 333 | if {[llength [$win.pager page]] > 2} { |
|---|
| 334 | # We have phases, so we shouldn't allow the "Simulate" button. |
|---|
| 335 | # If it pops up, there are two ways to push simulate and duplicate |
|---|
| 336 | # links for "About" and "Questions?". |
|---|
| 337 | $f.analyze configure -simcontrol off |
|---|
| 338 | } elseif {[llength [$win.pager page]] == 2} { |
|---|
| 339 | set style [string trim [$xmlobj get tool.layout]] |
|---|
| 340 | set screenw [winfo screenwidth .] |
|---|
| 341 | |
|---|
| 342 | update idletasks |
|---|
| 343 | set w0 [winfo reqwidth [$win.pager page @0]] |
|---|
| 344 | set w1 [winfo reqwidth [$win.pager page @1]] |
|---|
| 345 | |
|---|
| 346 | if { $style != "wizard" } { |
|---|
| 347 | # If only two windows and they're small enough, put them up |
|---|
| 348 | # side-by-side |
|---|
| 349 | if {$w0+$w1 < $screenw } { |
|---|
| 350 | $win.pager configure -arrangement side-by-side |
|---|
| 351 | $f.analyze configure -holdwindow [$win.pager page @0] |
|---|
| 352 | } |
|---|
| 353 | } |
|---|
| 354 | set type [string trim [$tool xml get tool.control]] |
|---|
| 355 | if {$type == ""} { |
|---|
| 356 | set type [string trim [$tool xml get tool.control.type]] |
|---|
| 357 | } |
|---|
| 358 | set arrangement [$win.pager cget -arrangement] |
|---|
| 359 | if { $type == "" } { |
|---|
| 360 | if { $arrangement != "side-by-side" } { |
|---|
| 361 | set type auto |
|---|
| 362 | } |
|---|
| 363 | } |
|---|
| 364 | if { $arrangement != "side-by-side" && |
|---|
| 365 | ($type == "manual" || $type == "manual-resim" || |
|---|
| 366 | $type == "auto" || $style == "wizard") } { |
|---|
| 367 | # in "auto" mode, we don't need a simulate button |
|---|
| 368 | $f.analyze configure -simcontrol off |
|---|
| 369 | } else { |
|---|
| 370 | # not in "auto" mode but side-by-side, we always need the button |
|---|
| 371 | $f.analyze configure -simcontrol on |
|---|
| 372 | } |
|---|
| 373 | } |
|---|
| 374 | |
|---|
| 375 | # load previous xml runfiles |
|---|
| 376 | if {0 != [llength $params(-load)]} { |
|---|
| 377 | foreach runobj $loadobjs { |
|---|
| 378 | # this doesn't seem to work with loaders |
|---|
| 379 | # loaders seem to get their value after this point |
|---|
| 380 | # may need to tell loader elements to update its value |
|---|
| 381 | $tool load $runobj |
|---|
| 382 | $f.analyze load $runobj |
|---|
| 383 | } |
|---|
| 384 | # don't need simulate button if we cannot simulate |
|---|
| 385 | if {$params(-nosim)} { |
|---|
| 386 | $f.analyze configure -simcontrol off |
|---|
| 387 | } |
|---|
| 388 | $f.analyze configure -notebookpage analyze |
|---|
| 389 | $win.pager current analyzer |
|---|
| 390 | } |
|---|
| 391 | |
|---|
| 392 | wm deiconify .main |
|---|
