source: branches/1.3/gui/apps/mapviewer-test @ 4513

Last change on this file since 4513 was 4513, checked in by gah, 7 years ago

remove vtkdir path (not needed for VTK 6+)

  • Property svn:executable set to *
File size: 11.3 KB
Line 
1#!/bin/sh
2# -*- mode: Tcl -*-
3# ----------------------------------------------------------------------
4#  TEST PROGRAM for MapViewer
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::MapViewer [list $widgets(mapviewer) 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(mapviewer) delete
145    $widgets(mapviewer) disconnect
146    $widgets(comm) configure -state normal
147    $widgets(comm) delete 1.0 end
148    $widgets(comm) configure -state disabled
149}
150
151proc resetMapGeocentric {} {
152    global widgets
153    set cmd "map reset geocentric"
154    namespace eval Rappture::MapViewer [list $widgets(mapviewer) SendCmd $cmd]
155}
156
157proc resetMapGlobalGeodetic {} {
158    global widgets
159    set cmd "map reset projected global-geodetic"
160    namespace eval Rappture::MapViewer [list $widgets(mapviewer) SendCmd $cmd]
161}
162
163proc resetMapGlobalMercator {} {
164    global widgets
165    set cmd "map reset projected global-mercator"
166    namespace eval Rappture::MapViewer [list $widgets(mapviewer) SendCmd $cmd]
167}
168
169# ----------------------------------------------------------------------
170# USAGE: show_comm <channel> <data>
171#
172# Invoked automatically whenever there is communication between
173# the rendering widget and the server.  Eavesdrops on the communication
174# and posts the commands in a text viewer.
175# ----------------------------------------------------------------------
176proc show_comm {channel {data ""}} {
177    global widgets
178
179    $widgets(comm) configure -state normal
180    switch -- $channel {
181        closed {
182            $widgets(comm) insert end "--CLOSED--\n" error
183        }
184        <<line {
185            $widgets(comm) insert end $data incoming "\n" incoming
186            images_refresh
187        }
188        >>line {
189            $widgets(comm) insert end $data outgoing "\n" outgoing
190        }
191        error {
192            $widgets(comm) insert end $data error "\n" error
193        }
194        default {
195            $widgets(comm) insert end "$data\n"
196        }
197    }
198    $widgets(comm) configure -state disabled
199    $widgets(comm) see end
200}
201
202# ----------------------------------------------------------------------
203# TOPLEVEL FOR IMAGES
204# ----------------------------------------------------------------------
205# USAGE: images_save
206#
207# Invoked when the user presses the "Save As..." button on the
208# images panel.  Saves the current image in a file, which can be
209# examined by some external program.
210# ----------------------------------------------------------------------
211proc images_save {} {
212    global widgets images
213
214    set imh [$widgets(mapviewer) get -image $images(which)]
215
216    set file [tk_getSaveFile -title "Save Image File" \
217        -defaultextension .jpg -filetypes {{{JPEG files} .jpg} {{All Files} *}}]
218
219    if {"" != $file} {
220        set cmds {
221            $imh write $file -format jpeg
222        }
223        if {[catch $cmds err]} {
224            tk_messageBox -icon error -message "Oops!  Save failed:\n$err"
225        }
226    }
227}
228
229# ----------------------------------------------------------------------
230# USAGE: images_refresh
231#
232# Invoked automatically whenever there is a change in the view/legend
233# controls on the images panel.  Updates the image being shown based
234# on the current selection.
235# ----------------------------------------------------------------------
236proc images_refresh {} {
237    global widgets images
238    set c $widgets(viewer)
239
240    set w [winfo width $c]
241    set h [winfo height $c]
242
243    set imh [$widgets(mapviewer) get -image $images(which)]
244    set iw [image width $imh]
245    set ih [image height $imh]
246
247    $c coords image [expr {$w/2}] [expr {$h/2}]
248    $c itemconfigure image -image $imh
249    $c coords outline [expr {$w/2-$iw/2}] [expr {$h/2-$ih/2}] \
250        [expr {$w/2+$iw/2}] [expr {$h/2+$ih/2}]
251}
252
253toplevel .images
254wm title .images "Geoviewer: Images"
255wm withdraw .images
256wm protocol .images WM_DELETE_WINDOW {wm withdraw .images}
257
258frame .images.cntls
259pack .images.cntls -side bottom -fill x
260button .images.cntls.save -text "Save As..." -command images_save
261pack .images.cntls.save -side right -padx 4
262radiobutton .images.cntls.view -text "3D View" -variable images(which) \
263    -value "view" -command images_refresh
264pack .images.cntls.view -side top -anchor w
265radiobutton .images.cntls.legend -text "Legend" -variable images(which) \
266    -value "legend" -command images_refresh
267pack .images.cntls.legend -side top -anchor w
268set images(which) "view"
269
270canvas .images.viewer -background black -width 500 -height 500
271pack .images.viewer -expand yes -fill both
272bind .images.viewer <Configure> images_refresh
273set widgets(viewer) .images.viewer
274
275$widgets(viewer) create image 0 0 -anchor c \
276    -image [image create photo] -tags image
277$widgets(viewer) create rectangle 0 0 1 1 -width 2 -outline red -fill "" \
278    -tags outline
279
280
281# ----------------------------------------------------------------------
282# MAIN WINDOW
283# ----------------------------------------------------------------------
284menu .mbar
285menu .mbar.file
286.mbar.file add command -label "Send Earth File..." -underline 0 -command send_file
287.mbar.file add command -label "Load script..." -underline 0 -command load_script
288.mbar.file add command -label "Reset Map to Geocentric" -underline 0 -command resetMapGeocentric
289.mbar.file add command -label "Reset Map to Geodetic Projection" -underline 0 -command resetMapGlobalGeodetic
290.mbar.file add command -label "Reset Map to Mercator Projection" -underline 0 -command resetMapGlobalMercator
291.mbar.file add command -label "Reset" -underline 0 -command reset
292.mbar.file add separator
293.mbar.file add command -label "Exit" -underline 1 -command exit
294.mbar add cascade -label "File" -underline 0 -menu .mbar.file
295
296menu .mbar.view
297.mbar.view add command -label "Images..." -underline 0 \
298    -command {wm deiconify .images}
299.mbar add cascade -label "View" -underline 0 -menu .mbar.view
300
301. configure -menu .mbar
302
303
304Rappture::Panes .main -sashwidth 4 -sashrelief raised -sashpadding 4 \
305    -width 6i -height 4i
306pack .main -expand yes -fill both
307
308set f [.main pane 0]
309set servers [Rappture::VisViewer::GetServerList "geovis"]
310Rappture::MapViewer $f.viewer $servers
311pack $f.viewer -expand yes -fill both
312set widgets(mapviewer) $f.viewer
313
314$f.viewer configure \
315    -sendcommand show_comm \
316    -receivecommand show_comm
317
318set f [.main insert end -fraction 0.5]
319frame $f.send
320pack $f.send -side bottom -fill x
321label $f.send.l -text "Send:"
322pack $f.send.l -side left
323set widgets(command) [entry $f.send.e]
324pack $f.send.e -side left -expand yes -fill x
325bind $f.send.e <KeyPress-Return> send_command
326
327scrollbar $f.sb -orient vertical -command "$f.comm yview"
328pack $f.sb -side right -fill y
329text $f.comm -wrap char -yscrollcommand "$f.sb set"
330pack $f.comm -expand yes -fill both
331set widgets(comm) $f.comm
332
333$widgets(comm) tag configure error -foreground red \
334    -font -*-courier-medium-o-normal-*-*-120-*
335$widgets(comm) tag configure incoming -foreground blue
Note: See TracBrowser for help on using the repository browser.