c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c   GKS utility to interpret and plot a text string given in
c   "TeX" math-mode format. This interpreter has limited, but useful,
c   TeX capability:
c
c   1) TeX capabilities available in this version:
c      a) One level of sub and/or superscript, five levels of brace
c         nesting
c      b) All upper and lower case Greek letters.
c      c) The following commands:
c         \prime, \nabla, \pm, \cdot, \geq, \leq, \partial,
c         \int, \oint, \infty, \sum, \times, \; (space)
c         \_, \^, \{, \}, \\, \AA (Angstrom), \surd, \bot
c         A backslash followed by a space generates a space character.
c      d) The following font style commands:
c         \rm (normal), \bf (bold), \it (italic)
c      e) The following font family commands (PostScript output only)
c         \Times (note: \times is a math symbol), \Courier, \Helvetica
c
c      Implementation note: You must follow the LaTeX convention of
c         always using braces to enclose super and subscripts.
c         For example, in normal TeX, you can use a^b
c         In the current implementation, you must use  a^{b}
c         This has been changed from previous versions of mathmode
c         so that random input strings that have underscores will
c         not accidentally cause subscripts.
c         
c      Implementation note:  \\ means output a backslash, not terminate
c         a line of text.
c
c   2) There is no "begin math" or "end math" delimiter. Mathmode
c      always interprets input strings in TeX math mode.
c      This was an intentional design decision. It would be trivial
c      to add begin/end math ($) delimiters. However, dollar signs
c      are often used in VAX/VMS names, and I wanted users to be able
c      input any common label string without caring about accidentally
c      entering math mode.
c
c   3) Only one line of output text is possible.
c      As such, more interesting TeX expressions, such as fractions,
c      are not supported.
c
c   4) Only a subset of TeX expressions are possible, given the
c      GKS and/or Postscript math fonts. Any TeX or LaTeX control
c      sequence that is not understood is flagged as an error.
c
c   5) Unlike TeX, spaces are NOT ignored, with the following exceptions:
c         a) all leading spaces are ignored
c         b) all trailing spaces are ignored
c         c) the first space after a control sequence (command beginning
c            with \) is ignored. This allows special characters to abut
c            other chars.
c      I feel these rules for spaces are more natural for this
c      application, where random input strings may be input.
c
c      Spaces at the beginning or end of a mathmode string may be added
c      by using the \; control sequence.
c
c   6) Only stroke precision is fully supported.
c
c      If the current text precision is character or string,
c      then mathmode will enter a "fallback" mode,
c      where all control sequences will printed verbatim,
c      minus the intial \. Sub and superscripting
c      will still occur, but the font size will remain the same.
c
c   7) Mathmode is programmed to work correctly with
c      char_path = right
c      Other char paths are flagged as an error.
c
c   8) Mathmode only supports one level of super/subscripting
c       i.e. a_{b_{c}} is not supported.
c
c   9) Mathmode does not support control sequences with arguments,
c      i.e. \sqrt{a}.
c
c   10) The current text attributes are used by mathmode:
c       CHAR_UPVEC, CHAR_WIDTH, CHAR_ALIGNMENT (both horizontal
c       and vertical), CHAR_SPACING, CHAR_PATH, TEXT_COLOR_INDEX,
c       CHAR_PRECISION
c
c   11) MATHMODE uses all five GKS vertical alignments, with slight
c       modifications in meaning for mathematics:
c
c       TOP, CAP, HALF, BASE, BOTTOM.
c       TOP    - Alignment is done to top of superscripts
c       CAP    - Alignment is done to top of normal text
c       HALF   - Alignment is done to middle of normal text
c       BASE   - Alignment is done to bottom of normal text along baseline
c       BOTTOM - Alignment is done to bottom of subscripts
c
c       Example: vertical alignment of a_b
c
c       base:                    bottom:      a
c                   a                           b
c       baseline  ----------------------------------------------
c                     b
c
c       Note: you may see some extra vertical space with TOP and
c       BOTTOM vertical alignments; this is normal for GKS.
c
c   12) Mathmode does *not* use the current text font for outputing
c       non-math text. It uses the following fonts for text and math;
c       these seem to give good esthetic appearance:
c
c         Stroke precision:
c            PostScript:
c                Text: Times Roman built-in
c                Math: Symbol font built-in
c            All other output devices:
c                Text: Hershey software font -9
c                Math: Hershey software font -10
c
c         Character/string precision:
c                Current hardware font for both text and math
c
c      You can change the default text font by calling the subroutine
c
c      mathmode_set_default_text_font(family,style)
c
c      where "family" is a character string with a valid Mathmode
c      font family name: 'Times' 'Courier' 'Helvetica'
c      and style is a character string with a valid Mathmode
c      font style name: 'rm' 'it' 'bf'
c      Note that math symbols are still done with Hershey or (PS) Symbol
c      fonts. If the family or style are invalid, then the default
c      family or style is used.
c
c      Obsolete:
c
c      You can change the default text font by calling the subroutine
c
c      mathmode_set_text_font(font_id)
c
c      where "font_id" is a valid GKS font for the workstation id
c      specified in the call to mathmode().
c      Note that math symbols are still done with Hershey or (PS) Symbol
c      fonts. Note that mathmode_set_text_font does not check to see if
c      font_id is valid.
c
c      The current font and precision are restored on subroutine exit.
c
c       NOTE WELL:
c          In a few cases, Mathmode takes advantage of characters
c       in a modified GKS stroke font (-9). The characters are:
c          1) The backarrow has been replaced by a true underscore (char 95)
c          2) The Angstrom symbol had been added (char 197)
c       If this font is not available, it will not cause an error, but the
c       correct characters will not be printed.
c
c       The modified font -9 is available from:
c
c       SUBPAC::TCAD$:[FARICELLI.PUBLIC.GKSFONTS]GKSFONT_NEG09_MOD.FNT
c       and replaces the file SYS$LIBRARY:GKSFONT_NEG09.FNT
c
c       Also, note that the Angstrom symbol for Postscript output has
c       been altered to use the ISO character value, so that it appears
c       in the same font as normal text. This requires that the user
c       define the logical GKS$ISO_ENCODE (GKSiso_encode on Unix) to any
c       non-empty value (e.g. setenv GKSiso_encode 1) for proper operation.
c       ISO encoding also allows other multi-national symbols (8bit characters)
c       to appear in Postscript output).
c
c   13) All error messages are written from the routine
c       mathmode_error(). It uses conventional FORTRAN formatted
c       writes to logical unit 6, which is normally the terminal.
c       This seems to give good results with GKS, even in mixed
c       language applications (e.g. C and FORTRAN). You may wish to
c       replace this routine with one of your own, depending on
c       your application.
c          You may also have trouble with error messages on VT300 series,
c       since GKS always keeps the terminal in REGIS mode. I haven't
c       tried this yet.
c
c======================================================================
c
c      These subroutines are highly dependent on Digital implementation
c      of GKS, especially for the fonts.
c
c      Mathmode has been tested on the following devices:
c         VT125/240/241/330/340, HP7750, PostScript, LN03+ in Tektronix mode
c         and sixel mode, UIS, Decwindows and Motif
c      Other devices should work as long as they are of workstation
c      category OUTPUT or OUTIN.
c
c      It is not possible to support GKS workstations of type
c      WISS or Metafile output, due to lack of INQ_TEXT_EXTENT
c      support. Mathmode returns an error in these cases.
c
c      FORTRAN code is written for the Digital FORTRAN compiler.
c      The most blatent violations of the ANSI-1977 standard I use are:
c         include statement
c         "implicit none"
c         long identifiers
c         records (structures) for state stack.
c         ! comment lines
c     Almost all modern compilers support these extensions, and most are
c     part of the f90 standard (structures have alternate syntax).
c
c     Original:                             John Faricelli  22-Sep-1986
c     Support for string/char precision:    John Faricelli  17-Mar-1987
c     Enforce {} usage for super/subscripts John Faricelli   3-Jul-1987
c     Support for (-1,0) up vector          John Faricelli         1989??
c     Use own logical unit number for error output   J. Faricelli 23-Jan-1992
c     Better sizing of sub/superscript in PS output  J.Faricelli  10-Aug-1993
c     Fix bug in certain wierd sub/superscript cases J.Faricelli  23-Mar-1994
c     Use Angstrom symbol in Postscript output John Faricelli  13-Jan-1997
c     Support for arbitrary up vectors         John Faricelli  12-Mar-1997
c     Support for changing text font and style John Faricelli  4-Sep-1997
c
      subroutine mathmode(ws_id, x_pos, y_pos, string, noaction, err)
      implicit none
c
c     ws_id        - (input)  GKS workstation ID
c     x_pos, y_pos - (input)  Position of string
c     string       - (input)  TeX string to be printed
c     noaction     - (input)  Logical, if .TRUE., then do not output string
c     err          - (output) Logical, .TRUE. if error occurred
c
      integer ws_id
      real x_pos,y_pos
      character*(*) string
      logical noaction, err
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c     locals
c
      integer pl_type, pl_index, pm_type, pm_index, text_index
      integer interior_style, style_index, fill_index
      integer attrib_sflgs(13)
      real    pl_width, pm_size, char_exp_fac, char_spacing
c
      integer list_bundle_indexes(4), char_align(2)
      integer err_stat, ws_cat, logical_name_len
      real char_width, extent_bv(2)
      real pat_width(2), pat_height(2), pat_ref(2)
      real x_adjust, y_adjust
      character*6 err_number
      character*132 logical_name
c
c     Initialize error reporting, disable GKS output
      mathmode_output_flag = .FALSE.
      mathmode_error_occurred = .FALSE.
c
c     First, save the current state of some text attributes:
c
      call GKS$INQ_INDIV_ATTB(err_stat, pl_type, pl_width, pl_index,
     1     pm_type, pm_size, pm_index,
     2     prev_font, prev_text_prec, char_exp_fac, char_spacing,
     3     text_index, interior_style, style_index, fill_index,
     4     attrib_sflgs)
      if( err_stat .ne. 0 ) then
         write(err_number,100) err_stat
100      format(i6)
         call mathmode_error(
     1      'Error occurred in call to GKS$INQ_INDIV_ATTB. Id = ',
     1      .FALSE., err_number)
         err = .TRUE.
         return
      endif
c
      call GKS$INQ_PRIM_ATTB(err_stat, list_bundle_indexes,
     1     mathmode_char_height, mathmode_upvec, char_width, extent_bv,
     2     mathmode_char_path, char_align,
     3     pat_width, pat_height, pat_ref)
      if( err_stat .ne. 0 ) then
         write(err_number,100) err_stat
         call mathmode_error(
     1      'Error occurred in call to GKS$INQ_PRIM_ATTB. Id = ',
     1      .FALSE., err_number)
         err = .TRUE.
         return
      endif
c
      prev_text_halign = char_align(1)
      prev_text_valign = char_align(2)
c
c     Get current workstation type
      mathmode_ws_id = ws_id
      call GKS$INQ_WS_TYPE(mathmode_ws_id, err_stat, logical_name,
     1                  mathmode_ws_type, logical_name_len)
      if( err_stat .ne. 0 ) then
         write(err_number,100) err_stat
         call mathmode_error(
     1      'Error occurred in call to GKS$INQ_WS_TYPE. Id = ',
     1      .FALSE., err_number)
         err = .TRUE.
         return
      endif
c
c     Mathmode only works on GKS workstations of type OUTPUT or OUTIN.
c     Return an error if this is not the case.
      call GKS$INQ_WS_CATEGORY(mathmode_ws_type, err_stat, ws_cat)
      if( err_stat .ne. 0 ) then
         write(err_number,100) err_stat
         call mathmode_error(
     1      'Error occurred in call to GKS$INQ_WS_CATEGORY. Id = ',
     1      .FALSE., err_number)
         err = .TRUE.
         return
      endif
      if( ws_cat .ne. GKS$K_WSCAT_OUTPUT .and.
     1    ws_cat .ne. GKS$K_WSCAT_OUTIN ) then
         call mathmode_error(
     1      'Workstation category is not OUTPUT or OUTIN', .TRUE., ' ')
         err = .TRUE.
         return
      endif
c
c     Support multiple DEC GKS Postscript types by folding all types
c     into GKS$K_POSTSCRIPT
c     Mask out any bit masks in upper word of workstation type.
c     These control paper size, landscape/portrait, etc.
      mathmode_ws_type = IAND(mathmode_ws_type,'FFFF'X)
      if( mathmode_ws_type .eq. GKS$K_POSTSCRIPT .or.
     1    mathmode_ws_type .eq. GKS$K_COLOR_POSTSCRIPT .or.
     2    mathmode_ws_type .eq. GKS$K_EPSF .or.
     3    mathmode_ws_type .eq. GKS$K_COLOR_EPSF ) then
         mathmode_ws_type = GKS$K_POSTSCRIPT
      endif
c
c     Compute proper sub/super script amount depending on
c     text orientation. This routine also checks to make sure
c     user has specified supported path/upvector
      call mathmode_setup_scripts
      err = mathmode_error_occurred
      if( mathmode_error_occurred) then
         call mathmode_restore_gks_state
         return
      endif
c
c     First call to texmode, to find equivalent length of string
c
      call texmode(string, x_pos, y_pos)
c
      err = mathmode_error_occurred
      if( noaction .or. mathmode_error_occurred) then
         call mathmode_restore_gks_state
         return
      endif
c
c     Now actually plot the string
c     Compute start of text, dependent on alignment and upvector
      call mathmode_adjust_text_start(x_pos, y_pos, x_adjust, y_adjust)
c
      mathmode_output_flag = .TRUE.  ! Disable error reports
      call texmode(string, x_adjust, y_adjust)
c
      call mathmode_restore_gks_state
c
      return
      end
c
      subroutine mathmode_set_text_font(font_id)
      implicit none
c
      include 'mathmode.cmn'
c
      integer font_id
c
c     Changes the default GKS font for text while in mathmode
c     NOTE: This is for backward compatibility. If the user changes
c           the font family or style, then the original font is lost.
c           Use:
c               mathmode_set_default_text_font(family,style)
c           in new code
c
      mathmode_user_font    = font_id
c
c     Try to guess font family and style for commonly used GKS fonts
c     Postscript fonts
      if( font_id .eq. -101 ) then
c        Times roman
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 1
      else if( font_id .eq. -103 ) then
c        Times bold
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 2
      else if( font_id .eq. -102 ) then
c        Times italic
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 3
      else if( font_id .eq. -109 ) then
c        Courier
         mathmode_default_font_family = 2
         mathmode_default_font_style  = 1
      else if( font_id .eq. -111 ) then
c        Courier bold
         mathmode_default_font_family = 2
         mathmode_default_font_style  = 2
      else if( font_id .eq. -110 ) then
c        Courier italic
         mathmode_default_font_family = 2
         mathmode_default_font_style  = 3
      else if( font_id .eq. -105 ) then
c        Helvetica
         mathmode_default_font_family = 3
         mathmode_default_font_style  = 1
      else if( font_id .eq. -107 ) then
c        Helvetica bold
         mathmode_default_font_family = 3
         mathmode_default_font_style  = 2
      else if( font_id .eq. -106 ) then
c        Helvetica italic
         mathmode_default_font_family = 3
         mathmode_default_font_style  = 3
c     Hershey stroke fonts
      else if( font_id .eq. -9 ) then
c        Hershey large complex duplex roman
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 1
      else if( font_id .eq. -15 ) then
c        Hershey large complex triplex roman
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 2
      else if( font_id .eq. -11 ) then
c        Hershey large complex duplex italic
         mathmode_default_font_family = 1
         mathmode_default_font_style  = 3
      endif
c
      return      
      end
c
      subroutine mathmode_set_lun(lun)
      implicit none
c
      include 'mathmode.cmn'
c
      integer lun
c
c     Changes the default FORTRAN logical unit number for error text
c     output while in mathmode.
c
      mathmode_lun = lun
      return      
      end
c
      subroutine mathmode_restore_gks_state
      implicit none
c
      include 'mathmode.cmn'
c
      call GKS$SET_TEXT_FONTPREC(prev_font, prev_text_prec)
      call GKS$SET_TEXT_ALIGN(prev_text_halign, prev_text_valign)
      call GKS$SET_TEXT_HEIGHT(mathmode_char_height)
      return
c
      end
c
      subroutine texmode(string, start_x, start_y)
      implicit none
c
c     string           - TeX string to be printed (input)
c     start_x, start_y - starting (x,y) world coordinates (input)
c
      character*(*) string
      real  start_x, start_y
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c    locals
c
      character*1 TAB
      parameter ( TAB = CHAR(9) )
      character*1 ch, last_char, next_char
      integer i, j, ilen, istart
      logical in_csname
c
c     Set up device dependent GKS parameters
c
      call init_texmode_device_parms
c
c     Store intial position of string
      mathmode_xpos = start_x
      mathmode_ypos = start_y
      mathmode_sup_xpos = start_x
      mathmode_sub_xpos = start_x
      mathmode_sup_ypos = start_y
      mathmode_sub_ypos = start_y
      mathmode_xo = start_x
      mathmode_yo = start_y
      do i=1,4
         mathmode_xextent(i) = start_x
         mathmode_yextent(i) = start_y
         mathmode_xform_xextent(i) = 0.0
         mathmode_xform_yextent(i) = 0.0
      end do
      mathmode_endof_text_buffer = 0
      call mathmode_normalsize
c
c     Initialize internal states (e.g. zero sub/superscript level)
      call init_math_stack
c
c     Get string length minus trailing blanks
      ilen = LEN(string)
c     Initialize j to zero, to catch the case of a zero length
c     string input.
      j = 0
      do 50 i=ilen,1,-1
         j = i
         if( string(i:i) .ne. ' ' ) goto 51
50    continue
51    ilen = j
c
c     Skip initial whitespace (blanks and tabs)
c     Initialize istart to one, because substrings always start at 1:1
      istart = 1
      do 100 i=1,ilen
         istart = i
         if( string(i:i) .ne. ' '   .and.
     1       string(i:i) .ne. TAB ) goto 150
100   continue
150   continue
c
c     Decode TeX string
      in_csname = .FALSE.
      csname_len = 0
      last_char = ' '
      do 200 i=istart,ilen
c        Decoding is dependent on ASCII sequence
         ch = string(i:i)
         if( i .ne. ilen ) then
            next_char = string(i+1:i+1)
         else
            next_char = ' '
         endif
         if ( ch .eq. BACKSLASH ) then
            call mathmode_flush_text_buffer
            if( in_csname ) then
               if( last_char .eq. BACKSLASH ) then  ! Special escape for \\
                  call mathmode_addtocs(ch)
                  call mathmode_endcs
                  in_csname = .FALSE.
               else   ! Csname ended by start of another csname
                  call mathmode_endcs
                  in_csname = .TRUE.
               endif
            else  ! Beginning of control sequence
               in_csname = .TRUE.
            endif
         else if ( ch .eq. ' ' ) then
c           First blank after cs ends cs, other blanks are passed through.
            if( in_csname ) then
               call mathmode_endcs
               in_csname = .FALSE.
               if( last_char .eq. BACKSLASH ) then  ! Special escape for \blank
               call mathmode_addto_text_buffer(ch)
               endif
            else
               call mathmode_addto_text_buffer(ch)
            endif
         else if ( (ch .ge. 'a' .and. ch .le. 'z') .or.
     1             (ch .ge. 'A' .and. ch .le. 'Z') ) then
            if( in_csname ) then
               call mathmode_addtocs(ch)
            else
               call mathmode_addto_text_buffer(ch)
            endif
         else if ( (ch .ge. '0') .and. (ch .le. '9') ) then
            if( in_csname ) then
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            call mathmode_addto_text_buffer(ch)
         else if ( ch .eq. '{' ) then
            call mathmode_flush_text_buffer
            if( last_char .eq. BACKSLASH ) then ! Escape sequence to get {
               call mathmode_addtocs(ch)
            endif
            if( in_csname ) then  ! Flush any pending cs
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            if( last_char .ne. BACKSLASH ) then ! Begin group if not an { escape
              call mathmode_begin_group
            endif
         else if ( ch .eq. '}' ) then
            call mathmode_flush_text_buffer
            if( last_char .eq. BACKSLASH ) then ! Escape sequence to get }
               call mathmode_addtocs(ch)
            endif
            if( in_csname ) then  ! Flush any pending cs
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            if( last_char .ne. BACKSLASH ) then ! End group if not an } escape
              call mathmode_end_group
            endif
         else if ( ch .eq. '^' ) then
            call mathmode_flush_text_buffer
            if( last_char .eq. BACKSLASH ) then ! Escape for ^
               call mathmode_addtocs(ch)
            endif
            if( in_csname ) then  ! Flush any pending cs
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            if( last_char .eq. '^' .or. last_char .eq. '_' ) then
c              Invalid sub/superscript. Note that silly constructs like
c              a\__b will get flagged with the error, although they are legal.
               call mathmode_error('Invalid use of super/sub script',
     1         .TRUE., ' ')
c              
            else if( last_char .ne. BACKSLASH ) then
c              If next char is {, then we have an actual superscript
c              Else, output caret
               if( next_char .eq. '{' ) then
                  call mathmode_super
               else
                  call mathmode_addto_text_buffer(ch)
               endif
            endif
         else if ( ch .eq. '_' ) then
            call mathmode_flush_text_buffer
            if( last_char .eq. BACKSLASH ) then ! Special case for \_
               call mathmode_addtocs(ch)
            endif
            if( in_csname ) then
               call mathmode_endcs  ! Flush out any pending cs
               in_csname = .FALSE.
            endif
            if( last_char .eq. '^' .or. last_char .eq. '_' ) then
               call mathmode_error('Invalid use of super/sub script',
     1         .TRUE., ' ')
            else if( last_char .ne. BACKSLASH ) then
c              If next char is {, then we have an actual superscript
c              Else, output underscore
               if( next_char .eq. '{' ) then
                  call mathmode_sub
               else
                  call mathmode_addto_text_buffer(ch)
               endif
            endif
         else if ( ch .eq. ';' ) then
            if( last_char .eq. BACKSLASH ) then ! Escape sequence to get (space)
               call mathmode_addtocs(ch)
            endif
            if( in_csname ) then  ! Flush any pending cs
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            if( last_char .ne. BACKSLASH ) then ! ; not an \;
               call mathmode_addto_text_buffer(ch)
            endif
         else
            if( in_csname ) then
               call mathmode_endcs
               in_csname = .FALSE.
            endif
            call mathmode_addto_text_buffer(ch)
         endif
         last_char = ch
200   continue
c
c     Flush out any remaining text or control sequences
      call mathmode_endcs
      call mathmode_flush_text_buffer
c
      return
      end
c
      subroutine mathmode_setup_scripts
      implicit none
c
      include 'mathmode.cmn'
      include 'gksdefs.cmn'
c
      real hypot
c
      mathmode_text_prec = prev_text_prec
c
c     Adjust script size and position depending on text precision
c
c     Note, special handling of PostScript output device
c
      if( mathmode_ws_type .eq. GKS$K_POSTSCRIPT ) then
         mathmode_script_size_factor = 0.85
         mathmode_script_pos_factor  = 0.75
      else if(mathmode_text_prec .eq. GKS$K_TEXT_PRECISION_STROKE) then
         mathmode_script_size_factor = 0.75
         mathmode_script_pos_factor  = 0.75
      else
         mathmode_script_size_factor = 1.0
         mathmode_script_pos_factor  = 0.5
      endif
c
c     Test for supported char path (RIGHT)
      if( mathmode_char_path .ne. GKS$K_TEXT_PATH_RIGHT ) then
         call mathmode_error('unsupported text path', .TRUE., ' ')
      endif
c
c     Process up vector...
      if( mathmode_upvec(1) .eq. 0.0 .and.
     1    mathmode_upvec(2) .eq. 0.0 ) then
         call mathmode_error('invalid upvec', .TRUE., ' ')
      else
         mathmode_theta = ATAN2(mathmode_upvec(1),mathmode_upvec(2))
         hypot = SQRT(mathmode_upvec(1)**2+mathmode_upvec(2)**2)
         mathmode_sin_theta = mathmode_upvec(1)/hypot
         mathmode_cos_theta = mathmode_upvec(2)/hypot
c
         mathmode_sub_deltax =  - mathmode_sin_theta*
     1      0.5*mathmode_char_height*mathmode_script_pos_factor
         mathmode_sub_deltay =  - mathmode_cos_theta*
     1      0.5*mathmode_char_height*mathmode_script_pos_factor
         mathmode_sup_deltax =  mathmode_sin_theta*
     1      mathmode_char_height*(1.0 - 0.5*mathmode_script_pos_factor)
         mathmode_sup_deltay =  mathmode_cos_theta*
     1      mathmode_char_height*(1.0 - 0.5*mathmode_script_pos_factor)
      endif
c
      return
      end
c
      subroutine mathmode_adjust_text_start(x_origin, y_origin,
     1           x_adjusted, y_adjusted)
      implicit none
c
      include 'mathmode.cmn'
      include 'gksdefs.cmn'
c
      real x_origin, y_origin, x_adjusted, y_adjusted
c
c     locals
c
      real xlen, ylen, deltax, deltay
c
c     Take care of horizontal alignment
c
      xlen = (mathmode_xextent(2) - mathmode_xextent(1))
      ylen = (mathmode_yextent(1) - mathmode_yextent(2))
      if( prev_text_halign .eq. GKS$K_TEXT_HALIGN_NORMAL .or.
     1    prev_text_halign .eq. GKS$K_TEXT_HALIGN_LEFT ) then
         x_adjusted = x_origin
         y_adjusted = y_origin
      else if( prev_text_halign .eq. GKS$K_TEXT_HALIGN_CENTER ) then
         x_adjusted = x_origin - xlen/2.0
         y_adjusted = y_origin + ylen/2.0
      else if( prev_text_halign .eq. GKS$K_TEXT_HALIGN_RIGHT ) then
         x_adjusted = x_origin - xlen
         y_adjusted = y_origin + ylen
      endif
c
c     Take care of vertical alignment
c
      if( prev_text_valign .eq. GKS$K_TEXT_VALIGN_BOTTOM ) then
         deltax = (x_origin - mathmode_xextent(1))
         deltay = (y_origin - mathmode_yextent(1))
      else if( prev_text_valign .eq. GKS$K_TEXT_VALIGN_NORMAL .or.
     1         prev_text_valign .eq. GKS$K_TEXT_VALIGN_BASE ) then
         deltax = 0.0
         deltay = 0.0
      else if( prev_text_valign .eq. GKS$K_TEXT_VALIGN_HALF ) then
         deltax = - mathmode_sin_theta*mathmode_char_height/2.0
         deltay = - mathmode_cos_theta*mathmode_char_height/2.0
      else if( prev_text_valign .eq. GKS$K_TEXT_VALIGN_CAP ) then
         deltax = - mathmode_sin_theta*mathmode_char_height
         deltay = - mathmode_cos_theta*mathmode_char_height
      else if( prev_text_valign .eq. GKS$K_TEXT_VALIGN_TOP ) then
         deltax = (x_origin - mathmode_xextent(4))
         deltay = (y_origin - mathmode_yextent(4))
      endif
      x_adjusted = x_adjusted + deltax
      y_adjusted = y_adjusted + deltay
c
      return
      end
c
      subroutine mathmode_addtocs(ch)
      implicit none
c
      character*1 ch
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c     Check to see if we would overrun storage
      if( csname_len .gt. MATHMODE_MAXCSNAME_LEN ) then
         call mathmode_error('control sequence too long', .FALSE.,
     1        csname_str(1:csname_len))
         return
      endif
c
c     Otherwise append char to control sequence name
      csname_len = csname_len + 1
      csname_str(csname_len:csname_len) = ch
c
      return
      end
c
      subroutine mathmode_endcs
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      integer id
c
c     If there is no control sequence pending, just return
      if( csname_len .eq. 0 ) return
c
c     Check for font change
      call mathmode_decode_font_style(csname_str, csname_len, id)
      if( id .ne. -1 ) then
         prev_math_state%font_style = id
         curr_math_state%font_style = id
         call mathmode_set_font(curr_math_state%font_family, id)
      else 
         call mathmode_decode_font_family(csname_str, csname_len, id)
         if( id .ne. -1 ) then
            prev_math_state%font_family = id
            curr_math_state%font_family = id
            call mathmode_set_font(id,curr_math_state%font_style)
         else
c           Decode control sequence and emit to output device
            call mathmode_plot_csname
            call mathmode_pop_state
         endif
      endif
      csname_len = 0
c
      return
      end
c
      subroutine mathmode_addto_text_buffer(ch)
      implicit none
c
      character*1 ch
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c     Check to see if we would overrun storage
      if(mathmode_endof_text_buffer .eq. MATHMODE_TEXT_BUFFER_LEN ) then
         call mathmode_flush_text_buffer
      endif
c
c     Append char to text buffer
      mathmode_endof_text_buffer = mathmode_endof_text_buffer + 1
      mathmode_text_buffer
     1   (mathmode_endof_text_buffer:mathmode_endof_text_buffer) = ch
      call mathmode_pop_state
c
      return
      end
c
      subroutine mathmode_begin_group
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      if( save_ptr .eq. MATHMODE_SAVE_MAXDEPTH ) then
         call mathmode_error('too many levels of brace nesting',
     1        .TRUE., ' ')
         return
      endif
c
c     Save current state
      call mathmode_save_state
c
      return
      end
c
      subroutine mathmode_end_group
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c
      if( save_ptr .eq. 0 ) then
         call mathmode_error('mismatched braces', .TRUE., ' ')
         return
      endif
c
c     Restore previous state
      call mathmode_restore_state
c
      return
      end
c
      subroutine mathmode_super
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      call mathmode_push_state
      curr_math_state%super_level = curr_math_state%super_level + 1
c
      if( mathmode_sup_marked ) then
         call mathmode_error('ambiguous double superscript',
     1        .TRUE., ' ')
         return
      else if ( mathmode_sub_marked ) then
c        Just did a subscript. Save position so we now how long
c        subscript extended.
         mathmode_sub_xpos = mathmode_xpos
         mathmode_sub_ypos = mathmode_ypos
c        Restore position saved when subscript began
         mathmode_xpos = mathmode_mark_xpos
         mathmode_ypos = mathmode_mark_ypos
      else
c        Just mark current position
         mathmode_mark_xpos = mathmode_xpos
         mathmode_mark_ypos = mathmode_ypos
      endif
      mathmode_sup_marked = .TRUE.
c     Make text font smaller
      call mathmode_scriptsize
c
      return
      end
c
      subroutine mathmode_sub
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      call mathmode_push_state
      curr_math_state%sub_level = curr_math_state%sub_level + 1
c
      if( mathmode_sub_marked ) then
         call mathmode_error('ambiguous double subscript', .TRUE., ' ')
         return
      else if ( mathmode_sup_marked ) then
c        Just did a superscript. Save position so we now how long
c        superscript extended.
         mathmode_sup_xpos = mathmode_xpos
         mathmode_sup_ypos = mathmode_ypos
c        Restore position saved when superscript began
         mathmode_xpos = mathmode_mark_xpos
         mathmode_ypos = mathmode_mark_ypos
      else
c        Just mark current position
         mathmode_mark_xpos = mathmode_xpos
         mathmode_mark_ypos = mathmode_ypos
      endif
      mathmode_sub_marked = .TRUE.
c     Make text font smaller
      call mathmode_scriptsize
c
      return
      end
c
      subroutine mathmode_push_state
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      prev_math_state%super_level = curr_math_state%super_level
      prev_math_state%sub_level   = curr_math_state%sub_level
      prev_math_state%font_family = curr_math_state%font_family
      prev_math_state%font_style  = curr_math_state%font_style
c
      return
      end
c
      subroutine mathmode_pop_state
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c     Check for special case of one character sub/superscript.
c     We have to flush output text buffer in this case.
      if( curr_math_state%super_level .ne. prev_math_state%super_level
     1    .or.
     1    curr_math_state%sub_level .ne. prev_math_state%sub_level) then
         call mathmode_flush_text_buffer
      endif
c
      curr_math_state%super_level = prev_math_state%super_level
      curr_math_state%sub_level   = prev_math_state%sub_level
      curr_math_state%font_family = prev_math_state%font_family
      curr_math_state%font_style  = prev_math_state%font_style
c
      return
      end
c
      subroutine mathmode_save_state
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c
      integer i
c
      if( save_ptr .gt. MATHMODE_SAVE_MAXDEPTH ) then
         call mathmode_error('Internal save state overflow',.TRUE.,' ')
         return
      endif
c
      do 10 i=save_ptr,1,-1
         saved_math_states(i+1)%super_level = 
     1         saved_math_states(i)%super_level
         saved_math_states(i+1)%sub_level = 
     1         saved_math_states(i)%sub_level
         saved_math_states(i+1)%font_style = 
     1         saved_math_states(i)%font_style
         saved_math_states(i+1)%font_family = 
     1         saved_math_states(i)%font_family
10    continue
      save_ptr = save_ptr + 1
c
c     Save previous state
      saved_math_states(1)%super_level = prev_math_state%super_level
      saved_math_states(1)%sub_level   = prev_math_state%sub_level
      saved_math_states(1)%font_family = prev_math_state%font_family
      saved_math_states(1)%font_style  = prev_math_state%font_style
c
      call mathmode_push_state
c
      return
      end
c
      subroutine mathmode_restore_state
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      integer i
c
      if( save_ptr .eq. 0 ) then
         call mathmode_error('tried to restore state when none saved',
     1        .TRUE., ' ')
         return
      endif
c
c     Restore top level state on stack to previous state
      prev_math_state%super_level =
     1                     saved_math_states(1)%super_level
      prev_math_state%sub_level =
     1                     saved_math_states(1)%sub_level
      prev_math_state%font_family     =
     1                     saved_math_states(1)%font_family
      prev_math_state%font_style      =
     1                     saved_math_states(1)%font_style
c
      do 10 i=1,save_ptr-1
         saved_math_states(i)%super_level = 
     1         saved_math_states(i+1)%super_level
         saved_math_states(i)%sub_level = 
     1         saved_math_states(i+1)%sub_level
         saved_math_states(i)%font_family  = 
     1         saved_math_states(i+1)%font_family
         saved_math_states(i)%font_style   = 
     1         saved_math_states(i+1)%font_style
10    continue
      save_ptr = save_ptr - 1
c
c     Restore current state to that saved.
      call mathmode_pop_state
c
c     Restore font
      call mathmode_set_font(curr_math_state%font_family,
     1                       curr_math_state%font_style)
c
      return
      end
c
      subroutine mathmode_plot_csname
      implicit none
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
c     locals
c
      integer id, err_stat, math_font, name_len
      integer string_len
      real concat_x, concat_y, extent_x(4), extent_y(4)
      real deltax, deltay
      character*1 ch
      character*6 err_number
      character*(MATHMODE_MAXCSNAME_LEN) name
      logical is_macro
c
      call mathmode_decode_macro(csname_str, csname_len, id, name)
      if( id .ne. -1 ) then
         is_macro = .TRUE.
         name_len = string_len(name)
      else
         is_macro = .FALSE.
         call mathmode_decode_csname(csname_str, csname_len, id)
         if( id .eq. -1 ) then ! Unknown csname
            return
         endif
      endif
c
c     Compute any sub/superscript vertical offset
c     This routine can change the current position if there
c     was both a previous super and subscript.
      call mathmode_compute_script(deltax, deltay)
c
c     debug stub
c      write(6,100) curr_math_state%sub_level,
c     1             curr_math_state%super_level,
c     2             csname_str(1:csname_len)
c100   format(' ','sub = ',i2,' sup = ',i2,' ',a)
c
      if( is_macro ) then
c        Output translated string
         call GKS$INQ_TEXT_EXTENT(mathmode_ws_id,
     1        mathmode_xpos, mathmode_ypos,
     2        name(1:name_len), err_stat, concat_x, concat_y,
     3        extent_x, extent_y)
         if( err_stat .ne. 0 ) then
            write(err_number,1000) err_stat
            call mathmode_error(
     1         'Error occurred in call to GKS$INQ_TEXT_EXTENT. Id = ',
     1         .FALSE., err_number)
            return
         endif
         call mathmode_bbox(extent_x, extent_y, deltax, deltay)
         if( mathmode_output_flag ) then
            call GKS$TEXT(mathmode_xpos + deltax,
     1                    mathmode_ypos + deltay,
     2                    name(1:name_len))
         endif
         mathmode_xpos = concat_x
         mathmode_ypos = concat_y
      else if( mathmode_text_prec .eq. GKS$K_TEXT_PRECISION_STROKE .or.
     1    mathmode_ws_type .eq. GKS$K_POSTSCRIPT ) then
c        For compatibility with GKS3D, we use STRING precision when the
c        output device is Postscript, since GKS3D wants that.
c        This is somewhat silly, since GKS and GKS3D drivers always
c        use STROKE precision.
         if( mathmode_ws_type .eq. GKS$K_POSTSCRIPT ) then
            math_font = mathchar_table(3,id)
            ch = CHAR(mathchar_table(4,id))
            call GKS$SET_TEXT_FONTPREC(math_font,
     1           GKS$K_TEXT_PRECISION_STRING)
         else
            math_font = mathchar_table(1,id)
            ch = CHAR(mathchar_table(2,id))
            call GKS$SET_TEXT_FONTPREC(math_font,
     1           GKS$K_TEXT_PRECISION_STROKE)
         endif
c
         call GKS$INQ_TEXT_EXTENT(mathmode_ws_id,
     1        mathmode_xpos, mathmode_ypos,
     2        ch, err_stat, concat_x, concat_y, extent_x, extent_y)
         if( err_stat .ne. 0 ) then
            write(err_number,1000) err_stat
1000        format(i6)
            call mathmode_error(
     1         'Error occurred in call to GKS$INQ_TEXT_EXTENT. Id = ',
     1         .FALSE., err_number)
            return
         endif
         call mathmode_bbox(extent_x, extent_y, deltax, deltay)
         if( mathmode_output_flag ) then
            call GKS$TEXT(mathmode_xpos + deltax,
     1                    mathmode_ypos + deltay, ch )
         endif
         mathmode_xpos = concat_x
         mathmode_ypos = concat_y
      else
c        Output entire control sequence string as a fallback
         call GKS$INQ_TEXT_EXTENT(mathmode_ws_id,
     1        mathmode_xpos, mathmode_ypos,
     2        csname_str(1:csname_len), err_stat, concat_x, concat_y,
     3        extent_x, extent_y)
         if( err_stat .ne. 0 ) then
            write(err_number,1000) err_stat
            call mathmode_error(
     1         'Error occurred in call to GKS$INQ_TEXT_EXTENT. Id = ',
     1         .FALSE., err_number)
            return
         endif
         call mathmode_bbox(extent_x, extent_y, deltax, deltay)
         if( mathmode_output_flag ) then
            call GKS$TEXT(mathmode_xpos + deltax,
     1                    mathmode_ypos + deltay,
     2                    csname_str(1:csname_len))
         endif
         mathmode_xpos = concat_x
         mathmode_ypos = concat_y
      endif
c
      csname_len = 0
      return
      end
c
      subroutine init_texmode_device_parms
      implicit none
c
      include 'mathmode.cmn'
      include 'gksdefs.cmn'
c
c     Work from left edge of text
      call GKS$SET_TEXT_ALIGN(GKS$K_TEXT_HALIGN_LEFT,
     1                        GKS$K_TEXT_VALIGN_BASE)
c
      return
      end
c
      subroutine init_math_stack
      implicit none
c
      include 'mathmode.cmn'
c
c     Initialize current and previous plot states
      mathmode_sub_marked = .FALSE.
      mathmode_sup_marked = .FALSE.
      curr_math_state%super_level = 0
      curr_math_state%sub_level   = 0
c     Default family == Times, style == normal
      curr_math_state%font_family = mathmode_default_font_family
      curr_math_state%font_style  = mathmode_default_font_style
c
      prev_math_state%super_level = 0
      prev_math_state%sub_level   = 0
      prev_math_state%font_family = curr_math_state%font_family
      prev_math_state%font_style  = curr_math_state%font_style
c
      call mathmode_set_font(curr_math_state%font_family,
     1                       curr_math_state%font_style)
c
c     Set user defined default font (backward compatibility before mathmode
c     could change font family/style)
      if( mathmode_user_font .ne. 0 ) then
         mathmode_text_font    = mathmode_user_font
         mathmode_ps_text_font = mathmode_user_font
      endif
c
c     Initialize saved state
      save_ptr  = 0
c
      return
      end
c
      subroutine mathmode_decode_csname(name, ilen, id)
      implicit none
c
c     Use look up table to translate control sequence name(1:ilen)
c     to internal id number. First pass does a exhaustive search;
c     would be better to sort list and uses a binary search. Some day.
c
      character*(*) name
      integer ilen, id
c
      include 'mathmode.cmn'
c
c     locals
c
      integer i
c
      id = -1
      do 100 i=1,MATHMODE_MAXCS
         if( name(1:ilen) .eq. mathmode_csname_table(i)(1:ilen) ) then
c           A match if length is equal to maximum
            if( ilen .eq. MATHMODE_MAXCSNAME_LEN ) then
               id = i
               goto 200
            endif
c           Otherwise, make sure we haven't just matched a substring
            if( mathmode_csname_table(i)(ilen+1:ilen+1) .eq. ' ' ) then
               id = i
               goto 200
            endif
         endif
100   continue
c
200   if( id .EQ. -1 ) then
         call mathmode_error('undefined control sequence:', .FALSE.,
     1        name(1:ilen))
      endif
      return
      end
c
      subroutine mathmode_decode_macro(name, ilen, id, translation)
      implicit none
c
c     If name(1:ilen) is a macro, then return its translation and
c     an internal id number.
c
c     Return -1 if macro not found.
c
      character*(*) name, translation
      integer ilen, id
c
      include 'mathmode.cmn'
c
c     locals
c
      id = -1
      if( name(1:ilen) .eq. 'date' ) then
         id = 1
         call pm_date(translation)
      else if( name(1:ilen) .eq. 'time' ) then
         id = 2
         call TIME(translation)
      else if( name(1:ilen) .eq. 'user' ) then
         id = 3
         call pm_username(translation)
      endif
c
      return
      end
c
      subroutine mathmode_decode_font_style(name, ilen, id)
      implicit none
c
c     Use look up table to translate font style(1:ilen)
c     to internal id number.
c
c     Return -1 if font name not found.
c
      character*(*) name
      integer ilen, id
c
      include 'mathmode.cmn'
c
c     locals
c
      integer i
c
      id = -1
      do 100 i=1,MATHMODE_MAXFONTSTYLES
         if( name(1:ilen) .eq. mathmode_font_style(i)(1:ilen) ) then
c           A match if length is equal to maximum
            if( ilen .eq. MATHMODE_MAXCSNAME_LEN ) then
               id = i
               goto 200
            endif
c           Otherwise, make sure we haven't just matched a substring
            if( mathmode_font_style(i)(ilen+1:ilen+1) .eq. ' ' ) then
               id = i
               goto 200
            endif
         endif
100   continue
c
200   continue
      return
      end
c
      subroutine mathmode_decode_font_family(name, ilen, id)
      implicit none
c
c     Use look up table to translate font family(1:ilen)
c     to internal id number.
c
c     Return -1 if font name not found.
c
      character*(*) name
      integer ilen, id
c
      include 'mathmode.cmn'
c
c     locals
c
      integer i
c
      id = -1
      do 100 i=1,MATHMODE_MAXFONTFAMILIES
         if( name(1:ilen) .eq. mathmode_font_family(i)(1:ilen) ) then
c           A match if length is equal to maximum
            if( ilen .eq. MATHMODE_MAXCSNAME_LEN ) then
               id = i
               goto 200
            endif
c           Otherwise, make sure we haven't just matched a substring
            if( mathmode_font_family(i)(ilen+1:ilen+1) .eq. ' ' ) then
               id = i
               goto 200
            endif
         endif
100   continue
c
200   continue
      return
      end
c
      subroutine mathmode_compute_script(deltax, deltay)
      implicit none
c
      real deltax, deltay
c
c     Assign sub/superscript offset.
c     Maintain history of previous super/sub script.
c     Set current position after both a super and subscript.
c     Algorithm only for one level of sub/super scripts.
c     There must be a better way that this. jvf
c
      include 'mathmode.cmn'
c
      real PI, PIO2
**    VAX/VMS Fortran compiler does not accept this form. jvf
**      parameter (PIO2 = ATAN2(1.0,0.0))
      parameter (PIO2 = 1.570796327)
      parameter (PI   = 2.0*PIO2)
c
      if( curr_math_state%super_level .eq. 0 .and.
     1    curr_math_state%sub_level   .eq. 0 ) then
          deltax = 0.0
          deltay = 0.0
          if( mathmode_sub_marked .and. .not. mathmode_sup_marked) then
             mathmode_sub_marked = .FALSE.
             call mathmode_normalsize
          else if(mathmode_sup_marked .and.
     1            .not. mathmode_sub_marked) then
             mathmode_sup_marked = .FALSE.
             call mathmode_normalsize
          else if(mathmode_sub_marked .and. mathmode_sup_marked) then
c            Just did both a sub and superscipt.
c            Move current position beyond either one.
             mathmode_sub_marked = .FALSE.
             mathmode_sup_marked = .FALSE.
             if( -PIO2 .le. mathmode_theta .and.
     1           mathmode_theta .le. PIO2 ) then
                mathmode_xpos = MAX(mathmode_sub_xpos,
     1                              mathmode_sup_xpos, mathmode_xpos)
             else
                mathmode_xpos = MIN(mathmode_sub_xpos,
     1                              mathmode_sup_xpos, mathmode_xpos)
             endif
             if( -PI .le. mathmode_theta .and.
     1           mathmode_theta .le. 0.0 ) then
                mathmode_ypos = MAX(mathmode_sub_ypos,
     1                              mathmode_sup_ypos, mathmode_ypos)
             else
                mathmode_ypos = MIN(mathmode_sub_ypos,
     1                              mathmode_sup_ypos, mathmode_ypos)
             endif
             call mathmode_normalsize
          endif
      else if( curr_math_state%super_level .eq. 1 .and.
     1         curr_math_state%sub_level   .eq. 0 ) then
          deltax = mathmode_sup_deltax
          deltay = mathmode_sup_deltay
      else if( curr_math_state%sub_level   .eq. 1 .and.
     1         curr_math_state%super_level .eq. 0 ) then
          deltax = mathmode_sub_deltax
          deltay = mathmode_sub_deltay
      else
         call mathmode_error('only one level sub/super script allowed',
     1        .TRUE., ' ')
      endif
c
      return
      end
c
      subroutine mathmode_scriptsize
c
c     Set current font size to that suitable for sup/super scripts
c
      include 'mathmode.cmn'
c
      call GKS$SET_TEXT_HEIGHT(mathmode_char_height * 
     1                         mathmode_script_size_factor)
      call gksqwin_scale_text_size(mathmode_script_size_factor)
      return
      end
c
      subroutine mathmode_normalsize
      implicit none
c
c     Set current font size to that suitable for normal text
c
      include 'mathmode.cmn'
c
      call GKS$SET_TEXT_HEIGHT(mathmode_char_height)
      call gksqwin_scale_text_size(1.0)
      return
      end
c
      subroutine mathmode_error(msg, short, more_info)
      implicit none
c
      include 'mathmode.cmn'
c
      character*(*) msg, more_info
      logical short
c
      if( .NOT. mathmode_output_flag ) then
        if( short ) then
            write(mathmode_lun,1000) msg
1000        format(' ','mathmode: error: ',a)
         else
            write(mathmode_lun,1001) msg, more_info
1001        format(' ','mathmode: error: ',a,' ',a)
         endif
      endif
c
      mathmode_error_occurred = .TRUE.
c
      return
      end
c
      subroutine mathmode_flush_text_buffer
      implicit none
c
c     Output current text buffer
c
      include 'gksdefs.cmn'
      include 'mathmode.cmn'
c
      real concat_x, concat_y, extent_x(4), extent_y(4)
      real deltax, deltay
      integer err_stat
      character*6 err_number
c
      if( mathmode_endof_text_buffer .eq. 0 ) return
c
c     debug stub
C      write(6,100) curr_math_state%sub_level,
C     1             curr_math_state%super_level,
C     1             curr_math_state%font_family,
C     1             curr_math_state%font_style,
C     1 mathmode_text_buffer(1:mathmode_endof_text_buffer)
C100   format(' ','sub = ',i2,' sup = ',i2,
C     1' fam = ',i2,' style = ',i2,' ',a)
c
c     Compute any sub/superscript vertical offset
c     This routine can change the current position if there
c     was both a previous super and subscript.
      call mathmode_compute_script(deltax, deltay)
c
c     If we are using a stroke font, then set current font to text font
c     For compatibility with DEC GKS3D, we use STRING precision
c     if the workstation is Postscript.
c     This is really irrelevant, since the Postscript handler
c     under GKS or GKS3D always uses STROKE precision.
c
      if( mathmode_ws_type .eq. GKS$K_POSTSCRIPT ) then
         call GKS$SET_TEXT_FONTPREC(mathmode_ps_text_font,
     1                              GKS$K_TEXT_PRECISION_STRING)
      else if( mathmode_text_prec .eq.
     1         GKS$K_TEXT_PRECISION_STROKE ) then
         call GKS$SET_TEXT_FONTPREC(mathmode_text_font,
     1                              GKS$K_TEXT_PRECISION_STROKE)
      endif
c
      call GKS$INQ_TEXT_EXTENT(mathmode_ws_id,
     1     mathmode_xpos, mathmode_ypos,
     1     mathmode_text_buffer(1:mathmode_endof_text_buffer),
     1     err_stat, concat_x, concat_y, extent_x, extent_y)
c
      if( err_stat .ne. 0 ) then
         write(err_number,1000) err_stat
1000     format(i6)
         call mathmode_error(
     1      'Error occurred in call to GKS$INQ_TEXT_EXTENT. Id = ',
     1      .FALSE., err_number)
         return
      endif
c
      call mathmode_bbox(extent_x, extent_y, deltax, deltay)
      if( mathmode_output_flag ) then
         call GKS$TEXT(mathmode_xpos + deltax,
     1        mathmode_ypos + deltay,
     1        mathmode_text_buffer(1:mathmode_endof_text_buffer))
      endif
      mathmode_xpos = concat_x
      mathmode_ypos = concat_y
c
      mathmode_endof_text_buffer = 0
c
      return
      end
c
      subroutine mathmode_bbox(x_extent, y_extent, delta_x, delta_y)
      implicit none
c
c     Compute current bounding box around entire text.
c     Extent vectors are defined ala GKS: x and y world coordinates
c     starting at lower left and moving counter-clockwise around
c     the text body.
c
      real x_extent(4), y_extent(4), delta_x, delta_y
c
      include 'mathmode.cmn'
c
c     locals
      real xform_x2, xform_y1, xform_y3, x, y, r, phi
      integer i
c
c     Transform coordinate of extents to 'normal form' (upvec(0,1))
c     with origin at (0,0) to make computing bounding box simpler.
      do i=1,3
         x = x_extent(i) + delta_x - mathmode_xo
         y = y_extent(i) + delta_y - mathmode_yo
         if( x .ne. 0.0 .or. y .ne. 0 ) then
            r = SQRT(x**2+y**2)
            phi = (ATAN2(x,y) - mathmode_theta)
            x = r*sin(phi)
            y = r*cos(phi)
         endif
         if( i .eq. 1 ) xform_y1 = y
         if( i .eq. 2 ) xform_x2 = x
         if( i .eq. 3 ) xform_y3 = y
      end do
c
c     Compute bounding box in transformed coordinates
c     Only a few coordinates need to be updated
      mathmode_xform_xextent(2) = MAX(mathmode_xform_xextent(2),
     1                                xform_x2)
      mathmode_xform_xextent(3) = mathmode_xform_xextent(2)
c
      mathmode_xform_yextent(1) = MIN(mathmode_xform_yextent(1),
     1                            xform_y1)
      mathmode_xform_yextent(2) = mathmode_xform_yextent(1)
      mathmode_xform_yextent(3) = MAX(mathmode_xform_yextent(3),
     1                            xform_y3)
      mathmode_xform_yextent(4) = mathmode_xform_yextent(3)
c
c     Transform back to rotated/translated coordinates
      do i=1,4
         if( mathmode_xform_xextent(i) .ne. 0.0 .or.
     1       mathmode_xform_yextent(i) .ne. 0.0 ) then
            r = SQRT(mathmode_xform_xextent(i)**2 +
     1               mathmode_xform_yextent(i)**2)
            phi = ATAN2(mathmode_xform_xextent(i),
     1                  mathmode_xform_yextent(i)) + mathmode_theta
            mathmode_xextent(i) = r*sin(phi) + mathmode_xo
            mathmode_yextent(i) = r*cos(phi) + mathmode_yo
         else
            mathmode_xextent(i) = mathmode_xo
            mathmode_yextent(i) = mathmode_yo
         endif
      end do
c
      return
      end
c
      subroutine mathmode_set_default_text_font(family,style)
      implicit none
c
      include 'mathmode.cmn'
c
      character*(*) family, style
c
      integer ilen, ifamily, istyle, len_blank
c
      ilen = len_blank(family)
      call mathmode_decode_font_family(family, ilen, ifamily)
      if( ifamily .ne. -1 ) then
         mathmode_default_font_family = ifamily
      endif
      ilen = len_blank(style)
      call mathmode_decode_font_style(style, ilen, istyle)
      if( istyle .ne. -1 ) then
         mathmode_default_font_style = istyle
      endif
c
      return
      end
c
      subroutine mathmode_set_font(family, style)
      implicit none
c
      include 'mathmode.cmn'
c
      integer family, style
c
c     Style  == 1,2,3 == {normal,bold,italic}
c     Family == 1,2,3 == {Times,Courier,Helvetica}
c
c     Note: styles and families must agree with names defined in
c     mathmode blockdata subroutine for mathmode_font_style() and
c     mathmode_font_family() arrays...
c
c     First, set stroke fonts
      if( style .eq. 1 ) then
         mathmode_text_font    = -9    ! Large complex duplex roman
      else if( style .eq. 2 ) then
         mathmode_text_font    = -15   ! Large complex triplex roman
      else if( style .eq. 3 ) then
         mathmode_text_font    = -11   ! Large complex duplex italic
      else
         mathmode_text_font    = MATHMODE_DEFAULT_HERSHEY_FONT
      endif
c
c     Second, set Postscript fonts
      if( family .eq. 1 ) then
         if( style .eq. 1 ) then
            mathmode_ps_text_font = -101  ! Times
         else if( style .eq. 2 ) then
            mathmode_ps_text_font = -103  ! Times bold
         else if( style. eq. 3 ) then
            mathmode_ps_text_font = -102  ! Times italic
         else
            mathmode_ps_text_font = MATHMODE_DEFAULT_PS_FONT
         endif
      else if( family .eq. 2 ) then
         if( style .eq. 1 ) then
            mathmode_ps_text_font = -109  ! Courier
         else if( style .eq. 2 ) then
            mathmode_ps_text_font = -111  ! Courier bold
         else if( style. eq. 3 ) then
            mathmode_ps_text_font = -110  ! Courier oblique
         else
            mathmode_ps_text_font = MATHMODE_DEFAULT_PS_FONT
         endif
      else if( family .eq. 3 ) then
         if( style .eq. 1 ) then
            mathmode_ps_text_font = -105  ! Helvetica
         else if( style .eq. 2 ) then
            mathmode_ps_text_font = -107  ! Helvetica bold
         else if( style. eq. 3 ) then
            mathmode_ps_text_font = -106  ! Helvetica oblique
         else
            mathmode_ps_text_font = MATHMODE_DEFAULT_PS_FONT
         endif
      else
         mathmode_ps_text_font = MATHMODE_DEFAULT_PS_FONT
      endif
c
      return
      end
c
      integer function len_blank(string)
      implicit none
c
      character*(*) string
c
c     Function returns number of characters in string, not including
c     trailing blanks. If string is completely blank, it returns 0.
c
      integer i, ilen, LEN, length
c
      ilen = LEN(string)
      length = ilen
      do 100 i=ilen,1,-1
         if( string(i:i) .ne. ' ' ) goto 200
         length = length - 1
100      continue
c
200   len_blank = length
      return
      end
c
      block data mathmode_block
      implicit none
c
      include 'mathmode.cmn'
c
c     Default text fonts
      data mathmode_text_font     / MATHMODE_DEFAULT_HERSHEY_FONT /
      data mathmode_ps_text_font  / MATHMODE_DEFAULT_PS_FONT /
c
      data mathmode_user_font           / 0 /
      data mathmode_default_font_family / 1 /
      data mathmode_default_font_style  / 1 /
c
c     Default FORTRAN logical unit number for error output
      data mathmode_lun           / MATHMODE_DEFAULT_LUN /
c
c     Setup control sequence names
c
c     NOTE WELL!! If you add control sequences, you must also
c        change the constant MATHMODE_MAXCS in mathmode.cmn
c
c     NOTE WELL: If a binary search algorithm were implemented in
c     subroutine mathmode_decode_csname, then these entries will have
c     to be placed in strict alphabetical order.
c     The mathchar_table will also have to be re-ordered. Ugh.
c
c     It would have been cleaner to use an array of structures with fields for
c     the name, font id's etc. But ya can't initialize structures in
c     block data statements. The alternate (load table on first call)
c     may still be attractive, but is messy to program.
c
      data mathmode_csname_table / 'alpha', 'beta', 'gamma', 'delta',
     1     'epsilon', 'zeta', 'eta', 'theta', 'iota', 'kappa',
     2     'lambda', 'mu', 'nu', 'xi', 'omicron', 'pi', 'rho',
     3     'sigma', 'tau', 'upsilon', 'phi', 'chi', 'psi', 'omega',
     4     'Alpha', 'Beta', 'Gamma', 'Delta',
     5     'Epsilon', 'Zeta', 'Eta', 'Theta', 'Iota', 'Kappa',
     6     'Lambda', 'Mu', 'Nu', 'Xi', 'Omicron', 'Pi', 'Rho',
     7     'Sigma', 'Tau', 'Upsilon', 'Phi', 'Chi', 'Psi', 'Omega',
     8     'prime', 'pm', 'cdot', 'geq', 'leq', 'partial',
     9     'nabla', 'int', 'oint', 'infty', 'sum', 'times',
     A     '_', '^', '{', '}', BACKSLASH, ';', 'AA', 'bot', 'surd'/
c
c     Set up math character table for csname id's
c     If you add lots more control sequences, you may exceed the compiler
c     default limit on continuations. If so, compile with /continuations=nn
c
c     Each group of four integers are codes for one symbol.
c     The first two integers in each group are the GKS font id and
c     font position for the Hershey font set (device independent).
c     The second two integers in each group are the GKS font id and
c     font position for the Postscript output device.
c
c     NOTE WELL: The GKS stroke font -9 used here has been slightly modified
c     The changes are:
c        1) Char 95 (_) has been changed from a backarrow to an true underscore
c        2) Char 197 has been changed from a capital N to an Angstrom symbol
c           (this is the correct symbol for the ASCII LATIN1 character set).
c     Using the native font -9 will not cause any error, but correct
c     symbol will not be printed out.
c                
c
      data mathchar_table
     1        / -113,  97, -113,  97,	-113,  98, -113,  98,  ! alpha, beta
     1		-113, 103, -113, 103,	-113, 100, -113, 100,  ! gamma, delta
     1		-113, 101, -113, 101,	-113, 122, -113, 122,  ! epsilon, zeta
     1		-113, 104, -113, 104,	-113, 113, -113, 113,  ! eta, theta
     1		-113, 105, -113, 105,	-113, 107, -113, 107,  ! iota, kappa
     1		-113, 108, -113, 108,	-113, 109, -113, 109,  ! lambda, mu
     1		-113, 110, -113, 110,	-113, 120, -113, 120,  ! nu, xi
     1		-113, 111, -113, 111,	-113, 112, -113, 112,  ! omicron, pi
     1		-113, 114, -113, 114,	-113, 115, -113, 115,  ! rho, sigma
     1		-113, 116, -113, 116,	-113, 117, -113, 117,  ! tau, upsilon
     1		-113, 102, -113, 102,	-113,  99, -113,  99,  ! phi, chi
     1		-113, 121, -113, 121,	-113, 119, -113, 119,  ! psi, omega
     1   	-113,  65, -113,  65,	-113,  66, -113,  66,  ! Alpha, Beta
     1		-113,  71, -113,  71,	-113,  68, -113,  68,  ! Gamma, Delta
     1		-113,  69, -113,  69,	-113,  90, -113,  90,  ! Epsilon, Zeta
     1		-113,  72, -113,  72,	-113,  81, -113,  81,  ! Eta, Theta
     1		-113,  73, -113,  73,	-113,  75, -113,  75,  ! Iota, Kappa
     1		-113,  76, -113,  76,	-113,  77, -113,  77,  ! Lambda, Mu
     1		-113,  78, -113,  78,	-113,  88, -113,  88,  ! Nu, Xi
     1		-113,  79, -113,  79,	-113,  80, -113,  80,  ! Omicron, Pi
     1		-113,  82, -113,  82,	-113,  83, -113,  83,  ! Rho, Sigma
     1		-113,  84, -113,  84,	-113,  89, -113,  89,  ! Tau, Upsilon
     1		-113,  70, -113,  70,	-113,  67, -113,  67,  ! Phi, Chi
     1		-113,  89, -113,  89,	-113,  87, -113,  87,  ! Psi, Omega
     1		-113, 162, -113, 162,	-113, 177, -113, 177,  ! prime, pm
     1		-113, 215, -113, 215,	-113, 179, -113, 179,  ! cdot, geq
     1		-113, 163, -113, 163,	-113, 182, -113, 182,  ! leq, partial
     1		-113, 209, -113, 209,	-113, 242, -113, 242,  ! nabla, int
     1		-113, 242, -113, 242,	-113, 165, -113, 165,  ! oint, infty
     1		-113, 229, -113, 229,	-113, 180, -113, 180,  ! sum, times
     1          -101,  95, -101,  95,	-101,  94, -101,  94,  ! _    ^
     1          -101, 123, -101, 123,	-101, 125, -101, 125,  ! {    }
     1          -101,  92, -101,  92,	-101,  32, -101,  32,  ! \    \; (space)
     1          -107, 197, -107, 197,   -113,  94, -113,  94,  ! AA (Angstrom)
c                                                              ! bot (perp)
     1          -113, 214, -113, 214/                          ! surd
c
c     Names of font styles
      data mathmode_font_style /'rm', 'bf', 'it'/
c
c     Names of font families
      data mathmode_font_family /'Times', 'Courier', 'Helvetica'/
c
      end
