#!/usr/local/bin/wish -f

# $Header: /cluster21/kennykb/src/tclTCP/RCS/bars.tcl,v 1.1 1992/02/14 20:02:23 kennykb Exp kennykb $
# $Source: /cluster21/kennykb/src/tclTCP/RCS/bars.tcl,v $
# $Log: bars.tcl,v $
# Revision 1.1  1992/02/14  20:02:23  kennykb
# Initial revision
#

#  Copyright (C) 1992 General Electric. All rights reserved.

#  Permission to use, copy, modify, and distribute this
#  software and its documentation for any purpose and without
#  fee is hereby granted, provided that the above copyright
#  notice appear in all copies and that both that copyright
#  notice and this permission notice appear in supporting
#  documentation, and that the name of General Electric not be used in
#  advertising or publicity pertaining to distribution of the
#  software without specific, written prior permission.
#  General Electric makes no representations about the suitability of
#  this software for any purpose.  It is provided "as is"
#  without express or implied warranty.

#  This work was supported by the DARPA Initiative in Concurrent
#  Engineering (DICE) through DARPA Contract MDA972-88-C-0047.

# This is a client to the master color server.  It displays a bar-chart view
# of the current color.

# Start a server so we can get updates

set s [tcp server]
$s start
set p [$s config -port]
puts stderr "bars: serving on port $p"

# Connect to the master server

set c [tcp connect localhost 2324]

# Make a procedure to send colors, unless the master server just sent them to
# us.

proc sendcolor {color value} {
	global c
	global myname
	set status [catch {tcp client} clientName]
	if {$status != 0} {
		$c send eval "	set $myname.active 1; \
				set $color $value ;  \ 
				unset $myname.active "
	}
}

# Build the display

label .text -text "Color values in the master application"

frame .bars
scale .bars.red -command "sendcolor red" \
	-orient horizontal -length 300 \
	-from 0 -to 255 -tickinterval 50 \
	-label Red -showvalue 1
scale .bars.green -command "sendcolor green" \
	-orient horizontal -length 300 \
	-from 0 -to 255 -tickinterval 50 \
	-label Green -showvalue 1
scale .bars.blue -command "sendcolor blue" \
	-orient horizontal -length 300 \
	-from 0 -to 255 -tickinterval 50 \
	-label Blue -showvalue 1
pack append .bars .bars.red {top expand fillx} \
		.bars.green {top expand fillx} \
		.bars.blue {top expand fillx}

button .quit -text "Quit" -command "destroy ."

pack append . .text {top expand fillx} \
	.bars {top expand fill} \
	.quit {top expand fillx}
puts stderr "packing complete"
update
puts stderr "update complete"

# Define a local procedure to receive a new set of colors and update the
# display

proc newcolors {red green blue} {
	.bars.red set $red
	.bars.green set $green
	.bars.blue set $blue
}

# Get a name for this application in the master server

set myname [$c send gensym bars]

# Define a procedure in the master server to update our colors

set procdef [format {
    proc %s.update args {
	global red
	global green
	global blue
	global %s.connection
	global %s.active

	# If we're trying to report back to the active client, skip.

	if {![info exists %s.active]} {
		${%s.connection} send newcolors $red $green $blue
	}
    }}	$myname \
	$myname \
	$myname \
	$myname \
	$myname]
$c send eval $procdef

# Remove traces when we exit

bind .bars <Destroy> {
	$c send trace vdelete red w $myname.update
	$c send trace vdelete green w $myname.update
	$c send trace vdelete blue w $myname.update
	$c send rename $myname.update {}
	set action "\$\{$myname.connection\} close"
	$c send eval $action
}


# Procedure to set up the traces in the master server

proc startTracing {} {
	global c
	global myname
	$c send trace variable red w $myname.update
	$c send trace variable green w $myname.update
	$c send trace variable blue w $myname.update
}

# Make the master server open a connection to us, and start tracing.

set action [format {
		set %s.connection [tcp connect localhost %d]
		puts stderr "got connection to bar"
		%s.update
		puts stderr "before send of startTracing"
		${%s.connection} send after 1000 startTracing
		puts stderr "after send of startTracing"
	} $myname $p \
	  $myname \
	  $myname \
	  $myname]
$c send after 1000 $action


