1 files changed, 232 insertions, 0 deletions
diff --git a/sys/gio/gmsg.x b/sys/gio/gmsg.x
new file mode 100644
index 00000000..360996be
--- /dev/null
+++ b/sys/gio/gmsg.x
@@ -0,0 +1,232 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gio.h>
+include	<fset.h>
+include	<chars.h>
+include	<mach.h>
+
+# GMSG -- Write a string value to a UI (user interface) parameter.  Another
+# way to look at this is that we are sending a message to a UI object, hence
+# this is called a message facility.
+#
+# NOTE -- This routine quotes the string with curly braces { } and prefaces
+# the string with a "setValue", as required to set the value of a GUI client
+# state variable.  This is done here rather than build knowledge into the
+# lower level i/o system about the requirements for sending messages to UI
+# parameters.  The low level i/o system just sends arbitrary messages to
+# named UI objects; setting the value of a UI parameter object is a higher
+# level abstraction layered upon the general i/o mechanism.
+#
+# One limitation of the UI parameter mechanism as it currently stands is that
+# if the message contains curly braces, they must match up to avoid having
+# the message be prematurely delimited (fortunately curly braces tend to
+# match up in any valid text that uses them).  So far I haven't found a way
+# around this.  The problem is that while Tcl allows braces to be backslash
+# escaped to avoid being treated as delimiters, the backslashes are not
+# removed, they are left in the message as data.  Hence they cannot be
+# inserted in an arbitrary string without changing the string.
+#
+# Messages may be arbitrarily large and may extend over multiple lines.  The
+# only restriction is that if the messages contain curly braces they must
+# match up.
+
+procedure gmsg (gp, object, message)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	message[ARB]		#I message text
+
+int	flushnl, control_stream
+int	fstati()
+bool	ttygetb()
+
+begin
+	call gflush (gp)
+	call flush (STDOUT)
+	call flush (STDERR)
+
+	control_stream = STDERR
+
+	if (ttygetb (GP_TTY(gp), "EM")) {
+	    flushnl = fstati (control_stream, F_FLUSHNL)
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, NO)
+
+	    call putci (control_stream, EM)
+	    call putline (control_stream, object)
+	    call putci (control_stream, ' ')
+	    call putline (control_stream, "setValue ")
+
+	    call putci (control_stream, '{')
+	    call putline (control_stream, message)
+	    call putci (control_stream, '}')
+
+	    call putci (control_stream, GS)
+	    call putci (control_stream, US)
+	    call flush (control_stream)
+
+	    if (flushnl == YES)
+		call fseti (control_stream, F_FLUSHNL, YES)
+	}
+end
+
+
+# GMSGB -- Set the value of a boolean UI parameter.
+
+procedure gmsgb (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+bool	value			#I value
+
+begin
+	if (value)
+	    call gmsg (gp, object, "yes")
+	else
+	    call gmsg (gp, object, "no")
+end
+
+
+# GMSGC -- Set the value of a character UI parameter.
+
+procedure gmsgc (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+char	value			#I value
+
+char	buf[10]
+int	junk, ctocc()
+
+begin
+	junk = ctocc (value, buf, 10)
+	call gmsg (gp, object, buf)
+end
+
+
+# GMSGS -- Set the value of a short integer UI parameter.
+
+procedure gmsgs (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+short	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFS (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGI -- Set the value of an integer UI parameter.
+
+procedure gmsgi (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+int	value			#I value
+
+long	val
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFI (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    val = value
+	    junk = ltoc (val, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGL -- Set the value of a long integer UI parameter.
+
+procedure gmsgl (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+long	value			#I value
+
+char	buf[32]
+int	junk, ltoc()
+
+begin
+	if (IS_INDEFL (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = ltoc (value, buf, 32)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGR -- Set the value of a type real UI parameter.
+
+procedure gmsgr (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+real	value			#I value
+
+double	dval
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    dval = value
+	    junk = dtoc (dval, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGD -- Set the value of a type double UI parameter.
+
+procedure gmsgd (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+double	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, dtoc()
+
+begin
+	if (IS_INDEFR (value))
+	    call gmsg (gp, object, "INDEF")
+	else {
+	    junk = dtoc (value, buf, MAX_DIGITS, NDIGITS_DP, 'g', MAX_DIGITS)
+	    call gmsg (gp, object, buf)
+	}
+end
+
+
+# GMSGX -- Set the value of a type complex UI parameter.
+
+procedure gmsgx (gp, object, value)
+
+pointer	gp			#I graphics descriptor
+char	object[ARB]		#I object name
+complex	value			#I value
+
+char	buf[MAX_DIGITS]
+int	junk, xtoc()
+
+begin
+	junk = xtoc (value, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS/2)
+	call gmsg (gp, object, buf)
+end