source: trunk/gui/apps/vtkviewer-test

Last change on this file was 6052, checked in by ldelgass, 9 years ago

Remove unused server list in viewer constructors. The server list is obtained
from the VisViewer? internal server list which can be modified with the
Get/SetServerList? "static" procs (and which is called while evaluating the
session resources file if present).

  • Property svn:executable set to *
File size: 13.6 KB
Line 
1#!/bin/sh
2# -*- mode: Tcl -*-
3# ----------------------------------------------------------------------
4#  TEST PROGRAM for VtkViewer
5#
6#  This program is a test harness for the VtkVis visualization
7#  engine.  It allows you to monitor the commands being sent back
8#  and forth between a standard Rappture application and the VtkVis
9#  server.  You can also send your own commands to the server, to
10#  debug new features.
11#
12# ======================================================================
13#  AUTHOR:  Michael McLennan, Purdue University
14#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
15#
16#  See the file "license.terms" for information on usage and
17#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18# ======================================================================
19#\
20bindir=`dirname $0` ; \
21. $bindir/rappture.env ; \
22exec $bindir/wish "$0" "$@"
23# ----------------------------------------------------------------------
24# wish executes everything from here on...
25package require Itcl
26package require Rappture
27package require RapptureGUI
28
29option add *comm.font -*-courier-medium-r-normal-*-*-120-*
30option add *Menu.tearOff off
31
32option add *Tooltip.background white
33option add *Editor.background white
34option add *Gauge.textBackground white
35option add *TemperatureGauge.textBackground white
36option add *Switch.textBackground white
37option add *Progress.barColor #ffffcc
38option add *Balloon.titleBackground #6666cc
39option add *Balloon.titleForeground white
40option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-*-120-*
41option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-*-120-*
42option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-*-120-*
43option add *ResultSet.controlbarBackground #6666cc
44option add *ResultSet.controlbarForeground white
45option add *ResultSet.activeControlBackground #ccccff
46option add *ResultSet.activeControlForeground black
47option add *Radiodial.length 3i
48option add *BugReport*banner*foreground white
49option add *BugReport*banner*background #a9a9a9
50option add *BugReport*banner*highlightBackground #a9a9a9
51option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-*-180-*
52
53# fix the "grab" command to support a stack of grab windows
54#Rappture::grab::init
55
56# ----------------------------------------------------------------------
57# LOAD RESOURCE SETTINGS
58#
59# Try to load the $SESSIONDIR/resources file, which contains
60# middleware settings, such as the application name and the
61# filexfer settings.
62# ----------------------------------------------------------------------
63Rappture::resources::load
64
65# ----------------------------------------------------------------------
66# Fake data object for sending VTK data file...
67# ----------------------------------------------------------------------
68itcl::class visData {
69    inherit Rappture::Drawing
70
71    constructor {args} {
72        Rappture::Drawing::constructor [Rappture::library standard] ""
73    } {
74        set _data [lindex $args 0]
75        set _type [lindex $args 1]
76    }
77
78    public method components {args} {
79        if {[llength $args] == 0} {
80            return "one"
81        }
82        return ""
83    }
84    public method data {args} {
85        return $_data
86    }
87    public method vtkdata {args} {
88        return $_data
89    }
90    public method values {args} {
91        return $_data
92    }
93    public method hints {args} {
94        return ""
95    }
96    public method type {args} {
97        return $_type
98    }
99    public method shape {args} {
100        return "sphere"
101    }
102
103    private variable _data ""
104    private variable _type ""
105}
106
107# ----------------------------------------------------------------------
108# USAGE: send_file
109#
110# Prompts the user for a text file, and then sends the text within
111# that file along to the rendering widget.
112# ----------------------------------------------------------------------
113proc send_file {} {
114    global widgets
115
116    set file [tk_getOpenFile -title "Open VTK File as PolyData"]
117    if {"" != $file && [catch {
118            set fid [open $file r]
119            fconfigure $fid -translation binary -encoding binary
120            set info [read $fid]
121            close $fid
122          }] == 0} {
123        set obj [visData #auto $info "polydata"]
124        $widgets(vtkviewer) add $obj
125    }
126}
127
128# ----------------------------------------------------------------------
129# USAGE: send_streamlines_file
130#
131# Prompts the user for a text file, and then sends the text within
132# that file along to the rendering widget.
133# ----------------------------------------------------------------------
134proc send_streamlines_file {} {
135    global widgets
136
137    set file [tk_getOpenFile -title "Open VTK File as Streamlines"]
138    if {"" != $file && [catch {
139            set fid [open $file r]
140            fconfigure $fid -translation binary -encoding binary
141            set info [read $fid]
142            close $fid
143          }] == 0} {
144        set obj [visData #auto $info "streamlines"]
145        $widgets(vtkviewer) add $obj
146    }
147}
148
149# ----------------------------------------------------------------------
150# USAGE: send_glyphs_file
151#
152# Prompts the user for a text file, and then sends the text within
153# that file along to the rendering widget.
154# ----------------------------------------------------------------------
155proc send_glyphs_file {} {
156    global widgets
157
158    set file [tk_getOpenFile -title "Open VTK File as Glyphs"]
159    if {"" != $file && [catch {
160            set fid [open $file r]
161            fconfigure $fid -translation binary
162            set info [read $fid]
163            close $fid
164          }] == 0} {
165        set obj [visData #auto $info "glyphs"]
166        $widgets(vtkviewer) add $obj
167    }
168}
169
170# ----------------------------------------------------------------------
171# USAGE: send_molecule_file
172#
173# Prompts the user for a text file, and then sends the text within
174# that file along to the rendering widget.
175# ----------------------------------------------------------------------
176proc send_molecule_file {} {
177    global widgets
178
179    set file [tk_getOpenFile -title "Open VTK File as Molecule"]
180    if {"" != $file && [catch {
181            set fid [open $file r]
182            fconfigure $fid -translation binary
183            set info [read $fid]
184            close $fid
185          }] == 0} {
186        set obj [visData #auto $info "molecule"]
187        $widgets(vtkviewer) add $obj
188    }
189}
190
191# ----------------------------------------------------------------------
192# USAGE: load_script
193#
194# Prompts the user for a text file, and then sends the text within
195# that file along to the rendering widget.
196# ----------------------------------------------------------------------
197proc load_script {} {
198    global widgets
199
200    set file [tk_getOpenFile -title "Open Command File"]
201    if {"" != $file && [catch {
202            set fid [open $file r]
203            fconfigure $fid -translation binary
204            set info [read $fid]
205            close $fid
206          }] == 0} {
207
208        $widgets(command) insert 0 $info
209        send_command
210    }
211}
212
213# ----------------------------------------------------------------------
214# USAGE: send_command
215#
216# Invoked automatically whenever the user enters a command and
217# presses <Return>.  Sends the command along to the rendering
218# widget.
219# ----------------------------------------------------------------------
220proc send_command {} {
221    global widgets
222    global last_command
223
224    set cmd [$widgets(command) get]
225
226    if {[string length $cmd] > 0} {
227        set last_command $cmd
228    } else {
229        set cmd $last_command
230    }
231    namespace eval Rappture::VtkViewer [list $widgets(vtkviewer) SendCmd $cmd]
232    $widgets(command) delete 0 end
233}
234
235# ----------------------------------------------------------------------
236# USAGE: reset
237#
238# Used internally to reset the connection to the rendering server.
239# Discards all data and resets the widget connection to the server.
240# ----------------------------------------------------------------------
241proc reset {} {
242    global widgets
243    $widgets(vtkviewer) delete
244    $widgets(vtkviewer) disconnect
245    $widgets(comm) configure -state normal
246    $widgets(comm) delete 1.0 end
247    $widgets(comm) configure -state disabled
248}
249
250# ----------------------------------------------------------------------
251# USAGE: show_comm <channel> <data>
252#
253# Invoked automatically whenever there is communication between
254# the rendering widget and the server.  Eavesdrops on the communication
255# and posts the commands in a text viewer.
256# ----------------------------------------------------------------------
257proc show_comm {channel {data ""}} {
258    global widgets
259
260    $widgets(comm) configure -state normal
261    switch -- $channel {
262        closed {
263            $widgets(comm) insert end "--CLOSED--\n" error
264        }
265        <<line {
266            $widgets(comm) insert end $data incoming "\n" incoming
267            images_refresh
268        }
269        >>line {
270            $widgets(comm) insert end $data outgoing "\n" outgoing
271        }
272        error {
273            $widgets(comm) insert end $data error "\n" error
274        }
275        default {
276            $widgets(comm) insert end "$data\n"
277        }
278    }
279    $widgets(comm) configure -state disabled
280    $widgets(comm) see end
281}
282
283# ----------------------------------------------------------------------
284# TOPLEVEL FOR IMAGES
285# ----------------------------------------------------------------------
286# USAGE: images_save
287#
288# Invoked when the user presses the "Save As..." button on the
289# images panel.  Saves the current image in a file, which can be
290# examined by some external program.
291# ----------------------------------------------------------------------
292proc images_save {} {
293    global widgets images
294
295    set imh [$widgets(vtkviewer) get -image $images(which)]
296
297    set file [tk_getSaveFile -title "Save Image File" \
298        -defaultextension .jpg -filetypes {{{JPEG files} .jpg} {{All Files} *}}]
299
300    if {"" != $file} {
301        set cmds {
302            $imh write $file -format jpeg
303        }
304        if {[catch $cmds err]} {
305            tk_messageBox -icon error -message "Oops!  Save failed:\n$err"
306        }
307    }
308}
309
310# ----------------------------------------------------------------------
311# USAGE: images_refresh
312#
313# Invoked automatically whenever there is a change in the view/legend
314# controls on the images panel.  Updates the image being shown based
315# on the current selection.
316# ----------------------------------------------------------------------
317proc images_refresh {} {
318    global widgets images
319    set c $widgets(viewer)
320
321    set w [winfo width $c]
322    set h [winfo height $c]
323
324    set imh [$widgets(vtkviewer) get -image $images(which)]
325    set iw [image width $imh]
326    set ih [image height $imh]
327
328    $c coords image [expr {$w/2}] [expr {$h/2}]
329    $c itemconfigure image -image $imh
330    $c coords outline [expr {$w/2-$iw/2}] [expr {$h/2-$ih/2}] \
331        [expr {$w/2+$iw/2}] [expr {$h/2+$ih/2}]
332}
333
334toplevel .images
335wm title .images "Vtkviewer: Images"
336wm withdraw .images
337wm protocol .images WM_DELETE_WINDOW {wm withdraw .images}
338
339frame .images.cntls
340pack .images.cntls -side bottom -fill x
341button .images.cntls.save -text "Save As..." -command images_save
342pack .images.cntls.save -side right -padx 4
343radiobutton .images.cntls.view -text "3D View" -variable images(which) \
344    -value "view" -command images_refresh
345pack .images.cntls.view -side top -anchor w
346radiobutton .images.cntls.legend -text "Legend" -variable images(which) \
347    -value "legend" -command images_refresh
348pack .images.cntls.legend -side top -anchor w
349set images(which) "view"
350
351canvas .images.viewer -background black -width 500 -height 500
352pack .images.viewer -expand yes -fill both
353bind .images.viewer <Configure> images_refresh
354set widgets(viewer) .images.viewer
355
356$widgets(viewer) create image 0 0 -anchor c \
357    -image [image create photo] -tags image
358$widgets(viewer) create rectangle 0 0 1 1 -width 2 -outline red -fill "" \
359    -tags outline
360
361
362# ----------------------------------------------------------------------
363# MAIN WINDOW
364# ----------------------------------------------------------------------
365menu .mbar
366menu .mbar.file
367.mbar.file add command -label "Send VTK File..." -underline 0 -command send_file
368.mbar.file add command -label "Send VTK File as Streamlines..." -underline 0 -command send_streamlines_file
369.mbar.file add command -label "Send VTK File as Glyphs..." -underline 0 -command send_glyphs_file
370.mbar.file add command -label "Send VTK File as Molecule..." -underline 0 -command send_molecule_file
371.mbar.file add command -label "Load script..." -underline 0 -command load_script
372.mbar.file add command -label "Reset" -underline 0 -command reset
373.mbar.file add separator
374.mbar.file add command -label "Exit" -underline 1 -command exit
375.mbar add cascade -label "File" -underline 0 -menu .mbar.file
376
377menu .mbar.view
378.mbar.view add command -label "Images..." -underline 0 \
379    -command {wm deiconify .images}
380.mbar add cascade -label "View" -underline 0 -menu .mbar.view
381
382. configure -menu .mbar
383
384
385Rappture::Panes .main -sashwidth 4 -sashrelief raised -sashpadding 4 \
386    -width 6i -height 4i
387pack .main -expand yes -fill both
388
389set f [.main pane 0]
390Rappture::VtkViewer $f.viewer
391pack $f.viewer -expand yes -fill both
392set widgets(vtkviewer) $f.viewer
393
394$f.viewer configure \
395    -sendcommand show_comm \
396    -receivecommand show_comm
397
398set f [.main insert end -fraction 0.5]
399frame $f.send
400pack $f.send -side bottom -fill x
401label $f.send.l -text "Send:"
402pack $f.send.l -side left
403set widgets(command) [entry $f.send.e]
404pack $f.send.e -side left -expand yes -fill x
405bind $f.send.e <KeyPress-Return> send_command
406
407scrollbar $f.sb -orient vertical -command "$f.comm yview"
408pack $f.sb -side right -fill y
409text $f.comm -wrap char -yscrollcommand "$f.sb set"
410pack $f.comm -expand yes -fill both
411set widgets(comm) $f.comm
412
413$widgets(comm) tag configure error -foreground red \
414    -font -*-courier-medium-o-normal-*-*-120-*
415$widgets(comm) tag configure incoming -foreground blue
Note: See TracBrowser for help on using the repository browser.