source: branches/1.3/gui/apps/vtkheightmap-test @ 4518

Last change on this file since 4518 was 4413, checked in by ldelgass, 10 years ago

Merge test app fixes from trunk

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