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

# $Header: /cluster21/kennykb/src/tclTCP/RCS/entries.tcl,v 1.1 1992/02/14 20:02:54 kennykb Exp kennykb $
# $Source: /cluster21/kennykb/src/tclTCP/RCS/entries.tcl,v $
# $Log: entries.tcl,v $
# Revision 1.1  1992/02/14  20:02:54  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 dialog-box view
# of the current color.

# Do keyboard and mouse bindings for an entry box.

proc bindentry {w {command eval}} {
	bind $w <Any-KeyPress> {%W insert insert "%A"; entry.cursor %W}
	bind $w <space> {%W insert insert " "; entry.cursor %W}
	bind $w <Control-a> {%W icursor 0; %W view 0}
	bind $w <Control-b> {entry.cursorleft %W}
	bind $w <Control-d> {entry.deleteright %W}
	bind $w <Control-e> {%W icursor end; entry.cursor %W}
	bind $w <Control-f> {entry.cursorright %W}
	bind $w <Control-h> {entry.deleteleft %W}
	bind $w <Control-j> "$command \[%W get\]"
	bind $w <Control-k> {%W delete insert end; entry.cursor %W}
	bind $w <Control-l> {entry.center %W}
	bind $w <Control-m> "$command \[%W get\]"
# Anyone volunteer to write the next one?
#	bind $w <Control-t> {entry.twiddle %W}
	bind $w <Control-u> {%W delete 0 end; %W view 0}
	bind $w <Control-w> {%W delete sel.first sel.last; entry.cursor %W}
	bind $w <Control-y> {%W insert insert [selection get]; entry.cursor %W}
	bind $w <BackSpace> {entry.deleteleft %W}
	bind $w <Delete> {entry.deleteleft %W}
	bind $w <Linefeed> "$command \[%W get\]"
	bind $w <Return> "$command \[%W get\]"
    # quote, backslash, and left bracket need
    # to be handled specially.
        bind $w <quotedbl> {%W insert insert "\""; entry.cursor %W}
        bind $w <backslash> {%W insert insert "\\"; entry.cursor %W}
        bind $w <bracketleft> {%W insert insert "\["; entry.cursor %W}
    # left, right arrows move cursor
        bind $w <Left>  {entry.cursorright %W}
        bind $w <Right> {entry.cursorleft %W}
	bind $w <ButtonPress-1> {%W icursor @%x; focus %W; %W select from @%x}
	bind $w <Button1-Motion> {%W select to @%x}
	bind $w <Shift-ButtonPress-1> {%W select adjust @%x}
	bind $w <Shift-Button1-Motion> {%W select to @%x}
	bind $w <Double-Button-1> {%W select from 0; %W select to end}
	bind $w <ButtonPress-2> {%W insert insert [selection get]; entry.cursor %W}
	bind $w <Control-ButtonPress-2> {entry.rpl %W}
	bind $w <ButtonPress-3> {%W scan mark %x}
	bind $w <Button3-Motion> {%W scan dragto %x}
}

# Cursor left

proc entry.cursorleft {w} {
	set x [expr {[$w index insert] - 1}]
	if {$x >= 0} {$w icursor $x}
	entry.cursor $w
}

# Cursor right

proc entry.cursorright {w} {
	set x [expr {[$w index insert] + 1}]
	set xm [$w index end]
	if {$x <= $xm} {$w icursor $x}
	entry.cursor $w
}

# Delete left

proc entry.deleteleft {w} {
	set x [expr {[$w index insert] - 1}]
	if {$x >= 0} {$w delete $x}
	entry.cursor $w
}

# Delete character right

proc entry.deleteright {w} {
	set x [$w index insert]
	set xm [$w index end]
	if {$x < $xm} {$w delete $x}
	entry.cursor $w
}

# Center the cursor in the window

proc entry.center {win} {
	set cursor_position [$win index insert]
	$win view 0
	set left_extent [$win index @0]
	set right_extent [$win index @[winfo width $win]]
	set entry_length [expr {$right_extent - $left_extent}]
	set text_length [expr [$win index end]]
	if {$text_length > $entry_length} {
		$win view [expr {$cursor_position - $entry_length/2 + 1}]
	}
}

# Move the view in the entry box to place cursor on screen

proc entry.cursor {win} {
	set left_extent [$win index @0]
	set right_extent [$win index @[winfo width $win]]
	set cursor_position [$win index insert]
	set entry_length [expr {$right_extent - $left_extent}]
	if {$cursor_position >= $right_extent \
	 || $cursor_position <= $left_extent} {
		entry.center $win
	}
}

# Replace the entire entry with the selection

proc entry.rpl {win} {
	set a [selection get]
	$win delete 0 end
	$win insert insert $a
	entry.cursor $win
}
# Start a server so we can get updates

set s [tcp server]
$s start
set p [$s config -port]

# 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 {[regexp {^[0-9]*$} $value] && $value <= 255} {
		if {$status != 0} {
			$c send eval "	set $myname.active 1; \
					set $color $value ;  \ 
					unset $myname.active "
		}
	} else {
		puts stderr "$value is not a valid value"
	}
}

# Build the display

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

proc vline {w color Color} {
	frame $w -relief raised -borderwidth 2
	label $w.label -text "$Color: "
	entry $w.entry -relief raised
	bindentry $w.entry "sendcolor $color"
	pack append $w $w.label {left expand frame w} $w.entry {left frame e}
	bind $w <Any-Enter> "focus $w.entry"
	return $w
}

vline .red red Red
vline .green green Green
vline .blue blue Blue

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

pack append . .text {top expand fillx} \
	.red {top expand fillx} \
	.green {top expand fillx} \
	.blue {top expand fillx} \
	.quit {top expand fillx}

# Local procedure to fill in an entry

proc show1color {color value} {
	catch {.$color.entry delete 0 end}
	.$color.entry insert 0 $value
}

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

proc newcolors {red green blue} {
	show1color red $red
	show1color green $green
	show1color blue $blue
}

# Get a name for this application in the master server

set myname [$c send gensym entries]

# 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 . <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]
		%s.update
		${%s.connection} send after 10 startTracing
	} $myname $p \
	  $myname \
	  $myname \
	  $myname]
$c send after 10 $action


