c************
c  Description:	XTEXT primitive for X-Windows testual display
c
c  Author:	JG Kralles
c
c  $Revision: 1.1 $
c  $Modtime:   17 May 1996 14:39:56  $
c
c************
      PROGRAM XTEXT
      IMPLICIT NONE

      INCLUDE 'PRIMITIVE.INC'
      INCLUDE 'QMESSAGES.INC'
      INCLUDE 'XTXINCLUDE.INC'

      integer*4    PARM_SIZE		! Added jdh
      integer*4    L_BBUF		! Added jdh
      PARAMETER    (PARM_SIZE  = 1024)	! Modified jdh
      PARAMETER    (L_BBUF = 65535)	! Modified jdh
      INCLUDE 'BUFFERS.INC'

      STRUCTURE /MQ/
         UNION
            MAP
               RECORD /BUFFER/  DATA
            END MAP
            MAP
               RECORD /MQ_DATA/ MQD
            END MAP
         END UNION
      END STRUCTURE
      RECORD /MQ/ MQ

      INTEGER*4    MESSAGE
      INTEGER*4    I,J,K
      INTEGER*4    CHARS,ITEM,SIZE,ROW
      INTEGER*4    STRIP
      LOGICAL*4    DONE
      REAL*4       TIME
      CHARACTER*(PARM_SIZE) STRING
      CHARACTER*(L_BBUF) TEXT
      CHARACTER*32 NAME
C
C     Preample
C
      CALL M$CHECKIN ()
C
C     Because this primitive processes the MSGLOG messages it can never
C     send MSGLOG messages via M$INFO, M$WARNING, M$ERROR, M$MESSAGE, etc.
C
      MU.MESSAGELOG = 0

      IF (M$GET_PSWITCH('XTS')) THEN
         I = ABS(M$GET_SWITCH('XTS'))
      ELSE
         I = 9
      ENDIF
      CALL XTX$INIT (I,-44,-6,0,XTX_P_INFO,'X-Text','XTEXT','XTEXT')

      ROW = 1
      CHARS = 0
      TEXT = ' '

      I = 0
      DONE = .FALSE.
      DO WHILE (.NOT. DONE)
         I = I + 1
         STRING = M$UPICK(I)
         SIZE = M$LENGTH(STRING)
         IF (SIZE .GT. 0) THEN
            TEXT(CHARS+1:CHARS+SIZE+1) = STRING(1:SIZE) // ' '
            CHARS = CHARS + SIZE + 1
         ELSE
            DONE = .TRUE.
         ENDIF
      ENDDO

      SIZE = M$LENGTH(TEXT)
      IF (SIZE .GT. 0) THEN
         IF (M$GET_PSWITCH ('HEADER')) THEN
            CALL XTX$WRITE_HEAD (XTX_P_DEF_COLOR,TEXT(1:SIZE))
         ELSE
            CALL XTX$WRITE_TEXT (ROW,XTX_P_DEF_COLOR,TEXT(1:SIZE))
         ENDIF
      ENDIF

      IF (MU.ID .LE. 0) THEN
         TIME = 0.1
      ELSE
         TIME = MC.PAUSE
      ENDIF

      CALL XTX$XFLUSH ()

      CALL M$SYNC ()
C
C--Computation Loop:
C
      DO WHILE ((.NOT. MC.BREAK) .AND. (.NOT. MX.BREAKFLAG))

         MESSAGE = M$GET_MSG (MQH,MQ,L_BBUF,0.0,0)

         IF (MESSAGE .GT. 0) THEN
            CALL M$UPPERCASE (MQH.NAME)

            MESSAGE = XTX$MESSAGE (MQH,MQ)

            IF (MESSAGE .EQ. XTX_P_MSG_NOT_PROC) THEN

               IF (MQH.NAME .EQ. MQH_MSGLOG.NAME) THEN

                  I = M$LENGTH (MQ.MQD.MSGLOG.TEXT)
                  IF (I .GT. 0) THEN
                     TEXT(1:I) = MQ.MQD.MSGLOG.TEXT(1:I)
                     J = M$LENGTH (MQ.MQD.MSGLOG.SOURCE)
                     NAME = '[' // MQ.MQD.MSGLOG.SOURCE(1:J) // ']'
                     J = J + 2
                     K = INDEX (TEXT(1:I),NAME(1:J))
                     IF (K .LE. 0) THEN
                        K = I + J + 2
                        TEXT(I+1:K) = '  ' // NAME
                     ELSE
                        K = I
                     ENDIF
                     CALL XTX$WRITE_TEXT (0,MQ.MQD.MSGLOG.SEVERITY,
     +                                    TEXT(1:K))
                  ENDIF

               ELSEIF (MQH.NAME .EQ. MQH_EXIT.NAME) THEN
                  GOTO 9999

               ELSE
                  CALL M$WARNING ('Unrecognized message: '//MQH.NAME)
               ENDIF

            ELSEIF (MQH.NAME .EQ. MQH_EXIT.NAME) THEN
               GOTO 9999
            ENDIF

         ELSE
C
C           Placing the wait here prevents an infinite cpu loop if no
C           /ID or /XS was on the command line or if the message queue
C           is not running
C
            CALL M$PAUSE (TIME)

         ENDIF

C
C        Process Display Events
C
         DO WHILE (MX$IFEVENT() .GT. 0)

            ITEM = XTX$MX_EVENTS ()

            IF (XTX_EXIT) THEN
               GOTO 9999
            ENDIF

         ENDDO

      ENDDO

9999  CONTINUE
C
C     Postamble
C
      CALL XTX$TERM ()

      CALL M$RETURN ()
      END
