source: trunk/gui/apps/geoviewer-test @ 4029

Last change on this file since 4029 was 4029, checked in by ldelgass, 11 years ago

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