#!/usr/local/bin/wish-tp -f
#
# Copyright (C) 1993-1996 Olivetti Research Limited, Cambridge, England.
#
# THERE IS NO WARRANTY FOR THIS SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE
# LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
# OTHER PARTIES PROVIDE THIS SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND,
# EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  NO
# GUARANTEE IS MADE THAT THIS SOFTWARE IS FREE OF SOFTWARE VIRUSES.  THE ENTIRE
# RISK AS TO THE QUALITY AND PERFORMANCE OF THIS SOFTWARE IS WITH YOU.  SHOULD
# THIS SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY
# SERVICING, REPAIR OR CORRECTION.
#
# IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL
# ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE
# THIS SOFTWARE AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
# GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE
# OR INABILITY TO USE THIS SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA
# OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES
# OR A FAILURE OF THIS SOFTWARE TO OPERATE WITH ANY OTHER SYSTEMS), EVEN IF
# SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
# DAMAGES.

proc main {} {
	global tp_physical_display

	if {![info exists tp_physical_display]} {
		puts stderr "Not in a teleport session"
		exit 1
	}

	label .this_display -text "This display: $tp_physical_display"
	pack .this_display -fill x -side top

	frame .teleport_to_frame
	label .teleport_to_label -text "Teleport to:"
	entry .teleport_to_entry -width 30 -relief sunken
	bind .teleport_to_entry <Return> {
		exec teleport -display [.teleport_to_entry get]
		.teleport_to_entry delete 0 end
	}
	button .teleport_to_button -text "Go" -command {
		exec teleport -display [.teleport_to_entry get]
		.teleport_to_entry delete 0 end
	}
	pack .teleport_to_label .teleport_to_entry .teleport_to_button \
		-side left -padx 5 -pady 5 -in .teleport_to_frame
	pack .teleport_to_frame -fill x -side top

	focus .teleport_to_entry

	button .away -text "Teleport away" -command {
		exec teleport -away
	}
	pack .away -fill x -side top

	button .rematerialise -text "Rematerialise on this display" -command {
		exec teleport -rematerialise
	}
	pack .rematerialise -fill x -side top

	button .cmapPrivate -text "Install private colormap" -command {
		exec teleport -command "colormap private"
		exec teleport -rematerialise
	}
	pack .cmapPrivate -fill x -side top

	button .cmapDefault -text "Use default (shared) colormap" -command {
		exec teleport -command "colormap default"
		exec teleport -rematerialise
	}
	pack .cmapDefault -fill x -side top

	button .quit -text "Quit" -command exit
	pack .quit -fill x -side top

	trace variable tp_physical_display w materialisation
}

proc materialisation {zz1 zz2 zz3} {
	global tp_physical_display

	.this_display configure -text "This display: $tp_physical_display"

	wm geometry . {}
}

main
