Context Navigation

source: branches/multichoice/gui/scripts/visviewer.tcl @ 6371

Last change on this file since 6371 was 6371, checked in by dkearney, 8 years ago
merging changes from trunk into multichoice branch
File size: 39.8 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# VisViewer -
4	#
5	# This class is the base class for the various visualization viewers
6	# that use the nanoserver render farm.
7	#
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15
16	itcl::class ::Rappture::VisViewer {
17	inherit itk::Widget
18
19	itk_option define -sendcommand sendCommand SendCommand ""
20	itk_option define -receivecommand receiveCommand ReceiveCommand ""
21
22	constructor { args } {
23	# defined below
24	}
25	destructor {
26	# defined below
27	}
28	public proc GetServerList { type } {
29	return $_servers($type)
30	}
31	public proc SetServerList { type namelist } {
32	# Convert the comma separated list into a Tcl list. OGRE also adds
33	# a trailing comma that we want to ignore.
34	regsub -all "," $namelist " " namelist
35	CheckNameList $namelist
36	set _servers($type) $namelist
37	}
38	public proc RemoveServerFromList { type server } {
39	if { ![info exists _servers($type)] } {
40	error "unknown server type \"$type\""
41	}
42	set i [lsearch $_servers($type) $server]
43	if { $i < 0 } {
44	return
45	}
46	set _servers($type) [lreplace $_servers($type) $i $i]
47	}
48	public proc SetPymolServerList { namelist } {
49	SetServerList "pymol" $namelist
50	}
51	public proc SetNanovisServerList { namelist } {
52	SetServerList "nanovis" $namelist
53	}
54	public proc SetVtkServerList { namelist } {
55	SetServerList "vtk" $namelist
56	}
57
58	protected method CheckConnection {}
59	protected method Color2RGB { color }
60	protected method ColorsToColormap { colors }
61	protected method Connect { servers }
62	protected method DebugOff {} {
63	set _debug 0
64	}
65	protected method DebugOn {} {
66	set _debug 1
67	}
68	protected method DebugTrace { args } {
69	if { $_debug } {
70	puts stderr "[info level -1]: $args"
71	}
72	}
73	protected method DisableWaitDialog {}
74	protected method Disconnect {}
75	protected method EnableWaitDialog { timeout }
76	protected method Euler2XYZ { theta phi psi }
77	protected method Flush {}
78	protected method GetColormapList { args }
79	protected method HandleError { args }
80	protected method HandleOk { args }
81	protected method IsConnected {}
82	protected method ReceiveBytes { nbytes }
83	protected method ReceiveEcho { channel {data ""} }
84	protected method SendBytes { bytes }
85	protected method SendCmd { string }
86	protected method SendData { bytes }
87	protected method SendEcho { channel {data ""} }
88	protected method StartBufferingCommands {}
89	protected method StartWaiting {}
90	protected method StopBufferingCommands {}
91	protected method StopWaiting {}
92	protected method ToggleConsole {}
93
94	protected variable _debug 0
95	protected variable _serverType "???";# Type of server.
96	protected variable _sid ""; # socket connection to server
97	protected variable _maxConnects 100
98	protected variable _buffering 0
99	protected variable _cmdSeq 0; # Command sequence number
100	protected variable _dispatcher ""; # dispatcher for !events
101	protected variable _hosts ""; # list of hosts for server
102	protected variable _parser ""; # interpreter for incoming commands
103	protected variable _image
104	protected variable _hostname
105	protected variable _numConnectTries 0
106	protected variable _debugConsole 0
107	protected variable _reportClientInfo 1
108	# Number of milliscends to wait for server reply before displaying wait
109	# dialog. If set to 0, dialog is never displayed.
110	protected variable _waitTimeout 0
111
112	private method BuildConsole {}
113	private method DebugConsole {}
114	private method HideConsole {}
115	private method ReceiveHelper {}
116	private method SendDebugCommand {}
117	private method SendHelper {}
118	private method ServerDown {}
119	private method Shuffle { servers }
120	private method TraceComm { channel {data {}} }
121	private method WaitDialog { state }
122	private method Waiting { option widget }
123
124	private proc CheckNameList { namelist } {
125	foreach host $namelist {
126	set pattern {^[a-zA-Z0-9\.]+:[0-9]}
127	if { ![regexp $pattern $host match] } {
128	error "bad visualization server address \"$host\": should be host:port,host:port,..."
129	}
130	}
131	}
132
133	private variable _buffer; # buffer for incoming/outgoing commands
134	private variable _outbuf; # buffer for outgoing commands
135	private variable _blockOnWrite 0; # Should writes to socket block?
136	private variable _initialized
137	private variable _isOpen 0
138	private variable _afterId -1
139	private variable _icon 0
140	private variable _trace 0; # Protocol tracing for console
141	private variable _logging 0; # Command logging to file
142	# Number of milliseconds to wait before idle timeout. If greater than 0,
143	# automatically disconnect from the visualization server when idle timeout
144	# is reached.
145	private variable _idleTimeout 43200000; # 12 hours
146	#private variable _idleTimeout 5000;# 5 seconds
147	#private variable _idleTimeout 0; # No timeout
148
149	private common _servers; # array of visualization server lists
150	set _servers(geovis) "localhost:2015"
151	set _servers(nanovis) "localhost:2000"
152	set _servers(pymol) "localhost:2020"
153	set _servers(vmdmds) "localhost:2018"
154	set _servers(vtkvis) "localhost:2010"
155	private common _done; # Used to indicate status of send.
156	}
157
158	itk::usual Panedwindow {
159	keep -background -cursor
160	}
161
162	# ----------------------------------------------------------------------
163	# CONSTRUCTOR
164	# ----------------------------------------------------------------------
165	itcl::body Rappture::VisViewer::constructor { args } {
166
167	Rappture::dispatcher _dispatcher
168	$_dispatcher register !serverDown
169	$_dispatcher dispatch $this !serverDown "[itcl::code $this ServerDown]; list"
170	$_dispatcher register !timeout
171	$_dispatcher dispatch $this !timeout "[itcl::code $this Disconnect]; list"
172
173	$_dispatcher register !waiting
174
175	set _buffer(in) ""
176	set _buffer(out) ""
177	#
178	# Create a parser to handle incoming requests
179	#
180	set _parser [interp create -safe]
181	foreach cmd [$_parser eval {info commands}] {
182	$_parser hide $cmd
183	}
184	# Add default handlers for "ok" acknowledgement and server errors.
185	$_parser alias ok [itcl::code $this HandleOk]
186	$_parser alias viserror [itcl::code $this HandleError]
187
188	#
189	# Set up the widgets in the main body
190	#
191	option add hull.width hull.height
192	pack propagate $itk_component(hull) no
193
194	itk_component add main {
195	Rappture::SidebarFrame $itk_interior.main -resizeframe 1
196	}
197	pack $itk_component(main) -expand yes -fill both
198	set f [$itk_component(main) component frame]
199
200	itk_component add plotarea {
201	frame $f.plotarea -highlightthickness 0 -background black
202	} {
203	ignore -background
204	}
205	pack $itk_component(plotarea) -fill both -expand yes
206	set _image(plot) [image create photo]
207
208	global env
209	if { [info exists env(VISRECORDER)] } {
210	set _logging 1
211	if { [file exists /tmp/recording.log] } {
212	file delete /tmp/recording.log
213	}
214	}
215	if { [info exists env(VISTRACE)] } {
216	set _trace 1
217	}
218	eval itk_initialize $args
219	}
220
221	#
222	# destructor --
223	#
224	itcl::body Rappture::VisViewer::destructor {} {
225	$_dispatcher cancel !timeout
226	interp delete $_parser
227	array unset _done $this
228	}
229
230	#
231	# Shuffle --
232	#
233	# Shuffle the list of server hosts.
234	#
235	itcl::body Rappture::VisViewer::Shuffle { hosts } {
236	set randomHosts {}
237	set ticks [clock clicks]
238	expr {srand($ticks)}
239	for { set i [llength $hosts] } { $i > 0 } { incr i -1 } {
240	set index [expr {round(rand()*$i - 0.5)}]
241	if { $index == $i } {
242	set index [expr $i - 1]
243	}
244	lappend randomHosts [lindex $hosts $index]
245	set hosts [lreplace $hosts $index $index]
246	}
247	return $randomHosts
248	}
249
250	#
251	# ServerDown --
252	#
253	# Used internally to let the user know when the connection to the
254	# visualization server has been lost. Puts up a tip encouraging the
255	# user to press any control to reconnect.
256	#
257	itcl::body Rappture::VisViewer::ServerDown {} {
258	if { [info exists itk_component(plotarea)] } {
259	set x [expr {[winfo rootx $itk_component(plotarea)]+10}]
260	set y [expr {[winfo rooty $itk_component(plotarea)]+10}]
261	} else {
262	set x 0; set y 0
263	}
264	Rappture::Tooltip::cue @$x,$y "Lost connection to visualization server. This happens sometimes when there are too many users and the system runs out of memory.\n\nTo reconnect, reset the view or press any other control. Your picture should come right back up."
265	}
266
267	#
268	# Connect --
269	#
270	# Connect to the visualization server (e.g. nanovis, pymolproxy).
271	# Creates an event callback that is triggered when we are idle
272	# (no I/O with the server) for some specified time.
273	#
274	itcl::body Rappture::VisViewer::Connect { servers } {
275	blt::busy hold $itk_component(hull) -cursor watch
276
277	if { $_numConnectTries > $_maxConnects } {
278	blt::busy release $itk_component(hull)
279	set x [expr {[winfo rootx $itk_component(hull)]+10}]
280	set y [expr {[winfo rooty $itk_component(hull)]+10}]
281	Rappture::Tooltip::cue @$x,$y "Exceeded maximum number of connection attmepts to any $_serverType visualization server. Please contact support."
282	return 0;
283	}
284	foreach server [Shuffle $servers] {
285	puts stderr "connecting to $server..."
286	foreach {hostname port} [split $server ":"] break
287	if { [catch {socket $hostname $port} _sid] != 0 } {
288	set _sid ""
289	RemoveServerFromList $_serverType $server
290	continue
291	}
292	incr _numConnectTries
293	set _hostname $server
294	fconfigure $_sid -translation binary -encoding binary
295
296	# Read back the server identification string.
297	if { [gets $_sid data] <= 0 } {
298	set _sid ""
299	puts stderr "ERORR reading from server data=($data)"
300	RemoveServerFromList $_serverType $server
301	continue
302	}
303	puts stderr "Render server is $data"
304	# We're connected. Cancel any pending serverDown events and
305	# release the busy window over the hull.
306	$_dispatcher cancel !serverDown
307	if { $_idleTimeout > 0 } {
308	$_dispatcher event -after $_idleTimeout !timeout
309	}
310	blt::busy release $itk_component(hull)
311	fconfigure $_sid -buffering line
312	fileevent $_sid readable [itcl::code $this ReceiveHelper]
313	return 1
314	}
315	blt::busy release $itk_component(hull)
316	set x [expr {[winfo rootx $itk_component(hull)]+10}]
317	set y [expr {[winfo rooty $itk_component(hull)]+10}]
318	Rappture::Tooltip::cue @$x,$y "Can't connect to any $_serverType visualization server. This may be a network problem. Wait a few moments and try resetting the view."
319	return 0
320	}
321
322	#
323	# Disconnect --
324	#
325	# Clients use this method to disconnect from the current rendering
326	# server. Cancel any pending idle timeout events.
327	#
328	itcl::body Rappture::VisViewer::Disconnect {} {
329	after cancel $_afterId
330	$_dispatcher cancel !timeout
331	catch {close $_sid}
332	set _sid ""
333	set _buffer(in) ""
334	set _buffer(out) ""
335	set _outbuf ""
336	set _cmdSeq 0
337	}
338
339	#
340	# IsConnected --
341	#
342	# Indicates if we are currently connected to a server.
343	#
344	itcl::body Rappture::VisViewer::IsConnected {} {
345	if { $_sid == "" } {
346	return 0
347	}
348	if { [eof $_sid] } {
349	set _sid ""
350	return 0
351	}
352	return 1
353	}
354
355	#
356	# CheckConection --
357	#
358	# This routine is called whenever we're about to send/receive data on
359	# the socket connection to the visualization server. If we're connected,
360	# then reset the timeout event. Otherwise try to reconnect to the
361	# visualization server.
362	#
363	itcl::body Rappture::VisViewer::CheckConnection {} {
364	$_dispatcher cancel !timeout
365	if { $_idleTimeout > 0 } {
366	$_dispatcher event -after $_idleTimeout !timeout
367	}
368	if { [IsConnected] } {
369	return 1
370	}
371	if { $_sid != "" } {
372	fileevent $_sid writable ""
373	}
374	# If we aren't connected, assume it's because the connection to the
375	# visualization server broke. Try to open a connection and trigger a
376	# rebuild.
377	$_dispatcher cancel !serverDown
378	set x [expr {[winfo rootx $itk_component(plotarea)]+10}]
379	set y [expr {[winfo rooty $itk_component(plotarea)]+10}]
380	Rappture::Tooltip::cue @$x,$y "Connecting..."
381	set code [catch { Connect } ok]
382	if { $code == 0 && $ok} {
383	$_dispatcher event -idle !rebuild
384	Rappture::Tooltip::cue hide
385	} else {
386	Rappture::Tooltip::cue @$x,$y "Can't connect to any $_serverType visualization server. This may be a network problem. Wait a few moments and try resetting the view."
387	return 0
388	}
389	return 1
390	}
391
392	#
393	# Flush --
394	#
395	# Flushes the socket.
396	#
397	itcl::body Rappture::VisViewer::Flush {} {
398	if { [CheckConnection] } {
399	flush $_sid
400	}
401	}
402
403
404	#
405	# SendHelper --
406	#
407	# Helper routine called from a file event to send data when the
408	# connection is writable (i.e. not blocked). Sets a magic variable
409	# _done($this) when we're done.
410	#
411	itcl::body Rappture::VisViewer::SendHelper {} {
412	if { ![CheckConnection] } {
413	return 0
414	}
415	puts -nonewline $_sid $_buffer(out)
416	flush $_sid
417	set _buffer(out) ""
418	set _done($this) 1; # Success
419	}
420
421	#
422	# SendBytes --
423	#
424	# Send a a string to the visualization server.
425	#
426	itcl::body Rappture::VisViewer::SendBytes { bytes } {
427	SendEcho >>line $bytes
428	if { ![CheckConnection] } {
429	return 0
430	}
431	StartWaiting
432	# Even though the data is sent in only 1 "puts", we need to verify that
433	# the server is ready first. Wait for the socket to become writable
434	# before sending anything.
435	set _done($this) 1
436	if { $_debug && [string bytelength $_buffer(out)] > 0 } {
437	puts stderr "SendBytes: appending to output buffer"
438	}
439	# Append to the buffer, since we may have been called recursively
440	append _buffer(out) $bytes
441	# There's problem when the user is interacting with the GUI at the
442	# same time we're trying to write to the server. Don't want to
443	# block because, the GUI will look like it's dead. We can start
444	# by putting a busy window over plot so that inadvertent things like
445	# mouse movements aren't received.
446	if {$_blockOnWrite} {
447	# Allow a write to block. In this case we won't re-enter SendBytes.
448	SendHelper
449	} else {
450	# NOTE: This can cause us to re-enter SendBytes during the tkwait.
451	# For this reason, we append to the buffer in the code above.
452	if { [info exists itk_component(main)] } {
453	blt::busy hold $itk_component(main) -cursor ""
454	}
455	fileevent $_sid writable [itcl::code $this SendHelper]
456	tkwait variable ::Rappture::VisViewer::_done($this)
457	if { [info exists itk_component(main)] } {
458	blt::busy release $itk_component(main)
459	}
460	}
461	set _buffer(out) ""
462	if { [IsConnected] } {
463	# The connection may have closed while we were writing to the server.
464	# This can happen if what we sent the server caused it to barf.
465	fileevent $_sid writable ""
466	flush $_sid
467	}
468	return $_done($this)
469	}
470
471	#
472	# StartWaiting --
473	#
474	# Display a waiting dialog after a timeout has passed
475	#
476	itcl::body Rappture::VisViewer::StartWaiting {} {
477	if { $_waitTimeout > 0 } {
478	after cancel $_afterId
479	set _afterId [after $_waitTimeout [itcl::code $this WaitDialog on]]
480	}
481	}
482
483	#
484	# StopWaiting --
485	#
486	# Take down waiting dialog
487	#
488	itcl::body Rappture::VisViewer::StopWaiting {} {
489	if { $_waitTimeout > 0 } {
490	WaitDialog off
491	}
492	}
493
494	itcl::body Rappture::VisViewer::EnableWaitDialog { value } {
495	set _waitTimeout $value
496	}
497
498	itcl::body Rappture::VisViewer::DisableWaitDialog {} {
499	set _waitTimeout 0
500	}
501
502	#
503	# ReceiveBytes --
504	#
505	# Read some number of bytes from the visualization server.
506	#
507	itcl::body Rappture::VisViewer::ReceiveBytes { size } {
508	if { ![CheckConnection] } {
509	return 0
510	}
511	set bytes [read $_sid $size]
512	ReceiveEcho <<line "<read $size bytes"
513	StopWaiting
514	return $bytes
515	}
516
517	#
518	# ReceiveHelper --
519	#
520	# Helper routine called from a file event when the connection is readable
521	# (i.e. a command response has been sent by the rendering server. Reads
522	# the incoming command and executes it in a safe interpreter to handle the
523	# action.
524	#
525	# Note: This routine currently only handles command responses from
526	# the visualization server. It doesn't handle non-blocking
527	# reads from the visualization server.
528	#
529	# nv>image -bytes 100000 yes
530	# ...following 100000 bytes... no
531	#
532	# Note: All commands from the render server are on one line.
533	# This is because the render server can send anything
534	# as an error message (restricted again to one line).
535	#
536	itcl::body Rappture::VisViewer::ReceiveHelper {} {
537	if { ![CheckConnection] } {
538	return 0
539	}
540	set n [gets $_sid line]
541
542	if { $n < 0 } {
543	Disconnect
544	return 0
545	}
546	set line [string trim $line]
547	if { $line == "" } {
548	return
549	}
550	if { [string compare -length 3 $line "nv>"] == 0 } {
551	ReceiveEcho <<line $line
552	if ($_trace) {
553	puts stderr "<<[string range $line 0 70]"
554	}
555	append _buffer(in) [string range $line 3 end]
556	append _buffer(in) "\n"
557	if {[info complete $_buffer(in)]} {
558	set request $_buffer(in)
559	set _buffer(in) ""
560	if { [catch {$_parser eval $request} err] != 0 } {
561	global errorInfo
562	puts stderr "err=$err errorInfo=$errorInfo"
563	}
564	}
565	} elseif { [string compare -length 21 $line "NanoVis Server Error:"] == 0 \|\|
566	[string compare -length 20 $line "VtkVis Server Error:"] == 0} {
567	# this shows errors coming back from the engine
568	ReceiveEcho <<error $line
569	puts stderr "Render Server Error: $line\n"
570	} else {
571	# this shows errors coming back from the engine
572	ReceiveEcho <<error $line
573	puts stderr "Garbled message: $line\n"
574	}
575	}
576
577	#
578	# Color2RGB --
579	#
580	# Converts a color name to a list of r,g,b values needed for the engine.
581	# Each r/g/b component is scaled in the # range 0-1.
582	#
583	itcl::body Rappture::VisViewer::Color2RGB {color} {
584	foreach {r g b} [winfo rgb $itk_component(hull) $color] break
585	set r [expr {$r/65535.0}]
586	set g [expr {$g/65535.0}]
587	set b [expr {$b/65535.0}]
588	return [list $r $g $b]
589	}
590
591	#
592	# Euler2XYZ --
593	#
594	# Converts euler angles for the camera placement the to angles of
595	# rotation about the x/y/z axes, used by the engine. Returns a list:
596	# {xangle, yangle, zangle}.
597	#
598	itcl::body Rappture::VisViewer::Euler2XYZ {theta phi psi} {
599	set xangle [expr {$theta-90.0}]
600	set yangle [expr {180.0-$phi}]
601	set zangle $psi
602	return [list $xangle $yangle $zangle]
603	}
604
605	#
606	# SendEcho --
607	#
608	# Used internally to echo sent data to clients interested in this widget.
609	# If the -sendcommand option is set, then it is invoked in the global scope
610	# with the <channel> and <data> values as arguments. Otherwise, this does
611	# nothing.
612	#
613	itcl::body Rappture::VisViewer::SendEcho {channel {data ""}} {
614	if { $_logging } {
615	set f [open "/tmp/recording.log" "a"]
616	fconfigure $f -translation binary -encoding binary
617	puts -nonewline $f $data
618	close $f
619	}
620	#puts stderr ">>($data)"
621	if {[string length $itk_option(-sendcommand)] > 0} {
622	uplevel #0 $itk_option(-sendcommand) [list $channel $data]
623	}
624	}
625
626	#
627	# ReceiveEcho --
628	#
629	# Echoes received data to clients interested in this widget. If the
630	# -receivecommand option is set, then it is invoked in the global scope
631	# with the <channel> and <data> values as arguments. Otherwise, this
632	# does nothing.
633	#
634	itcl::body Rappture::VisViewer::ReceiveEcho {channel {data ""}} {
635	#puts stderr "<<line $data"
636	if {[string length $itk_option(-receivecommand)] > 0} {
637	uplevel #0 $itk_option(-receivecommand) [list $channel $data]
638	}
639	}
640
641	itcl::body Rappture::VisViewer::WaitDialog { state } {
642	after cancel $_afterId
643	set _afterId -1
644	if { $state } {
645	if { [winfo exists $itk_component(plotarea).view.splash] } {
646	return
647	}
648	set inner [frame $itk_component(plotarea).view.splash]
649	$inner configure -relief raised -bd 2
650	label $inner.text1 -text "Working...\nPlease wait." \
651	-font "Arial 10"
652	label $inner.icon
653	pack $inner -expand yes -anchor c
654	blt::table $inner \
655	0,0 $inner.text1 -anchor w \
656	0,1 $inner.icon
657	Waiting start $inner.icon
658	} else {
659	if { ![winfo exists $itk_component(plotarea).view.splash] } {
660	return
661	}
662	Waiting stop $itk_component(plotarea).view.splash
663	destroy $itk_component(plotarea).view.splash
664	}
665	}
666
667	itcl::body Rappture::VisViewer::Waiting { option widget } {
668	switch -- $option {
669	"start" {
670	$_dispatcher dispatch $this !waiting \
671	"[itcl::code $this Waiting "next" $widget] ; list"
672	set _icon 0
673	$widget configure -image [Rappture::icon bigroller${_icon}]
674	$_dispatcher event -after 150 !waiting
675	}
676	"next" {
677	incr _icon
678	if { $_icon >= 8 } {
679	set _icon 0
680	}
681	$widget configure -image [Rappture::icon bigroller${_icon}]
682	$_dispatcher event -after 150 !waiting
683	}
684	"stop" {
685	$_dispatcher cancel !waiting
686	}
687	}
688	}
689
690	#
691	# HideConsole --
692	#
693	# Hide the debug console by withdrawing its toplevel window.
694	#
695	itcl::body Rappture::VisViewer::HideConsole {} {
696	set _debugConsole 0
697	DebugConsole
698	}
699
700	#
701	# BuildConsole --
702	#
703	# Create and pack the widgets that make up the debug console: a text
704	# widget to display the communication and an entry widget to type
705	# in commands to send to the render server.
706	#
707	itcl::body Rappture::VisViewer::BuildConsole {} {
708	toplevel .renderconsole
709	wm protocol .renderconsole WM_DELETE_WINDOW [itcl::code $this HideConsole]
710	set f .renderconsole
711	frame $f.send
712	pack $f.send -side bottom -fill x
713	label $f.send.l -text "Send:"
714	pack $f.send.l -side left
715	itk_component add command {
716	entry $f.send.e -background white
717	} {
718	ignore -background
719	}
720	pack $f.send.e -side left -expand yes -fill x
721	bind $f.send.e <Return> [itcl::code $this SendDebugCommand]
722	bind $f.send.e <KP_Enter> [itcl::code $this SendDebugCommand]
723	scrollbar $f.sb -orient vertical -command "$f.comm yview"
724	pack $f.sb -side right -fill y
725	itk_component add trace {
726	text $f.comm -wrap char -yscrollcommand "$f.sb set" -background white
727	} {
728	ignore -background
729	}
730	pack $f.comm -expand yes -fill both
731	bind $f.comm <Control-F1> [itcl::code $this ToggleConsole]
732	bind $f.comm <Enter> [list focus %W]
733	bind $f.send.e <Control-F1> [itcl::code $this ToggleConsole]
734
735	$itk_component(trace) tag configure error -foreground red \
736	-font --courier-medium-o-normal---120-
737	$itk_component(trace) tag configure incoming -foreground blue
738	}
739
740	#
741	# ToggleConsole --
742	#
743	# This is used by derived classes to turn on/off debuging. It's
744	# up the to derived class to decide how to turn on/off debugging.
745	#
746	itcl::body Rappture::VisViewer::ToggleConsole {} {
747	if { $_debugConsole } {
748	set _debugConsole 0
749	} else {
750	set _debugConsole 1
751	}
752	DebugConsole
753	}
754
755	#
756	# DebugConsole --
757	#
758	# Based on the value of the variable _debugConsole, turns on/off
759	# debugging. This is done by setting/unsetting a procedure that
760	# is called whenever new characters are received or sent on the
761	# socket to the render server. Additionally, the debug console
762	# is created if necessary and hidden/shown.
763	#
764	itcl::body Rappture::VisViewer::DebugConsole {} {
765	if { ![winfo exists .renderconsole] } {
766	BuildConsole
767	}
768	if { $_debugConsole } {
769	$this configure -sendcommand [itcl::code $this TraceComm]
770	$this configure -receivecommand [itcl::code $this TraceComm]
771	wm deiconify .renderconsole
772	} else {
773	$this configure -sendcommand ""
774	$this configure -receivecommand ""
775	wm withdraw .renderconsole
776	}
777	}
778
779	# ----------------------------------------------------------------------
780	# USAGE: TraceComm <channel> <data>
781	#
782	# Invoked automatically whenever there is communication between
783	# the rendering widget and the server. Eavesdrops on the communication
784	# and posts the commands in a text viewer.
785	# ----------------------------------------------------------------------
786	itcl::body Rappture::VisViewer::TraceComm {channel {data ""}} {
787	$itk_component(trace) configure -state normal
788	switch -- $channel {
789	closed {
790	$itk_component(trace) insert end "--CLOSED--\n" error
791	}
792	<<line {
793	$itk_component(trace) insert end $data incoming "\n" incoming
794	}
795	>>line {
796	$itk_component(trace) insert end $data outgoing "\n" outgoing
797	}
798	error {
799	$itk_component(trace) insert end $data error "\n" error
800	}
801	default {
802	$itk_component(trace) insert end "$data\n"
803	}
804	}
805	$itk_component(trace) configure -state disabled
806	$itk_component(trace) see end
807	}
808
809	# ----------------------------------------------------------------------
810	# USAGE: SendDebugCommand
811	#
812	# Invoked automatically whenever the user enters a command and
813	# presses <Return>. Sends the command along to the rendering
814	# widget.
815	# ----------------------------------------------------------------------
816	itcl::body Rappture::VisViewer::SendDebugCommand {} {
817	incr _cmdSeq
818	set cmd [$itk_component(command) get]
819	append cmd "\n"
820	if {$_trace} {
821	puts stderr "$_cmdSeq>>[string range $cmd 0 70]"
822	}
823	SendBytes $cmd
824	$itk_component(command) delete 0 end
825	}
826
827	#
828	# HandleOk --
829	#
830	# This handles the "ok" response from the server that acknowledges
831	# the reception of a server command, but does not produce an image.
832	# It may pass an argument such as "-token 9" that could be used to
833	# determine how many commands have been processed by the server.
834	#
835	itcl::body Rappture::VisViewer::HandleOk { args } {
836	if { $_waitTimeout > 0 } {
837	StopWaiting
838	}
839	}
840
841	#
842	# HandleError --
843	#
844	# This handles the "viserror" response from the server that reports
845	# that a client-initiated error has occurred on the server.
846	#
847	itcl::body Rappture::VisViewer::HandleError { args } {
848	array set info {
849	-token "???"
850	-bytes 0
851	-type "???"
852	}
853	array set info $args
854	set bytes [ReceiveBytes $info(-bytes)]
855	if { $info(-type) == "error" } {
856	set popup $itk_component(hull).error
857	if { ![winfo exists $popup] } {
858	Rappture::Balloon $popup \
859	-title "Render Server Error"
860	set inner [$popup component inner]
861	label $inner.summary -text "" -anchor w
862
863	Rappture::Scroller $inner.scrl \
864	-xscrollmode auto -yscrollmode auto
865	text $inner.scrl.text \
866	-font "Arial 9" -background white -relief sunken -bd 1 \
867	-height 5 -wrap word -width 60
868	$inner.scrl contents $inner.scrl.text
869	button $inner.ok -text "Dismiss" -command [list $popup deactivate] \
870	-font "Arial 9"
871	blt::table $inner \
872	0,0 $inner.scrl -fill both \
873	1,0 $inner.ok
874	$inner.scrl.text tag configure normal -font "Arial 9"
875	$inner.scrl.text tag configure italic -font "Arial 9 italic"
876	$inner.scrl.text tag configure bold -font "Arial 10 bold"
877	$inner.scrl.text tag configure code -font "Courier 10 bold"
878	} else {
879	$popup deactivate
880	}
881	update
882	set inner [$popup component inner]
883	$inner.scrl.text delete 0.0 end
884
885	$inner.scrl.text configure -state normal
886	$inner.scrl.text insert end "The following error was reported by the render server:\n\n" bold
887	$inner.scrl.text insert end $bytes code
888	$inner.scrl.text configure -state disabled
889	update
890	$popup activate $itk_component(hull) below
891	} else {
892	ReceiveEcho <<error $bytes
893	puts stderr "Render server error:\n$bytes"
894	}
895	}
896
897	itcl::body Rappture::VisViewer::GetColormapList { args } {
898	array set opts {
899	-includeDefault 0
900	-includeElementDefault 0
901	-includeNone 0
902	}
903	if {[llength $args] > 0} {
904	foreach opt $args {
905	set opts($opt) 1
906	}
907	}
908	set colormaps [list]
909	if {$opts(-includeDefault)} {
910	lappend colormaps "default" "default"
911	}
912	if {$opts(-includeElementDefault)} {
913	lappend colormaps "elementDefault" "elementDefault"
914	}
915	lappend colormaps \
916	"BCGYR" "BCGYR" \
917	"BGYOR" "BGYOR" \
918	"blue-to-brown" "blue-to-brown" \
919	"blue-to-orange" "blue-to-orange" \
920	"blue-to-grey" "blue-to-grey" \
921	"green-to-magenta" "green-to-magenta" \
922	"greyscale" "greyscale" \
923	"nanohub" "nanohub" \
924	"rainbow" "rainbow" \
925	"spectral" "spectral" \
926	"ROYGB" "ROYGB" \
927	"RYGCB" "RYGCB" \
928	"white-to-blue" "white-to-blue" \
929	"brown-to-blue" "brown-to-blue" \
930	"grey-to-blue" "grey-to-blue" \
931	"orange-to-blue" "orange-to-blue"
932	if {$opts(-includeNone)} {
933	lappend colormaps "none" "none"
934	}
935	return $colormaps
936	}
937
938	itcl::body Rappture::VisViewer::ColorsToColormap { colors } {
939	set cmap {}
940	switch -- $colors {
941	"grey-to-blue" {
942	set cmap {
943	0.0 0.200 0.200 0.200
944	0.14285714285714285 0.400 0.400 0.400
945	0.2857142857142857 0.600 0.600 0.600
946	0.42857142857142855 0.900 0.900 0.900
947	0.5714285714285714 0.800 1.000 1.000
948	0.7142857142857143 0.600 1.000 1.000
949	0.8571428571428571 0.400 0.900 1.000
950	1.0 0.000 0.600 0.800
951	}
952	}
953	"blue-to-grey" {
954	set cmap {
955	0.0 0.000 0.600 0.800
956	0.14285714285714285 0.400 0.900 1.000
957	0.2857142857142857 0.600 1.000 1.000
958	0.42857142857142855 0.800 1.000 1.000
959	0.5714285714285714 0.900 0.900 0.900
960	0.7142857142857143 0.600 0.600 0.600
961	0.8571428571428571 0.400 0.400 0.400
962	1.0 0.200 0.200 0.200
963	}
964	}
965	"white-to-blue" {
966	set cmap {
967	0.0 0.900 1.000 1.000
968	0.1111111111111111 0.800 0.983 1.000
969	0.2222222222222222 0.700 0.950 1.000
970	0.3333333333333333 0.600 0.900 1.000
971	0.4444444444444444 0.500 0.833 1.000
972	0.5555555555555556 0.400 0.750 1.000
973	0.6666666666666666 0.300 0.650 1.000
974	0.7777777777777778 0.200 0.533 1.000
975	0.8888888888888888 0.100 0.400 1.000
976	1.0 0.000 0.250 1.000
977	}
978	}
979	"brown-to-blue" {
980	set cmap {
981	0.0 0.200 0.100 0.000
982	0.09090909090909091 0.400 0.187 0.000
983	0.18181818181818182 0.600 0.379 0.210
984	0.2727272727272727 0.800 0.608 0.480
985	0.36363636363636365 0.850 0.688 0.595
986	0.45454545454545453 0.950 0.855 0.808
987	0.5454545454545454 0.800 0.993 1.000
988	0.6363636363636364 0.600 0.973 1.000
989	0.7272727272727273 0.400 0.940 1.000
990	0.8181818181818182 0.200 0.893 1.000
991	0.9090909090909091 0.000 0.667 0.800
992	1.0 0.000 0.480 0.600
993	}
994	}
995	"blue-to-brown" {
996	set cmap {
997	0.0 0.000 0.480 0.600
998	0.09090909090909091 0.000 0.667 0.800
999	0.18181818181818182 0.200 0.893 1.000
1000	0.2727272727272727 0.400 0.940 1.000
1001	0.36363636363636365 0.600 0.973 1.000
1002	0.45454545454545453 0.800 0.993 1.000
1003	0.5454545454545454 0.950 0.855 0.808
1004	0.6363636363636364 0.850 0.688 0.595
1005	0.7272727272727273 0.800 0.608 0.480
1006	0.8181818181818182 0.600 0.379 0.210
1007	0.9090909090909091 0.400 0.187 0.000
1008	1.0 0.200 0.100 0.000
1009	}
1010	}
1011	"blue-to-orange" {
1012	set cmap {
1013	0.0 0.000 0.167 1.000
1014	0.09090909090909091 0.100 0.400 1.000
1015	0.18181818181818182 0.200 0.600 1.000
1016	0.2727272727272727 0.400 0.800 1.000
1017	0.36363636363636365 0.600 0.933 1.000
1018	0.45454545454545453 0.800 1.000 1.000
1019	0.5454545454545454 1.000 1.000 0.800
1020	0.6363636363636364 1.000 0.933 0.600
1021	0.7272727272727273 1.000 0.800 0.400
1022	0.8181818181818182 1.000 0.600 0.200
1023	0.9090909090909091 1.000 0.400 0.100
1024	1.0 1.000 0.167 0.000
1025	}
1026	}
1027	"orange-to-blue" {
1028	set cmap {
1029	0.0 1.000 0.167 0.000
1030	0.09090909090909091 1.000 0.400 0.100
1031	0.18181818181818182 1.000 0.600 0.200
1032	0.2727272727272727 1.000 0.800 0.400
1033	0.36363636363636365 1.000 0.933 0.600
1034	0.45454545454545453 1.000 1.000 0.800
1035	0.5454545454545454 0.800 1.000 1.000
1036	0.6363636363636364 0.600 0.933 1.000
1037	0.7272727272727273 0.400 0.800 1.000
1038	0.8181818181818182 0.200 0.600 1.000
1039	0.9090909090909091 0.100 0.400 1.000
1040	1.0 0.000 0.167 1.000
1041	}
1042	}
1043	"rainbow" {
1044	set clist {
1045	"#EE82EE"
1046	"#4B0082"
1047	"blue"
1048	"#008000"
1049	"yellow"
1050	"#FFA500"
1051	"red"
1052	}
1053	}
1054	"BGYOR" {
1055	set clist {
1056	"blue"
1057	"#008000"
1058	"yellow"
1059	"#FFA500"
1060	"red"
1061	}
1062	}
1063	"ROYGB" {
1064	set clist {
1065	"red"
1066	"#FFA500"
1067	"yellow"
1068	"#008000"
1069	"blue"
1070	}
1071	}
1072	"RYGCB" {
1073	set clist {
1074	"red"
1075	"yellow"
1076	"green"
1077	"cyan"
1078	"blue"
1079	}
1080	}
1081	"BCGYR" {
1082	set clist {
1083	"blue"
1084	"cyan"
1085	"green"
1086	"yellow"
1087	"red"
1088	}
1089	}
1090	"spectral" {
1091	set cmap {
1092	0.0 0.150 0.300 1.000
1093	0.1 0.250 0.630 1.000
1094	0.2 0.450 0.850 1.000
1095	0.3 0.670 0.970 1.000
1096	0.4 0.880 1.000 1.000
1097	0.5 1.000 1.000 0.750
1098	0.6 1.000 0.880 0.600
1099	0.7 1.000 0.680 0.450
1100	0.8 0.970 0.430 0.370
1101	0.9 0.850 0.150 0.196
1102	1.0 0.650 0.000 0.130
1103	}
1104	}
1105	"green-to-magenta" {
1106	set cmap {
1107	0.0 0.000 0.316 0.000
1108	0.06666666666666667 0.000 0.526 0.000
1109	0.13333333333333333 0.000 0.737 0.000
1110	0.2 0.000 0.947 0.000
1111	0.26666666666666666 0.316 1.000 0.316
1112	0.3333333333333333 0.526 1.000 0.526
1113	0.4 0.737 1.000 0.737
1114	0.4666666666666667 1.000 1.000 1.000
1115	0.5333333333333333 1.000 0.947 1.000
1116	0.6 1.000 0.737 1.000
1117	0.6666666666666666 1.000 0.526 1.000
1118	0.7333333333333333 1.000 0.316 1.000
1119	0.8 0.947 0.000 0.947
1120	0.8666666666666667 0.737 0.000 0.737
1121	0.9333333333333333 0.526 0.000 0.526
1122	1.0 0.316 0.000 0.316
1123	}
1124	}
1125	"greyscale" {
1126	set cmap {
1127	0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0
1128	}
1129	}
1130	"nanohub" {
1131	set clist "white yellow green cyan blue magenta"
1132	}
1133	default {
1134	set clist [split $colors ":"]
1135	}
1136	}
1137	if {$cmap == ""} {
1138	if { [llength $clist] == 1 } {
1139	set rgb [Color2RGB $clist]
1140	append cmap "0.0 $rgb 1.0 $rgb"
1141	} else {
1142	for {set i 0} {$i < [llength $clist]} {incr i} {
1143	set x [expr {double($i)/([llength $clist]-1)}]
1144	set color [lindex $clist $i]
1145	append cmap "$x [Color2RGB $color] "
1146	}
1147	}
1148	} else {
1149	regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
1150	}
1151	return $cmap
1152	}
1153
1154
1155	#
1156	# StartBufferingCommands --
1157	#
1158	itcl::body Rappture::VisViewer::StartBufferingCommands { } {
1159	incr _buffering
1160	if { $_buffering == 1 } {
1161	set _outbuf ""
1162	}
1163	}
1164
1165	#
1166	# StopBufferingCommands --
1167	#
1168	# This gets called when we want to stop buffering the commands for
1169	# the server and actually send then to the server. Note that there's
1170	# a reference count on buffering. This is so that you can can
1171	# Start/Stop multiple times without worrying about the current state.
1172	#
1173	itcl::body Rappture::VisViewer::StopBufferingCommands { } {
1174	incr _buffering -1
1175	if { $_buffering == 0 } {
1176	SendBytes $_outbuf
1177	set _outbuf ""
1178	}
1179	}
1180
1181	#
1182	# SendCmd
1183	#
1184	# Send command off to the rendering server. If we're currently
1185	# buffering, the command is queued to be sent later.
1186	#
1187	itcl::body Rappture::VisViewer::SendCmd {string} {
1188	incr _cmdSeq
1189	if {$_trace} {
1190	puts stderr "$_cmdSeq>>[string range $string 0 70]"
1191	}
1192	if { $_buffering } {
1193	append _outbuf $string "\n"
1194	} else {
1195	SendBytes "$string\n"
1196	}
1197	}
1198
1199	#
1200	# SendData
1201	#
1202	# Send data off to the rendering server. If we're currently
1203	# buffering, the data is queued to be sent later.
1204	#
1205	itcl::body Rappture::VisViewer::SendData {bytes} {
1206	if {$_trace} {
1207	puts stderr "$_cmdSeq>>data payload"
1208	}
1209	if { $_buffering } {
1210	append _outbuf $bytes
1211	} else {
1212	SendBytes $bytes
1213	}
1214	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: