#!/bin/sh # ---------------------------------------------------------------------- # TEST PROGRAM for nanoVIS # # This program is a test harness for the nanoVIS visualization # engine. It allows you to monitor the commands being sent back # and forth between a standard Rappture application and the nanoVIS # server. You can also send your own commands to the server, to # debug new features. # # ====================================================================== # AUTHOR: Michael McLennan, Purdue University # Copyright (c) 2004-2007 Purdue Research Foundation # # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ====================================================================== #\ exec wish "$0" $* # ---------------------------------------------------------------------- # wish executes everything from here on... lappend auto_path /usr/local/rappture/lib /usr/local/rappture/lib/vtk /usr/local/rappture/lib/vtk/tcl package require Itcl package require Rappture package require RapptureGUI option add *comm.font -*-courier-medium-r-normal-*-*-120-* option add *Menu.tearOff off option add *Tooltip.background white option add *Editor.background white option add *Gauge.textBackground white option add *TemperatureGauge.textBackground white option add *Switch.textBackground white option add *Progress.barColor #ffffcc option add *Balloon.titleBackground #6666cc option add *Balloon.titleForeground white option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-*-120-* option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-*-120-* option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-*-120-* option add *ResultSet.controlbarBackground #6666cc option add *ResultSet.controlbarForeground white option add *ResultSet.activeControlBackground #ccccff option add *ResultSet.activeControlForeground black option add *Radiodial.length 3i option add *BugReport*banner*foreground white option add *BugReport*banner*background #a9a9a9 option add *BugReport*banner*highlightBackground #a9a9a9 option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-*-180-* # fix the "grab" command to support a stack of grab windows #Rappture::grab::init # ---------------------------------------------------------------------- # LOAD RESOURCE SETTINGS # # Try to load the $SESSIONDIR/resources file, which contains # middleware settings, such as the application name and the # filexfer settings. # ---------------------------------------------------------------------- Rappture::resources::load # ---------------------------------------------------------------------- # Fake data object for sending DX data... # ---------------------------------------------------------------------- itcl::class DxData { constructor {args} { set _data [Rappture::encoding::encode -as zb64 [lindex $args 0]] } public method components {args} { if {[llength $args] == 0} { return "one" } return "" } public method values {args} { return $_data } public method hints {args} { return "" } private variable _data "" } # ---------------------------------------------------------------------- # USAGE: send_file # # Prompts the user for a text file, and then sends the text within # that file along to the rendering widget. # ---------------------------------------------------------------------- proc send_file {} { global widgets set file [tk_getOpenFile -title "Open Command File"] if {"" != $file && [catch { set fid [open $file r] fconfigure $fid -translation binary set info [read $fid] close $fid }] == 0} { set obj [DxData #auto $info] $widgets(nanovis) add $obj } } # ---------------------------------------------------------------------- # USAGE: send_command # # Invoked automatically whenever the user enters a command and # presses . Sends the command along to the rendering # widget. # ---------------------------------------------------------------------- proc send_command {} { global widgets global last_command set cmd [$widgets(command) get] # Karl if {[string length $cmd] > 0} { set last_command $cmd } else { set cmd $last_command } namespace eval Rappture::NanovisViewer [list $widgets(nanovis) _send_text $cmd] $widgets(command) delete 0 end } # ---------------------------------------------------------------------- # USAGE: karl_send_command # # Used internally in this script (not from command prompt) # ---------------------------------------------------------------------- proc karl_send_command {cmd} { global widgets namespace eval Rappture::NanovisViewer [list $widgets(nanovis) _send_text $cmd] # $widgets(command) delete 0 end } # ---------------------------------------------------------------------- # USAGE: reset # # Used internally to reset the connection to the rendering server. # Discards all data and resets the widget connection to the server. # ---------------------------------------------------------------------- proc reset {} { global widgets $widgets(nanovis) delete $widgets(nanovis) disconnect $widgets(comm) configure -state normal $widgets(comm) delete 1.0 end $widgets(comm) configure -state disabled } # ---------------------------------------------------------------------- # USAGE: show_comm # # Invoked automatically whenever there is communication between # the rendering widget and the server. Eavesdrops on the communication # and posts the commands in a text viewer. # ---------------------------------------------------------------------- proc show_comm {channel {data ""}} { global widgets $widgets(comm) configure -state normal switch -- $channel { closed { $widgets(comm) insert end "--CLOSED--\n" error } <>line { $widgets(comm) insert end $data outgoing "\n" outgoing } error { $widgets(comm) insert end $data error "\n" error } default { $widgets(comm) insert end "$data\n" } } $widgets(comm) configure -state disabled $widgets(comm) see end } # ---------------------------------------------------------------------- # USAGE: karl_activate_flow # # ---------------------------------------------------------------------- proc karl_activate_flow {} { global img_storage_dir puts "Preparing images..." # sequence of commands to initilize flow visualization go here karl_send_command {test} karl_send_command {flow vectorid 0} karl_send_command {flow particle visible on} set renderserver render05 set img_storage_dir [exec ssh $renderserver mktemp -d /tmp/animation.XXXXXX] karl_send_command "flow capture 117 $img_storage_dir" } # ---------------------------------------------------------------------- # USAGE: karl_flow_movie # # ---------------------------------------------------------------------- proc karl_flow_movie {} { global img_storage_dir set renderserver render05 if {0} { # create animated gif: puts "creating animated gif..." exec ssh $renderserver convert -delay 20 -loop 0 $img_storage_dir/image*.bmp $img_storage_dir/animated_flow.gif } else { # create mpeg movie: puts "creating mpeg movie in $img_storage_dir" exec ssh $renderserver "cd $img_storage_dir && mogrify -format jpg *.bmp && ffmpeg -i image%03d.jpg flow_movie.mpg 2>/dev/null && rm *.jpg" } # Now present the .mpg or .gif file to the user to download ## ?? return # Finally, delete the temporary animation directory we have created exec ssh $renderserver rmdir $img_storage_dir } # ---------------------------------------------------------------------- # TOPLEVEL FOR IMAGES # ---------------------------------------------------------------------- # USAGE: images_save # # Invoked when the user presses the "Save As..." button on the # images panel. Saves the current image in a file, which can be # examined by some external program. # ---------------------------------------------------------------------- proc images_save {} { global widgets images set imh [$widgets(nanovis) get -image $images(which)] set file [tk_getSaveFile -title "Save Image File" \ -defaultextension .jpg -filetypes {{{JPEG files} .jpg} {{All Files} *}}] if {"" != $file} { set cmds { $imh write $file -format jpeg } if {[catch $cmds err]} { tk_messageBox -icon error -message "Oops! Save failed:\n$err" } } } # ---------------------------------------------------------------------- # USAGE: images_refresh # # Invoked automatically whenever there is a change in the 3dview/legend # controls on the images panel. Updates the image being shown based # on the current selection. # ---------------------------------------------------------------------- proc images_refresh {} { global widgets images set c $widgets(viewer) set w [winfo width $c] set h [winfo height $c] set imh [$widgets(nanovis) get -image $images(which)] set iw [image width $imh] set ih [image height $imh] $c coords image [expr {$w/2}] [expr {$h/2}] $c itemconfigure image -image $imh $c coords outline [expr {$w/2-$iw/2}] [expr {$h/2-$ih/2}] \ [expr {$w/2+$iw/2}] [expr {$h/2+$ih/2}] } toplevel .images wm title .images "nanoVIS: Images" wm withdraw .images wm protocol .images WM_DELETE_WINDOW {wm withdraw .images} frame .images.cntls pack .images.cntls -side bottom -fill x button .images.cntls.save -text "Save As..." -command images_save pack .images.cntls.save -side right -padx 4 radiobutton .images.cntls.3dview -text "3D View" -variable images(which) \ -value "3dview" -command images_refresh pack .images.cntls.3dview -side top -anchor w radiobutton .images.cntls.legend -text "Legend" -variable images(which) \ -value "legend" -command images_refresh pack .images.cntls.legend -side top -anchor w set images(which) "3dview" canvas .images.viewer -background black -width 500 -height 500 pack .images.viewer -expand yes -fill both bind .images.viewer images_refresh set widgets(viewer) .images.viewer $widgets(viewer) create image 0 0 -anchor c \ -image [image create photo] -tags image $widgets(viewer) create rectangle 0 0 1 1 -width 2 -outline red -fill "" \ -tags outline # ---------------------------------------------------------------------- # MAIN WINDOW # ---------------------------------------------------------------------- menu .mbar menu .mbar.file .mbar.file add command -label "Send file..." -underline 0 -command send_file .mbar.file add command -label "Reset" -underline 0 -command reset .mbar.file add separator .mbar.file add command -label "Exit" -underline 1 -command exit .mbar add cascade -label "File" -underline 0 -menu .mbar.file menu .mbar.view .mbar.view add command -label "Images..." -underline 0 \ -command {wm deiconify .images} .mbar add cascade -label "View" -underline 0 -menu .mbar.view menu .mbar.flow .mbar.flow add command -label "Activate Flow" -command {karl_activate_flow} .mbar.flow add command -label "Capture Flow Movie" -command {karl_flow_movie} .mbar add cascade -label "Flow" -underline 0 -menu .mbar.flow . configure -menu .mbar Rappture::Panes .main -sashwidth 4 -sashrelief raised -sashpadding 4 \ -width 6i -height 4i pack .main -expand yes -fill both set f [.main pane 0] Rappture::Field3DResult $f.viewer pack $f.viewer -expand yes -fill both set widgets(nanovis) [$f.viewer component renderer] puts stderr [winfo class $widgets(nanovis)] $f.viewer component renderer configure \ -sendcommand show_comm \ -receivecommand show_comm set f [.main insert end -fraction 0.5] frame $f.send pack $f.send -side bottom -fill x label $f.send.l -text "Send:" pack $f.send.l -side left set widgets(command) [entry $f.send.e] pack $f.send.e -side left -expand yes -fill x bind $f.send.e send_command scrollbar $f.sb -orient vertical -command "$f.comm yview" pack $f.sb -side right -fill y text $f.comm -wrap char -yscrollcommand "$f.sb set" pack $f.comm -expand yes -fill both set widgets(comm) $f.comm $widgets(comm) tag configure error -foreground red \ -font -*-courier-medium-o-normal-*-*-120-* $widgets(comm) tag configure incoming -foreground blue