Context Navigation

source: trunk/gui/scripts/visviewer.tcl @ 4735

Last change on this file since 4735 was 4692, checked in by ldelgass, 9 years ago
Add command sequence counter (this should match the server's command tokens returned in ok/ack replies), tracing of commands and replies to console. Also, clear output buffer from SendHelper? and print an error message if we re- enter SendBytes? causing the output buffer to be clobbered.
File size: 39.8 KB

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

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

Download in other formats: