Context Navigation

source: trunk/gui/scripts/heightmapviewer.tcl @ 1313

Last change on this file since 1313 was 1313, checked in by gah, 15 years ago
Add camera positioning
File size: 44.6 KB

Rev	Line
[1313]	1
[822]	2	# ----------------------------------------------------------------------
[839]	3	# COMPONENT: heightmapviewer - 3D volume rendering
[822]	4	#
[839]	5	# This widget performs volume rendering on 3D scalar/vector datasets.
	6	# It connects to the Nanovis server running on a rendering farm,
[822]	7	# transmits data, and displays the results.
	8	# ======================================================================
	9	# AUTHOR: Michael McLennan, Purdue University
	10	# Copyright (c) 2004-2005 Purdue Research Foundation
	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	# ======================================================================
[909]	15
[822]	16	package require Itk
	17	package require BLT
	18	package require Img
	19
[839]	20	option add *HeightmapViewer.width 4i widgetDefault
	21	option add *HeightmapViewer.height 4i widgetDefault
	22	option add *HeightmapViewer.foreground black widgetDefault
	23	option add *HeightmapViewer.controlBackground gray widgetDefault
	24	option add *HeightmapViewer.controlDarkBackground #999999 widgetDefault
	25	option add *HeightmapViewer.plotBackground black widgetDefault
	26	option add *HeightmapViewer.plotForeground white widgetDefault
	27	option add *HeightmapViewer.plotOutline white widgetDefault
	28	option add *HeightmapViewer.font \
[822]	29	--helvetica-medium-r-normal--12-* widgetDefault
	30
[909]	31	# must use this name -- plugs into Rappture::resources::load
	32	proc HeightmapViewer_init_resources {} {
	33	Rappture::resources::register \
[935]	34	nanovis_server Rappture::HeightmapViewer::SetServerList
[909]	35	}
	36
[839]	37	itcl::class Rappture::HeightmapViewer {
[909]	38	inherit Rappture::VisViewer
[822]	39
	40	itk_option define -plotforeground plotForeground Foreground ""
	41	itk_option define -plotbackground plotBackground Background ""
	42	itk_option define -plotoutline plotOutline PlotOutline ""
	43
[1294]	44	constructor { hostlist args } {
	45	Rappture::VisViewer::constructor $hostlist
	46	} {
	47	# defined below
[909]	48	}
[1294]	49	destructor {
	50	# defined below
[909]	51	}
[822]	52
[935]	53	public proc SetServerList { namelist } {
[1294]	54	Rappture::VisViewer::SetServerList "nanovis" $namelist
[935]	55	}
[822]	56	public method add {dataobj {settings ""}}
	57	public method get {args}
	58	public method delete {args}
	59	public method scale {args}
	60	public method download {option args}
[1294]	61	public method parameters {title args} {
	62	# do nothing
[909]	63	}
[1313]	64	public method drawer {what who}
	65	public method camera {option args}
[909]	66	protected method Connect {}
	67	protected method Disconnect {}
[822]	68
[909]	69	protected method _send {string}
[822]	70	protected method _send_dataobjs {}
[1228]	71	protected method ReceiveImage {option size}
[1313]	72	private method _ReceiveLegend {tf vmin vmax size}
	73	private method _BuildSettingsDrawer {}
	74	private method _BuildCameraDrawer {}
	75	private method _PanCamera {}
[822]	76	protected method _receive_echo {channel {data ""}}
	77
	78	protected method _rebuild {}
	79	protected method _zoom {option}
[1215]	80	protected method _pan {option x y}
	81	protected method _rotate {option x y}
[822]	82
	83	protected method _state {comp}
	84	protected method _fixSettings {what {value ""}}
	85	protected method _getTransfuncData {dataobj comp}
	86
	87
[1228]	88	private variable outbuf_ ;# buffer for outgoing commands
[822]	89
[1228]	90	private variable dlist_ "" ;# list of data objects
	91	private variable obj2style_ ;# maps dataobj => style settings
	92	private variable obj2ovride_ ;# maps dataobj => style override
	93	private variable obj2id_ ;# maps dataobj => heightmap ID in server
	94	private variable id2obj_ ;# maps heightmap ID => dataobj in server
	95	private variable sendobjs_ "" ;# list of data objs to send to server
	96	private variable receiveIds_ ;# list of data responses from the server
	97	private variable click_ ;# info used for _rotate operations
	98	private variable limits_ ;# autoscale min/max for all axes
	99	private variable view_ ;# view params for 3D view
	100	private common settings_ ;# Array used for checkbuttons and radiobuttons
[1313]	101	private variable initialized_
[822]	102	}
	103
[839]	104	itk::usual HeightmapViewer {
[822]	105	keep -background -foreground -cursor -font
	106	keep -plotbackground -plotforeground
	107	}
	108
	109	# ----------------------------------------------------------------------
	110	# CONSTRUCTOR
	111	# ----------------------------------------------------------------------
[839]	112	itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
[909]	113	# Draw legend event
[822]	114	$_dispatcher register !legend
[909]	115	$_dispatcher dispatch $this !legend \
[921]	116	"[itcl::code $this _fixSettings legend]; list"
[909]	117	# Send dataobjs event
	118	$_dispatcher register !send_dataobjs
	119	$_dispatcher dispatch $this !send_dataobjs \
[921]	120	"[itcl::code $this _send_dataobjs]; list"
[909]	121	# Rebuild event
	122	$_dispatcher register !rebuild
	123	$_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
[822]	124
[1228]	125	set outbuf_ ""
[822]	126
	127	#
[909]	128	# Populate parser with commands handle incoming requests
[822]	129	#
[1228]	130	$_parser alias image [itcl::code $this ReceiveImage]
[1313]	131	$_parser alias legend [itcl::code $this _ReceiveLegend]
[822]	132
[919]	133	# Initialize the view to some default parameters.
[1228]	134	array set view_ {
[921]	135	theta 45
	136	phi 45
	137	psi 0
	138	zoom 1.0
[1313]	139	pan-x 0
	140	pan-y 0
[919]	141	}
[1228]	142	set obj2id_(count) 0
[822]	143
	144	itk_component add zoom {
	145	frame $itk_component(controls).zoom
	146	} {
	147	usual
	148	rename -background -controlbackground controlBackground Background
	149	}
	150	pack $itk_component(zoom) -side top
	151
	152	itk_component add reset {
	153	button $itk_component(zoom).reset \
	154	-borderwidth 1 -padx 1 -pady 1 \
[1313]	155	-image [Rappture::icon reset-view] \
[822]	156	-command [itcl::code $this _zoom reset]
	157	} {
	158	usual
	159	ignore -borderwidth
	160	rename -highlightbackground -controlbackground controlBackground Background
	161	}
[1313]	162	pack $itk_component(reset) -side top -padx 2 -pady { 2 0 }
[822]	163	Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
	164
	165	itk_component add zoomin {
	166	button $itk_component(zoom).zin \
	167	-borderwidth 1 -padx 1 -pady 1 \
[1313]	168	-image [Rappture::icon zoom-in] \
[822]	169	-command [itcl::code $this _zoom in]
	170	} {
	171	usual
	172	ignore -borderwidth
	173	rename -highlightbackground -controlbackground controlBackground Background
	174	}
[1313]	175	pack $itk_component(zoomin) -side top -padx 2 -pady { 2 0 }
[822]	176	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
	177
	178	itk_component add zoomout {
	179	button $itk_component(zoom).zout \
	180	-borderwidth 1 -padx 1 -pady 1 \
[1313]	181	-image [Rappture::icon zoom-out] \
[822]	182	-command [itcl::code $this _zoom out]
	183	} {
	184	usual
	185	ignore -borderwidth
	186	rename -highlightbackground -controlbackground controlBackground Background
	187	}
[1313]	188	pack $itk_component(zoomout) -side top -padx 2 -pady { 2 0 }
[822]	189	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
	190
[1313]	191	itk_component add settings_button {
	192	label $itk_component(controls).settingsbutton \
	193	-borderwidth 1 -padx 1 -pady 1 \
	194	-relief "raised" -image [Rappture::icon wrench]
[822]	195	} {
	196	usual
	197	ignore -borderwidth
[1313]	198	rename -highlightbackground -controlbackground controlBackground \
	199	Background
[822]	200	}
[1313]	201	pack $itk_component(settings_button) -padx 2 -pady { 0 2 } \
	202	-ipadx 1 -ipady 1
	203	Rappture::Tooltip::for $itk_component(settings_button) \
	204	"Configure settings"
	205	bind $itk_component(settings_button) <ButtonPress> \
	206	[itcl::code $this drawer toggle settings]
	207	pack $itk_component(settings_button) -side bottom \
	208	-padx 2 -pady 2 -anchor e
[822]	209
[1313]	210	itk_component add camera_button {
	211	label $itk_component(controls).camerabutton \
	212	-borderwidth 1 -padx 1 -pady 1 \
	213	-relief "raised" -image [Rappture::icon camera]
	214	} {
	215	usual
	216	ignore -borderwidth
	217	rename -highlightbackground -controlbackground controlBackground \
	218	Background
	219	}
	220	Rappture::Tooltip::for $itk_component(camera_button) \
	221	"Camera settings"
	222	bind $itk_component(camera_button) <ButtonPress> \
	223	[itcl::code $this drawer toggle camera]
	224	pack $itk_component(camera_button) -side bottom \
	225	-padx 2 -pady { 0 2 } -ipadx 1 -ipady 1
[1294]	226
[1313]	227	_BuildSettingsDrawer
	228	_BuildCameraDrawer
[1294]	229
[909]	230	# Legend
[822]	231	set _image(legend) [image create photo]
	232	itk_component add legend {
[1313]	233	canvas $itk_component(area).legend -width 30 -highlightthickness 0
[822]	234	} {
	235	usual
	236	ignore -highlightthickness
	237	rename -background -plotbackground plotBackground Background
	238	}
[1313]	239	pack $itk_component(legend) -side right -fill y
	240	pack $itk_component(3dview) -side left -expand yes -fill both
[822]	241	bind $itk_component(legend) <Configure> \
	242	[list $_dispatcher event -idle !legend]
	243
[1228]	244	# Bindings for rotation via mouse
[1215]	245	bind $itk_component(3dview) <ButtonPress-1> \
	246	[itcl::code $this _rotate click %x %y]
[822]	247	bind $itk_component(3dview) <B1-Motion> \
[1215]	248	[itcl::code $this _rotate drag %x %y]
	249	bind $itk_component(3dview) <ButtonRelease-1> \
	250	[itcl::code $this _rotate release %x %y]
[822]	251	bind $itk_component(3dview) <Configure> \
[909]	252	[itcl::code $this _send "screen %w %h"]
[822]	253
[1228]	254	# Bindings for panning via mouse
[1215]	255	bind $itk_component(3dview) <ButtonPress-2> \
	256	[itcl::code $this _pan click %x %y]
	257	bind $itk_component(3dview) <B2-Motion> \
	258	[itcl::code $this _pan drag %x %y]
	259	bind $itk_component(3dview) <ButtonRelease-2> \
	260	[itcl::code $this _pan release %x %y]
	261
[1228]	262	# Bindings for panning via keyboard
	263	bind $itk_component(3dview) <KeyPress-Left> \
	264	[itcl::code $this _pan set -10 0]
	265	bind $itk_component(3dview) <KeyPress-Right> \
	266	[itcl::code $this _pan set 10 0]
	267	bind $itk_component(3dview) <KeyPress-Up> \
	268	[itcl::code $this _pan set 0 -10]
	269	bind $itk_component(3dview) <KeyPress-Down> \
	270	[itcl::code $this _pan set 0 10]
	271	bind $itk_component(3dview) <Shift-KeyPress-Left> \
	272	[itcl::code $this _pan set -2 0]
	273	bind $itk_component(3dview) <Shift-KeyPress-Right> \
	274	[itcl::code $this _pan set 2 0]
	275	bind $itk_component(3dview) <Shift-KeyPress-Up> \
	276	[itcl::code $this _pan set 0 -2]
	277	bind $itk_component(3dview) <Shift-KeyPress-Down> \
	278	[itcl::code $this _pan set 0 2]
	279
	280	# Bindings for zoom via keyboard
	281	bind $itk_component(3dview) <KeyPress-Prior> \
[1294]	282	[itcl::code $this _zoom out]
[1228]	283	bind $itk_component(3dview) <KeyPress-Next> \
[1294]	284	[itcl::code $this _zoom in]
[1228]	285
	286	bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
	287
[1215]	288	if {[string equal "x11" [tk windowingsystem]]} {
[1294]	289	# Bindings for zoom via mouse
	290	bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
	291	bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
[1215]	292	}
	293
[822]	294	set _image(download) [image create photo]
	295
	296	eval itk_initialize $args
	297
[909]	298	Connect
[822]	299	}
	300
	301	# ----------------------------------------------------------------------
	302	# DESTRUCTOR
	303	# ----------------------------------------------------------------------
[839]	304	itcl::body Rappture::HeightmapViewer::destructor {} {
[1228]	305	set sendobjs_ "" ;# stop any send in progress
[909]	306	$_dispatcher cancel !rebuild
	307	$_dispatcher cancel !send_dataobjs
[822]	308	image delete $_image(plot)
	309	image delete $_image(legend)
	310	image delete $_image(download)
	311	}
	312
	313	# ----------------------------------------------------------------------
	314	# USAGE: add <dataobj> ?<settings>?
	315	#
	316	# Clients use this to add a data object to the plot. The optional
	317	# <settings> are used to configure the plot. Allowed settings are
	318	# -color, -brightness, -width, -linestyle, and -raise.
	319	# ----------------------------------------------------------------------
[839]	320	itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
[822]	321	array set params {
	322	-color auto
	323	-width 1
	324	-linestyle solid
	325	-brightness 0
	326	-raise 0
	327	-description ""
	328	-param ""
	329	}
	330	foreach {opt val} $settings {
	331	if {![info exists params($opt)]} {
	332	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
	333	}
	334	set params($opt) $val
	335	}
	336	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
	337	# can't handle -autocolors yet
	338	set params(-color) black
	339	}
[1313]	340	set location [$dataobj hints camera]
	341	if { $location != "" } {
	342	array set view_ $location
	343	}
[1228]	344	set pos [lsearch -exact $dataobj $dlist_]
[822]	345	if {$pos < 0} {
[1228]	346	lappend dlist_ $dataobj
	347	set obj2ovride_($dataobj-color) $params(-color)
	348	set obj2ovride_($dataobj-width) $params(-width)
	349	set obj2ovride_($dataobj-raise) $params(-raise)
[921]	350	$_dispatcher event -idle !rebuild
[822]	351	}
	352	}
	353
	354	# ----------------------------------------------------------------------
	355	# USAGE: get ?-objects?
	356	# USAGE: get ?-image 3dview\|legend?
	357	#
	358	# Clients use this to query the list of objects being plotted, in
	359	# order from bottom to top of this result. The optional "-image"
	360	# flag can also request the internal images being shown.
	361	# ----------------------------------------------------------------------
[839]	362	itcl::body Rappture::HeightmapViewer::get {args} {
[822]	363	if {[llength $args] == 0} {
	364	set args "-objects"
	365	}
	366
	367	set op [lindex $args 0]
	368	switch -- $op {
	369	-objects {
	370	# put the dataobj list in order according to -raise options
[1228]	371	set dlist $dlist_
[822]	372	foreach obj $dlist {
[1228]	373	if { [info exists obj2ovride_($obj-raise)] &&
	374	$obj2ovride_($obj-raise)} {
[822]	375	set i [lsearch -exact $dlist $obj]
	376	if {$i >= 0} {
	377	set dlist [lreplace $dlist $i $i]
	378	lappend dlist $obj
	379	}
	380	}
	381	}
	382	return $dlist
	383	}
	384	-image {
	385	if {[llength $args] != 2} {
	386	error "wrong # args: should be \"get -image 3dview\|legend\""
	387	}
	388	switch -- [lindex $args end] {
	389	3dview {
	390	return $_image(plot)
	391	}
	392	legend {
	393	return $_image(legend)
	394	}
	395	default {
	396	error "bad image name \"[lindex $args end]\": should be 3dview or legend"
	397	}
	398	}
	399	}
	400	default {
	401	error "bad option \"$op\": should be -objects or -image"
	402	}
	403	}
	404	}
	405
	406	# ----------------------------------------------------------------------
	407	# USAGE: delete ?<dataobj1> <dataobj2> ...?
	408	#
	409	# Clients use this to delete a dataobj from the plot. If no dataobjs
	410	# are specified, then all dataobjs are deleted.
	411	# ----------------------------------------------------------------------
[839]	412	itcl::body Rappture::HeightmapViewer::delete {args} {
[822]	413	if {[llength $args] == 0} {
[1228]	414	set args $dlist_
[822]	415	}
	416
	417	# delete all specified dataobjs
	418	set changed 0
	419	foreach dataobj $args {
[1228]	420	set pos [lsearch -exact $dlist_ $dataobj]
[822]	421	if {$pos >= 0} {
[1228]	422	set dlist_ [lreplace $dlist_ $pos $pos]
	423	foreach key [array names obj2ovride_ $dataobj-*] {
	424	unset obj2ovride_($key)
[822]	425	}
	426	set changed 1
	427	}
	428	}
	429
	430	# if anything changed, then rebuild the plot
	431	if {$changed} {
[921]	432	$_dispatcher event -idle !rebuild
[822]	433	}
	434	}
	435
	436	# ----------------------------------------------------------------------
	437	# USAGE: scale ?<data1> <data2> ...?
	438	#
	439	# Sets the default limits for the overall plot according to the
	440	# limits of the data for all of the given <data> objects. This
	441	# accounts for all objects--even those not showing on the screen.
	442	# Because of this, the limits are appropriate for all objects as
	443	# the user scans through data in the ResultSet viewer.
	444	# ----------------------------------------------------------------------
[839]	445	itcl::body Rappture::HeightmapViewer::scale {args} {
[822]	446	foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
[1228]	447	set limits_($val) ""
[822]	448	}
	449	foreach obj $args {
	450	foreach axis {x y z v} {
	451	foreach {min max} [$obj limits $axis] break
	452	if {"" != $min && "" != $max} {
[1228]	453	if {"" == $limits_(${axis}min)} {
	454	set limits_(${axis}min) $min
	455	set limits_(${axis}max) $max
[822]	456	} else {
[1228]	457	if {$min < $limits_(${axis}min)} {
	458	set limits_(${axis}min) $min
[822]	459	}
[1228]	460	if {$max > $limits_(${axis}max)} {
	461	set limits_(${axis}max) $max
[822]	462	}
	463	}
[1313]	464	set limits_(${axis}range) [expr {$max - $min}]
[822]	465	}
	466	}
	467	}
	468	}
	469
	470	# ----------------------------------------------------------------------
	471	# USAGE: download coming
	472	# USAGE: download controls <downloadCommand>
	473	# USAGE: download now
	474	#
	475	# Clients use this method to create a downloadable representation
	476	# of the plot. Returns a list of the form {ext string}, where
	477	# "ext" is the file extension (indicating the type of data) and
	478	# "string" is the data itself.
	479	# ----------------------------------------------------------------------
[839]	480	itcl::body Rappture::HeightmapViewer::download {option args} {
[822]	481	switch $option {
	482	coming {
[839]	483	if {[catch {
[921]	484	blt::winop snap $itk_component(area) $_image(download)
	485	}]} {
[822]	486	$_image(download) configure -width 1 -height 1
	487	$_image(download) put #000000
	488	}
	489	}
	490	controls {
	491	# no controls for this download yet
	492	return ""
	493	}
	494	now {
	495	#
	496	# Hack alert! Need data in binary format,
	497	# so we'll save to a file and read it back.
	498	#
	499	set tmpfile /tmp/image[pid].jpg
	500	$_image(download) write $tmpfile -format jpeg
	501	set fid [open $tmpfile r]
	502	fconfigure $fid -encoding binary -translation binary
	503	set bytes [read $fid]
	504	close $fid
	505	file delete -force $tmpfile
	506
	507	return [list .jpg $bytes]
	508	}
	509	default {
	510	error "bad option \"$option\": should be coming, controls, now"
	511	}
	512	}
	513	}
	514
	515	# ----------------------------------------------------------------------
[909]	516	# USAGE: Connect ?<host:port>,<host:port>...?
[822]	517	#
	518	# Clients use this method to establish a connection to a new
	519	# server, or to reestablish a connection to the previous server.
	520	# Any existing connection is automatically closed.
	521	# ----------------------------------------------------------------------
[909]	522	itcl::body Rappture::HeightmapViewer::Connect {} {
	523	Disconnect
	524	set _hosts [GetServerList "nanovis"]
	525	if { "" == $_hosts } {
[822]	526	return 0
	527	}
[909]	528	set result [VisViewer::Connect $_hosts]
	529	return $result
[822]	530	}
	531
	532	# ----------------------------------------------------------------------
[909]	533	# USAGE: Disconnect
[822]	534	#
	535	# Clients use this method to disconnect from the current rendering
	536	# server.
	537	# ----------------------------------------------------------------------
[909]	538	itcl::body Rappture::HeightmapViewer::Disconnect {} {
	539	VisViewer::Disconnect
[822]	540
[1228]	541	set outbuf_ ""
[822]	542	# disconnected -- no more data sitting on server
[1228]	543	catch {unset obj2id_}
	544	array unset id2obj_
	545	set obj2id_(count) 0
	546	set id2obj_(cound) 0
	547	set sendobjs_ ""
[822]	548	}
	549
	550	#
[919]	551	# _send
[822]	552	#
[921]	553	# Send commands off to the rendering server. If we're currently
	554	# sending data objects to the server, buffer the commands to be
	555	# sent later.
[919]	556	#
[909]	557	itcl::body Rappture::HeightmapViewer::_send {string} {
[1228]	558	if {[llength $sendobjs_] > 0} {
	559	append outbuf_ $string "\n"
[919]	560	} else {
[921]	561	if {[SendBytes $string]} {
	562	foreach line [split $string \n] {
	563	SendEcho >>line $line
	564	}
	565	}
[822]	566	}
	567	}
	568
	569	# ----------------------------------------------------------------------
	570	# USAGE: _send_dataobjs
	571	#
	572	# Used internally to send a series of volume objects off to the
	573	# server. Sends each object, a little at a time, with updates in
	574	# between so the interface doesn't lock up.
	575	# ----------------------------------------------------------------------
[839]	576	itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
[822]	577	blt::busy hold $itk_component(hull); update idletasks
	578
[919]	579	# Reset the overall limits
[1228]	580	if { $sendobjs_ != "" } {
	581	set limits_(vmin) ""
	582	set limits_(vmax) ""
[919]	583	}
[1228]	584	foreach dataobj $sendobjs_ {
[822]	585	foreach comp [$dataobj components] {
[839]	586	set data [$dataobj blob $comp]
[822]	587
[921]	588	foreach { vmin vmax } [$dataobj limits v] break
[1228]	589	if { $limits_(vmin) == "" \|\| $vmin < $limits_(vmin) } {
	590	set limits_(vmin) $vmin
[921]	591	}
[1228]	592	if { $limits_(vmax) == "" \|\| $vmax > $limits_(vmax) } {
	593	set limits_(vmax) $vmax
[921]	594	}
[919]	595
[822]	596	# tell the engine to expect some data
[919]	597	set nbytes [string length $data]
[1294]	598	if { ![SendBytes "heightmap data follows $nbytes"] } {
[822]	599	return
[1112]	600
[822]	601	}
[921]	602	if { ![SendBytes $data] } {
	603	return
	604	}
[1228]	605	set id $obj2id_(count)
	606	incr obj2id_(count)
	607	set id2obj_($id) [list $dataobj $comp]
	608	set obj2id_($dataobj-$comp) $id
	609	set receiveIds_($id) 1
[822]	610
	611	#
	612	# Determine the transfer function needed for this volume
	613	# and make sure that it's defined on the server.
	614	#
	615	foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
[839]	616	set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
[919]	617	if {![SendBytes $cmdstr]} {
[822]	618	return
	619	}
[1228]	620	set obj2style_($dataobj-$comp) $sname
[822]	621	}
	622	}
[1228]	623	set sendobjs_ ""
[822]	624	blt::busy release $itk_component(hull)
	625
	626	# activate the proper volume
	627	set first [lindex [get] 0]
	628	if {"" != $first} {
	629	set axis [$first hints updir]
	630	if {"" != $axis} {
[909]	631	_send "up $axis"
[822]	632	}
	633	}
	634
[1228]	635	foreach key [array names obj2id_ -] {
[839]	636	set state [string match $first-* $key]
[1228]	637	_send "heightmap data visible $state $obj2id_($key)"
	638	if {[info exists obj2style_($key)]} {
	639	_send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
[822]	640	}
	641	}
	642
	643	# if there are any commands in the buffer, send them now that we're done
[1228]	644	SendBytes $outbuf_
	645	set outbuf_ ""
[822]	646
	647	$_dispatcher event -idle !legend
	648	}
	649
	650	# ----------------------------------------------------------------------
[1228]	651	# USAGE: ReceiveImage -bytes <size>
[822]	652	#
	653	# Invoked automatically whenever the "image" command comes in from
	654	# the rendering server. Indicates that binary image data with the
	655	# specified <size> will follow.
	656	# ----------------------------------------------------------------------
[1228]	657	itcl::body Rappture::HeightmapViewer::ReceiveImage {option size} {
	658	if {[IsConnected]} {
[919]	659	set bytes [ReceiveBytes $size]
[822]	660	$_image(plot) configure -data $bytes
[909]	661	ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
[822]	662	}
	663	}
	664
	665	# ----------------------------------------------------------------------
[1313]	666	# USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>
[822]	667	#
	668	# Invoked automatically whenever the "legend" command comes in from
	669	# the rendering server. Indicates that binary image data with the
	670	# specified <size> will follow.
	671	# ----------------------------------------------------------------------
[1313]	672	itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
[1228]	673	if { [IsConnected] } {
[919]	674	set bytes [ReceiveBytes $size]
[909]	675	ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
[1313]	676	if 1 {
	677	set src [image create photo -data $bytes]
	678	blt::winop image rotate $src $_image(legend) 90
	679	set dst $_image(legend)
	680	} else {
	681	$_image(legend) configure -data $bytes
	682	}
[822]	683	set c $itk_component(legend)
	684	set w [winfo width $c]
	685	set h [winfo height $c]
[1313]	686	set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
[822]	687	if {"" == [$c find withtag transfunc]} {
[1313]	688	$c create image 0 [expr $lineht] -anchor ne \
[822]	689	-image $_image(legend) -tags transfunc
[1313]	690	$c create text 10 [expr {$h-8}] -anchor se \
[822]	691	-fill $itk_option(-plotforeground) -tags vmin
[1313]	692	$c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
[822]	693	-fill $itk_option(-plotforeground) -tags vmax
	694	}
[1313]	695	$c coords transfunc [expr $w - 5] [expr $lineht]
[1111]	696	$c itemconfigure vmin -text $vmin
	697	$c itemconfigure vmax -text $vmax
[1313]	698	$c coords vmax [expr $w - 5] 2
	699	$c coords vmin [expr $w - 5] [expr $h - 2]
[822]	700	}
	701	}
	702
	703	# ----------------------------------------------------------------------
	704	# USAGE: _rebuild
	705	#
	706	# Called automatically whenever something changes that affects the
	707	# data in the widget. Clears any existing data and rebuilds the
	708	# widget to display new data.
	709	# ----------------------------------------------------------------------
[839]	710	itcl::body Rappture::HeightmapViewer::_rebuild {} {
[822]	711	# in the midst of sending data? then bail out
[1228]	712	if {[llength $sendobjs_] > 0} {
[822]	713	return
	714	}
[919]	715	# Find any new data that needs to be sent to the server. Queue this up on
[1228]	716	# the sendobjs_ list, and send it out a little at a time. Do this first,
[919]	717	# before we rebuild the rest.
[822]	718	foreach dataobj [get] {
	719	set comp [lindex [$dataobj components] 0]
[1228]	720	if {![info exists obj2id_($dataobj-$comp)]} {
	721	set i [lsearch -exact $sendobjs_ $dataobj]
[822]	722	if {$i < 0} {
[1228]	723	lappend sendobjs_ $dataobj
[822]	724	}
	725	}
	726	}
[1228]	727	if {[llength $sendobjs_] > 0} {
[919]	728	# Send off new data objects
[909]	729	$_dispatcher event -idle !send_dataobjs
[822]	730	} else {
[919]	731	# Nothing to send -- activate the proper volume
[822]	732	set first [lindex [get] 0]
	733	if {"" != $first} {
	734	set axis [$first hints updir]
	735	if {"" != $axis} {
[909]	736	_send "up $axis"
[822]	737	}
	738	}
[1228]	739	foreach key [array names obj2id_ -] {
[839]	740	set state [string match $first-* $key]
[1228]	741	_send "heightmap data visible $state $obj2id_($key)"
	742	if {[info exists obj2style_($key)]} {
	743	_send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
[822]	744	}
	745	}
	746	$_dispatcher event -idle !legend
	747	}
	748
[1220]	749	# Reset the screen size.
	750	set w [winfo width $itk_component(3dview)]
	751	set h [winfo height $itk_component(3dview)]
	752	_send "screen $w $h"
	753
[822]	754	# Reset the camera and other view parameters
[1228]	755	set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
[1220]	756	_send "camera angle $xyz"
[1313]	757	_PanCamera
[1228]	758	_send "camera zoom $view_(zoom)"
[822]	759
[839]	760	if {"" == $itk_option(-plotoutline)} {
[909]	761	_send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
[839]	762	}
[1313]	763	set settings_($this-theta) $view_(theta)
	764	set settings_($this-phi) $view_(phi)
	765	set settings_($this-psi) $view_(psi)
	766	set settings_($this-pan-x) $view_(pan-x)
	767	set settings_($this-pan-y) $view_(pan-y)
	768	set settings_($this-zoom) $view_(zoom)
	769
[935]	770	_fixSettings wireframe
[909]	771	_fixSettings grid
	772	_fixSettings axes
	773	_fixSettings contourlines
[822]	774	}
	775
	776	# ----------------------------------------------------------------------
	777	# USAGE: _zoom in
	778	# USAGE: _zoom out
	779	# USAGE: _zoom reset
	780	#
	781	# Called automatically when the user clicks on one of the zoom
	782	# controls for this widget. Changes the zoom for the current view.
	783	# ----------------------------------------------------------------------
[839]	784	itcl::body Rappture::HeightmapViewer::_zoom {option} {
[822]	785	switch -- $option {
[919]	786	"in" {
[1228]	787	set view_(zoom) [expr {$view_(zoom)*1.25}]
[1313]	788	set settings_($this-zoom) $view_(zoom)
[822]	789	}
[919]	790	"out" {
[1228]	791	set view_(zoom) [expr {$view_(zoom)*0.8}]
[1313]	792	set settings_($this-zoom) $view_(zoom)
[822]	793	}
[919]	794	"reset" {
[1228]	795	array set view_ {
[921]	796	theta 45
	797	phi 45
	798	psi 0
[1313]	799	zoom 1.0
	800	pan-x 0
	801	pan-y 0
[921]	802	}
[1313]	803	set first [lindex [get] 0]
	804	if { $first != "" } {
	805	set location [$first hints camera]
	806	if { $location != "" } {
	807	array set view_ $location
	808	}
	809	}
[1228]	810	set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
[909]	811	_send "camera angle $xyz"
[1313]	812	_PanCamera
	813	set settings_($this-theta) $view_(theta)
	814	set settings_($this-phi) $view_(phi)
	815	set settings_($this-psi) $view_(psi)
	816	set settings_($this-pan-x) $view_(pan-x)
	817	set settings_($this-pan-y) $view_(pan-y)
	818	set settings_($this-zoom) $view_(zoom)
[822]	819	}
	820	}
[1228]	821	_send "camera zoom $view_(zoom)"
[822]	822	}
	823
	824	# ----------------------------------------------------------------------
[1215]	825	# USAGE: $this _pan click x y
	826	# $this _pan drag x y
[1294]	827	# $this _pan release x y
[822]	828	#
[1215]	829	# Called automatically when the user clicks on one of the zoom
	830	# controls for this widget. Changes the zoom for the current view.
	831	# ----------------------------------------------------------------------
[1246]	832	itcl::body Rappture::HeightmapViewer::_pan {option x y} {
[1228]	833	# Experimental stuff
[1243]	834	set w [winfo width $itk_component(3dview)]
	835	set h [winfo height $itk_component(3dview)]
[1228]	836	if { $option == "set" } {
[1313]	837	set x [expr ($x / double($w)) * $limits_(xrange)]
	838	set y [expr ($y / double($h)) * $limits_(yrange)]
	839	set view_(pan-x) [expr $view_(pan-x) + $x]
	840	set view_(pan-y) [expr $view_(pan-y) + $y]
	841	_PanCamera
	842	set settings_($this-pan-x) $view_(pan-x)
	843	set settings_($this-pan-y) $view_(pan-y)
[1294]	844	return
[1228]	845	}
[1294]	846	if { $option == "click" } {
	847	set click_(x) $x
	848	set click_(y) $y
[1215]	849	$itk_component(3dview) configure -cursor hand1
	850	}
	851	if { $option == "drag" \|\| $option == "release" } {
[1313]	852	set dx [expr (($click_(x) - $x)/double($w)) * $limits_(xrange)]
	853	set dy [expr (($click_(y) - $y)/double($h)) * $limits_(yrange)]
	854	set click_(x) $x
	855	set click_(y) $y
	856	set view_(pan-x) [expr $view_(pan-x) - $dx]
	857	set view_(pan-y) [expr $view_(pan-y) - $dy]
	858	_PanCamera
	859	set settings_($this-pan-x) $view_(pan-x)
	860	set settings_($this-pan-y) $view_(pan-y)
[1215]	861	}
	862	if { $option == "release" } {
	863	$itk_component(3dview) configure -cursor ""
	864	}
	865	}
	866
[1313]	867	itcl::body Rappture::HeightmapViewer::_PanCamera {} {
	868	set x [expr ($view_(pan-x)) / $limits_(xrange)]
	869	set y [expr ($view_(pan-y)) / $limits_(yrange)]
	870	_send "camera pan $x $y"
	871	}
	872
[1215]	873	# ----------------------------------------------------------------------
	874	# USAGE: _rotate click <x> <y>
	875	# USAGE: _rotate drag <x> <y>
	876	# USAGE: _rotate release <x> <y>
	877	#
[822]	878	# Called automatically when the user clicks/drags/releases in the
	879	# plot area. Moves the plot according to the user's actions.
	880	# ----------------------------------------------------------------------
[1215]	881	itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
[822]	882	switch -- $option {
	883	click {
	884	$itk_component(3dview) configure -cursor fleur
[1294]	885	array set click_ [subst {
	886	x $x
	887	y $y
	888	theta $view_(theta)
	889	phi $view_(phi)
	890	}]
[822]	891	}
	892	drag {
[1228]	893	if {[array size click_] == 0} {
[1215]	894	_rotate click $x $y
[822]	895	} else {
	896	set w [winfo width $itk_component(3dview)]
	897	set h [winfo height $itk_component(3dview)]
	898	if {$w <= 0 \|\| $h <= 0} {
	899	return
	900	}
	901
	902	if {[catch {
	903	# this fails sometimes for no apparent reason
[1228]	904	set dx [expr {double($x-$click_(x))/$w}]
	905	set dy [expr {double($y-$click_(y))/$h}]
[1250]	906	}] != 0 } {
[822]	907	return
	908	}
	909
	910	#
	911	# Rotate the camera in 3D
	912	#
[1228]	913	if {$view_(psi) > 90 \|\| $view_(psi) < -90} {
[822]	914	# when psi is flipped around, theta moves backwards
	915	set dy [expr {-$dy}]
	916	}
[1228]	917	set theta [expr {$view_(theta) - $dy*180}]
[822]	918	while {$theta < 0} { set theta [expr {$theta+180}] }
	919	while {$theta > 180} { set theta [expr {$theta-180}] }
	920
	921	if {abs($theta) >= 30 && abs($theta) <= 160} {
[1228]	922	set phi [expr {$view_(phi) - $dx*360}]
[822]	923	while {$phi < 0} { set phi [expr {$phi+360}] }
	924	while {$phi > 360} { set phi [expr {$phi-360}] }
[1228]	925	set psi $view_(psi)
[822]	926	} else {
[1228]	927	set phi $view_(phi)
	928	set psi [expr {$view_(psi) - $dx*360}]
[822]	929	while {$psi < -180} { set psi [expr {$psi+360}] }
	930	while {$psi > 180} { set psi [expr {$psi-360}] }
	931	}
	932
[1228]	933	set view_(theta) $theta
	934	set view_(phi) $phi
	935	set view_(psi) $psi
	936	set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
[1313]	937	set settings_($this-theta) $view_(theta)
	938	set settings_($this-phi) $view_(phi)
	939	set settings_($this-psi) $view_(psi)
[909]	940	_send "camera angle $xyz"
[1228]	941	set click_(x) $x
	942	set click_(y) $y
[822]	943	}
	944	}
	945	release {
[1215]	946	_rotate drag $x $y
[822]	947	$itk_component(3dview) configure -cursor ""
[1228]	948	catch {unset click_}
[822]	949	}
	950	default {
	951	error "bad option \"$option\": should be click, drag, release"
	952	}
	953	}
	954	}
	955
	956	# ----------------------------------------------------------------------
	957	# USAGE: _state <component>
	958	#
	959	# Used internally to determine the state of a toggle button.
	960	# The <component> is the itk component name of the button.
	961	# Returns on/off for the state of the button.
	962	# ----------------------------------------------------------------------
[839]	963	itcl::body Rappture::HeightmapViewer::_state {comp} {
[822]	964	if {[$itk_component($comp) cget -relief] == "sunken"} {
	965	return "on"
	966	}
	967	return "off"
	968	}
	969
	970	# ----------------------------------------------------------------------
	971	# USAGE: _fixSettings <what> ?<value>?
	972	#
	973	# Used internally to update rendering settings whenever parameters
	974	# change in the popup settings panel. Sends the new settings off
	975	# to the back end.
	976	# ----------------------------------------------------------------------
[909]	977	itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
[822]	978	switch -- $what {
[921]	979	"legend" {
[1313]	980	if { $settings_($this-legend) } {
	981	pack $itk_component(legend) -side right -fill y
	982	} else {
	983	pack forget $itk_component(legend)
	984	}
	985	set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
	986	set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
	987	set h [expr {[winfo width $itk_component(legend)] - 16}]
[921]	988	set imap ""
	989	set dataobj [lindex [get] 0]
	990	if {"" != $dataobj} {
	991	set comp [lindex [$dataobj components] 0]
[1228]	992	if {[info exists obj2id_($dataobj-$comp)]} {
	993	set imap $obj2id_($dataobj-$comp)
[921]	994	}
	995	}
	996	if {$w > 0 && $h > 0 && "" != $imap} {
	997	_send "heightmap legend $imap $w $h"
	998	} else {
	999	$itk_component(legend) delete all
	1000	}
	1001	}
	1002	"grid" {
[1228]	1003	if { [IsConnected] } {
	1004	_send "grid visible $settings_($this-grid)"
[921]	1005	}
	1006	}
	1007	"axes" {
[1228]	1008	if { [IsConnected] } {
	1009	_send "axis visible $settings_($this-axes)"
[921]	1010	}
	1011	}
[935]	1012	"wireframe" {
[1228]	1013	if { [IsConnected] } {
	1014	_send "heightmap polygon $settings_($this-wireframe)"
[935]	1015	}
	1016	}
[921]	1017	"contourlines" {
[1228]	1018	if {[IsConnected]} {
[921]	1019	set dataobj [lindex [get] 0]
	1020	if {"" != $dataobj} {
	1021	set comp [lindex [$dataobj components] 0]
[1228]	1022	if {[info exists obj2id_($dataobj-$comp)]} {
	1023	set i $obj2id_($dataobj-$comp)
	1024	set bool $settings_($this-contourlines)
[921]	1025	_send "heightmap linecontour visible $bool $i"
	1026	}
	1027	}
	1028	}
	1029	}
[822]	1030	default {
[909]	1031	error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
[822]	1032	}
	1033	}
	1034	}
	1035
	1036	# ----------------------------------------------------------------------
	1037	# USAGE: _getTransfuncData <dataobj> <comp>
	1038	#
	1039	# Used internally to compute the colormap and alpha map used to define
	1040	# a transfer function for the specified component in a data object.
	1041	# Returns: name {v r g b ...} {v w ...}
	1042	# ----------------------------------------------------------------------
[839]	1043	itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
[822]	1044	array set style {
	1045	-color rainbow
	1046	-levels 6
	1047	-opacity 0.5
	1048	}
	1049	array set style [lindex [$dataobj components -style $comp] 0]
	1050	set sname "$style(-color):$style(-levels):$style(-opacity)"
	1051
	1052	if {$style(-color) == "rainbow"} {
	1053	set style(-color) "white:yellow:green:cyan:blue:magenta"
	1054	}
	1055	set clist [split $style(-color) :]
[1013]	1056	set color white
	1057	set cmap "0.0 [Color2RGB $color] "
[1228]	1058	set range [expr $limits_(vmax) - $limits_(vmin)]
[822]	1059	for {set i 0} {$i < [llength $clist]} {incr i} {
	1060	set xval [expr {double($i+1)/([llength $clist]+1)}]
	1061	set color [lindex $clist $i]
[909]	1062	append cmap "$xval [Color2RGB $color] "
[822]	1063	}
[1111]	1064	append cmap "1.0 [Color2RGB $color] "
[822]	1065
[1013]	1066	set opacity $style(-opacity)
[822]	1067	set levels $style(-levels)
[1013]	1068	set wmap {}
[822]	1069	if {[string is int $levels]} {
[1013]	1070	lappend wmap 0.0 0.0
[822]	1071	set delta [expr {0.125/($levels+1)}]
	1072	for {set i 1} {$i <= $levels} {incr i} {
	1073	# add spikes in the middle
	1074	set xval [expr {double($i)/($levels+1)}]
[1294]	1075	lappend wmap [expr {$xval-$delta-0.01}] 0.0
	1076	lappend wmap [expr {$xval-$delta}] $opacity
	1077	lappend wmap [expr {$xval+$delta}] $opacity
	1078	lappend wmap [expr {$xval+$delta+0.01}] 0.0
[822]	1079	}
[1013]	1080	lappend wmap 1.0 0.0
[822]	1081	} else {
[1013]	1082	lappend wmap 0.0 0.0
[822]	1083	set delta 0.05
	1084	foreach xval [split $levels ,] {
[1294]	1085	lappend wmap [expr {$xval-$delta}] 0.0
	1086	lappend $xval $opacity
	1087	lappend [expr {$xval+$delta}] 0.0
[822]	1088	}
[1013]	1089	lappend wmap 1.0 0.0
[822]	1090	}
	1091	return [list $sname $cmap $wmap]
	1092	}
	1093
	1094	# ----------------------------------------------------------------------
	1095	# CONFIGURATION OPTION: -plotbackground
	1096	# ----------------------------------------------------------------------
[839]	1097	itcl::configbody Rappture::HeightmapViewer::plotbackground {
[909]	1098	foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
[822]	1099	#fix this!
[909]	1100	#_send "color background $r $g $b"
[822]	1101	}
	1102
	1103	# ----------------------------------------------------------------------
	1104	# CONFIGURATION OPTION: -plotforeground
	1105	# ----------------------------------------------------------------------
[839]	1106	itcl::configbody Rappture::HeightmapViewer::plotforeground {
[909]	1107	foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
[822]	1108	#fix this!
[909]	1109	#_send "color background $r $g $b"
[822]	1110	}
	1111
	1112	# ----------------------------------------------------------------------
	1113	# CONFIGURATION OPTION: -plotoutline
	1114	# ----------------------------------------------------------------------
[839]	1115	itcl::configbody Rappture::HeightmapViewer::plotoutline {
[1228]	1116	if {[IsConnected]} {
[921]	1117	_send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
[822]	1118	}
	1119	}
[1313]	1120
	1121
	1122
	1123	# camera --
	1124	#
	1125	itcl::body Rappture::HeightmapViewer::camera {option args} {
	1126	switch -- $option {
	1127	"show" {
	1128	puts [array get view_]
	1129	}
	1130	"set" {
	1131	set who [lindex $args 0]
	1132	set x $settings_($this-$who)
	1133	set code [catch { string is double $x } result]
	1134	if { $code != 0 \|\| !$result } {
	1135	set settings_($this-$who) $view_($who)
	1136	return
	1137	}
	1138	switch -- $who {
	1139	"pan-x" - "pan-y" {
	1140	set view_($who) $settings_($this-$who)
	1141	_PanCamera
	1142	}
	1143	"phi" - "theta" - "psi" {
	1144	set view_($who) $settings_($this-$who)
	1145	set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
	1146	_send "camera angle $xyz"
	1147	}
	1148	"zoom" {
	1149	set view_($who) $settings_($this-$who)
	1150	_send "camera zoom $view_(zoom)"
	1151	}
	1152	}
	1153	}
	1154	}
	1155	}
	1156
	1157	itcl::body Rappture::HeightmapViewer::_BuildSettingsDrawer {} {
	1158
	1159	itk_component add settings {
	1160	Rappture::Scroller $itk_component(drawer).scrl \
	1161	-xscrollmode auto -yscrollmode auto \
	1162	-width 200 -height 100
	1163	}
	1164
	1165	itk_component add settings_canvas {
	1166	canvas $itk_component(settings).canvas -highlightthickness 0
	1167	}
	1168	$itk_component(settings) contents $itk_component(settings_canvas)
	1169
	1170	itk_component add settings_frame {
	1171	frame $itk_component(settings_canvas).frame -bg white \
	1172	-highlightthickness 0
	1173	}
	1174	$itk_component(settings_canvas) create window 0 0 \
	1175	-anchor nw -window $itk_component(settings_frame)
	1176	bind $itk_component(settings_frame) <Configure> \
	1177	[itcl::code $this drawer resize settings]
	1178
	1179	set fg [option get $itk_component(hull) font Font]
	1180
	1181	set inner $itk_component(settings_frame)
	1182
	1183	foreach { key value } {
	1184	grid 1
	1185	axes 0
	1186	contourlines 1
	1187	wireframe fill
	1188	legend 1
	1189	} {
	1190	set settings_($this-$key) $value
	1191	}
	1192	set inner $itk_component(settings_frame)
	1193	label $inner.title -text "View Settings" -font "Arial 10 bold"
	1194	checkbutton $inner.grid \
	1195	-text "grid" \
	1196	-variable [itcl::scope settings_($this-grid)] \
	1197	-command [itcl::code $this _fixSettings grid] \
	1198	-font "Arial 9"
	1199	checkbutton $inner.axes \
	1200	-text "axes" \
	1201	-variable ::Rappture::HeightmapViewer::settings_($this-axes) \
	1202	-command [itcl::code $this _fixSettings axes] \
	1203	-font "Arial 9"
	1204	checkbutton $inner.contourlines \
	1205	-text "contour lines" \
	1206	-variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
	1207	-command [itcl::code $this _fixSettings contourlines]\
	1208	-font "Arial 9"
	1209	checkbutton $inner.wireframe \
	1210	-text "wireframe" \
	1211	-onvalue "wireframe" -offvalue "fill" \
	1212	-variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
	1213	-command [itcl::code $this _fixSettings wireframe]\
	1214	-font "Arial 9"
	1215	checkbutton $inner.legend \
	1216	-text "legend" \
	1217	-variable ::Rappture::HeightmapViewer::settings_($this-legend) \
	1218	-command [itcl::code $this _fixSettings legend]\
	1219	-font "Arial 9"
	1220
	1221	blt::table $inner \
	1222	0,0 $inner.title -anchor w -columnspan 2 \
	1223	1,1 $inner.grid -anchor w \
	1224	2,1 $inner.axes -anchor w \
	1225	3,1 $inner.contourlines -anchor w \
	1226	4,1 $inner.wireframe -anchor w \
	1227	5,1 $inner.legend -anchor w
	1228
	1229	blt::table configure $inner c0 -resize expand -width 2
	1230	blt::table configure $inner c2 -resize expand
	1231	blt::table configure $inner c1 -resize none
	1232
	1233	}
	1234
	1235	itcl::body Rappture::HeightmapViewer::_BuildCameraDrawer {} {
	1236
	1237	itk_component add camera {
	1238	Rappture::Scroller $itk_component(drawer).camerascrl \
	1239	-xscrollmode auto -yscrollmode auto \
	1240	-highlightthickness 0
	1241	}
	1242
	1243	itk_component add camera_canvas {
	1244	canvas $itk_component(camera).canvas -highlightthickness 0
	1245	} {
	1246	ignore -highlightthickness
	1247	}
	1248	$itk_component(camera) contents $itk_component(camera_canvas)
	1249
	1250	itk_component add camera_frame {
	1251	frame $itk_component(camera_canvas).frame \
	1252	-highlightthickness 0
	1253	}
	1254	$itk_component(camera_canvas) create window 0 0 \
	1255	-anchor nw -window $itk_component(camera_frame)
	1256	bind $itk_component(camera_frame) <Configure> \
	1257	[itcl::code $this drawer resize camera]
	1258
	1259	set inner $itk_component(camera_frame)
	1260
	1261	label $inner.title -text "Camera Settings" -font "Arial 10 bold"
	1262
	1263	set labels { phi theta psi pan-x pan-y zoom }
	1264	blt::table $inner \
	1265	0,0 $inner.title -anchor w -columnspan 4
	1266	set row 1
	1267	foreach tag $labels {
	1268	label $inner.${tag}label -text $tag -font "Arial 9"
	1269	entry $inner.${tag} -font "Arial 9" -bg white \
	1270	-textvariable [itcl::scope settings_($this-$tag)]
	1271	bind $inner.${tag} <KeyPress-Return> \
	1272	[itcl::code $this camera set ${tag}]
	1273	blt::table $inner \
	1274	$row,1 $inner.${tag}label -anchor e \
	1275	$row,2 $inner.${tag} -anchor w
	1276	incr row
	1277	}
	1278	bind $inner.title <Shift-ButtonPress> \
	1279	[itcl::code $this camera show]
	1280	blt::table configure $inner c0 -resize expand -width 4
	1281	blt::table configure $inner c1 c2 -resize none
	1282	blt::table configure $inner c3 -resize expand
	1283
	1284	}
	1285
	1286	itcl::body Rappture::HeightmapViewer::drawer { what who } {
	1287	switch -- ${what} {
	1288	"activate" {
	1289	$itk_component(drawer) add $itk_component($who) -sticky nsew
	1290	after idle [list focus $itk_component($who)]
	1291	if { ![info exists initialized_($who)] } {
	1292	set w [winfo width $itk_component(drawer)]
	1293	set x [expr $w - 120]
	1294	$itk_component(drawer) sash place 0 $x 0
	1295	set initialized_($who) 1
	1296	}
	1297	$itk_component(${who}_button) configure -relief sunken
	1298	}
	1299	"deactivate" {
	1300	$itk_component(drawer) forget $itk_component($who)
	1301	$itk_component(${who}_button) configure -relief raised
	1302	}
	1303	"toggle" {
	1304	set slaves [$itk_component(drawer) panes]
	1305	if { [lsearch $slaves $itk_component($who)] >= 0 } {
	1306	drawer deactivate $who
	1307	} else {
	1308	drawer activate $who
	1309	}
	1310	}
	1311	"resize" {
	1312	set bbox [$itk_component(${who}_canvas) bbox all]
	1313	set wid [winfo width $itk_component(${who}_frame)]
	1314	$itk_component(${who}_canvas) configure -width $wid \
	1315	-scrollregion $bbox -yscrollincrement 0.1i
	1316	}
	1317	}
	1318	}
	1319

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

Download in other formats: