c************
c  Description:	This module contains the non-XWindows graphics support routines
c		excluding the FACILITIES related routines found in glibf2.for
c
c  Author:	JGS   4//90
c		Split off from glibf.for 6/9/93
c
c  
c  RDA: 21-May-98 Fixed MX$XC - now (r,g,b) colorspec's work.  Moved '(' check
c                 prior to M$A2D call.  Also put "color(n).position = -1"
c                 AFTER the call to MX$COLORTAB
c  JDH: 05-Sep-00 Modified to support headless operation
C  JTM: 26-Jun-20 Added Duy's updates for gfc support
c************

c************
c Actual routine called by MX$SETUP passing the Mx structure.  
c MX$SETUP is a C jacket in gjackets.c that passes its global 
c pointer to the Mx structure along with the other arguments.  See HELP 
c MX$SETUP for more info.
c************

	subroutine MXF$SETUP (Mx, width, height)
c
	implicit none
	include 'types.inc'
	include 'midas.inc'
	include 'xprim.inc'
	integer*4 width,height
	integer*4 i, ln
	character*(L_max_resname) label
	character*(L_max_resname) tmp
	real*8 dval
	character*40 node	! Added DR 11244
c
c pick up correct plot node
	label = ' '
	ln = M$GET_USWITCH('XD2', label)
	if (ln.lt.0) then
	  Mx.node = Mc.plot_node
	elseif (ln.eq.0) then
	  Mx.node = Mc.plot_node2
	elseif (M$RFIND(label,Mx.node,dval).ne.'A') then
	  Mx.node = label
	endif

	i = M$LENGTH(Mx.node)
	if (BTEST(Mc.debug,3)) write(*,*) 'Plotting to node: ',Mx.node(1:i)
c
c get icon state, inverted mode flag, noexit flag and xsetup id
	Mx.icon = M$GET_SSWITCH('ICON')
	Mx.xi = M$GET_SWITCH('XI')
	Mx.xcmax = M$GET_SWITCH_DEF('XCMAX', L_color)
	Mx.noexit = M$GET_SWITCH('NOEXIT')
	if (Mc.mode.lt.0) Mx.noexit = max(Mx.noexit,1)
	Mx.xs = M$GET_SWITCH('XS')
	Mx.parent = M$GET_SWITCH('XWIN')
c+++
c DR 11244
	if (Mx.parent .gt. 0) then
	  i = Mx.parent
	  call MX$DISPLAY_ID(i,0,node)
	  if (node .ne. ' ') then
	    Mx.node = node
	  endif
	endif
c---
c
c get desired window sizes from command line and/or environment
	Mx.left = M$GET_SWITCH_DEF('XL', Mc.left)
	Mx.top = M$GET_SWITCH_DEF('XT', Mc.top)
	Mx.width = M$GET_SWITCH_DEF('XW', width)
	Mx.height = M$GET_SWITCH_DEF('XH', height)
c
c check for text size override switch
	Mx.text_size_lock = M$GET_SWITCH('XTS')
c
c check for title/name switch
	Mx.title = ' '
	ln = M$GET_USWITCH('XN',Mx.title)
c
c get command name for help file processing
	Mx.name = Mc.command_name
c	
c get the mouse tags
	call M$MTAG (Mx)
c
c get shared colormap ID
	Mx.shrcmap = max(0, M$GET_SWITCH('XCSHR'))
c
c RDA: get CDE workspaces list (didn't have uswitch in C!)
	Mx.wspace_num = -2
	Mx.wspace = CHAR(0)
	ln = M$GET_USWITCH( 'WKSP' , tmp )
	if ( ln .gt. 0 ) ln = M$CLEAN( tmp , Mx.wspace )
c
c RDA: get switches to select X-Server visual class (override defaults)
	Mx.visClass = M$GET_SWITCH_DEF('VISCLASS', Mc.visClass )
	Mx.visDepth = M$GET_SWITCH_DEF('VISDEPTH', Mc.visDepth )
	Mx.visID    = M$GET_SWITCH_DEF('VISUALID', Mc.visID )
	Mx.visDebug = M$GET_SWITCH('VISUALDEBUG')

c+++
c DR 11175
	Mx.disable_menu = 0
c---

c+++
c New jdh
c Check for headless mode
#if _HEADLESS
	if (Mu.headless .eq. 1) then
	  Mx.headless = 1
	else
	  Mx.headless = 0
	endif
#endif
c---

	Mx.font_id = 0
c--EHG--ADD (BACK) CODE: DR 15522, Initialize font width & height. 
c                   Code lost after revision 1.4.
	Mx.text_w = 0
	Mx.text_h = 0
c--
c
c If not DS, open display, find full screen size and black/white pixels.
c DATASTREAMS primitives will do this when their DSES calls MX$DOPEN.
	if (Mc.command_support .ne. 'D') then
     	    call MX$DISPLAY(Mx, Mc.break, Mc.sysunlock)
	endif  

	return
	end


	subroutine MX$DOPEN (Mx,name)
	include 'midas.inc'
	include 'xdsprim.inc'
	character*(*) name
c
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  call MX$DISPLAY (Mx,Mc.break,Mc.sysunlock)
	  call MX$OPEN (name)
#if _HEADLESS
	endif
#endif
c
	return
	end

	integer*4 function MX$WINDOW_ID (xs, op)
	include 'types.inc'
	include 'midas.inc'
	integer*4 xs, op
c locals
	real*8 dval
	integer*4 txs, wid
	character*(L_max_resname) label
	character type, sval, prefix*9

	if (xs.lt.1000) then
	  write(prefix,'(3hWId,i5.5,1h_)') mod(M_spid,10000)
	else
	  prefix = 'WID_GLOB_'
	endif

	MX$WINDOW_ID = 0
	if (xs .ge. 0) then
	  txs = xs
	  if (txs.eq.0) then
	    txs = MX$QUERY('X')
	    if (txs.le.0) return
	  endif
	  label = prefix
	  ll = M$L2A(txs,label(10:)) + 9
	endif

	if (op .eq. 1) then			! set into results table
	  if (xs.gt.0) then
	    wid = MX$QUERY('W')
	    call M$LRSLT(label(1:ll), wid)
	    if (M$RFIND(prefix//'Max',sval,dval).lt.'A') dval = 0.d0
	    call M$LRSLT(prefix//'Max', max(xs,INT(dval)))
	    MX$WINDOW_ID = wid
	  endif

	elseif (op .eq. 0) then			! extract from results table
	  if (xs .lt. 0) then
	    if (M$RFIND(prefix//'Max',sval,dval).lt.'A') then
	      MX$WINDOW_ID = 0
	    else
	      MX$WINDOW_ID = dval
	    endif
	  elseif (xs .eq. 0) then
	    MX$WINDOW_ID = MX$QUERY('W')
	  elseif (M$RGET(label(1:ll),type,wid,4).gt.0) then
	    MX$WINDOW_ID = wid
	  endif

	elseif (op .eq. -1) then		! remove from results table
	  if (xs.lt.0) then
	    MX$WINDOW_ID = M$RDEL(prefix//'*')
	  else
	    MX$WINDOW_ID = M$RDEL(label(1:ll))
	  endif

	endif

	return
	end

c+++
c DR 11244
	subroutine MX$DISPLAY_ID (xs, op, node)
	include 'types.inc'
	include 'midas.inc'

	character*(*) node
	integer*4 xs, op
c locals
	integer*4 ds, ll
	character*(L_max_resname) label
	character type, prefix*9

	if (xs.lt.1000) then
	  write(prefix,'(3hDId,i5.5,1h_)') mod(M_spid,10000)
	else
	  prefix = 'DID_GLOB_'
	endif

	label = prefix
	ll = M$L2A(xs,label(10:)) + 9

	if (op .eq. 1) then			! set into results table
	  if (xs.gt.0) then
	    call M$ARSLT(label(1:ll), node)
	  endif

	elseif (op .eq. 0) then			! extract from results table
	  node = ' '
	  if (xs .gt. 0) then
	    ll = len(node)
	    ds = M$RGET(label(1:ll),type,%ref(node),ll)
	  endif

	elseif (op .eq. -1) then		! remove from results table
	  if (xs.lt.0) then
	    ds = M$RDEL(prefix//'*')
	  else
	    ds = M$RDEL(label(1:ll))
	  endif

	endif

	return
	end
c---

c	integer*4
	function MX$COLORMAP_ID (Mx, cmap, ncolors)
	implicit none
	include 'types.inc'
	include 'midas.inc'
	include 'xprim.inc'
	include 'resmasks.inc'
c arguments
	record /COLORTYPE/ cmap
	integer*4 ncolors
c locals
	integer*4 ll, shrcmap, i, attr
	character*(L_max_resname) label
	character type, sval, prefix*11

	MX$COLORMAP_ID = 0

	write(prefix,'(5hXCShr,i5.5,1h_)') mod(M_spid,10000)
	shrcmap = abs(Mx.shrcmap)
	label = prefix
	ll = M$L2A(shrcmap, label(12:)) + 11
        
	if (ncolors .gt. 0) then		! set into results table
	  attr = RA_READONLY + RA_OVERRIDE
	  i = M$PUT_RESULT(label(1:ll)//'_MAP', cmap, 56, 0, 'I', attr)
	  MX$COLORMAP_ID = M$PUT_RESULT(label(1:ll), Mx.pixel, ncolors*4,
     +					0, 'L', attr) !RDA: pixel is 'L'
          if (MX$COLORMAP_ID .gt. 0) MX$COLORMAP_ID = MX$COLORMAP_ID/4
	elseif (ncolors .eq. 0) then		! extract from results table
	  i = M$GET_RESULT(label(1:ll)//'_MAP', cmap, 56, 0, type, attr)
	  MX$COLORMAP_ID = M$GET_RESULT(label(1:ll), Mx.pixel, L_color*4,
     +					0, type, attr) !RDA: pixel is 'L'
          if (MX$COLORMAP_ID .gt. 0) MX$COLORMAP_ID = MX$COLORMAP_ID/4
	else					! remove from results table
	  i = M$DEL_RESULT(label(1:ll)//'_MAP', RA_OVERRIDE)
	  MX$COLORMAP_ID = M$DEL_RESULT(label(1:ll), RA_OVERRIDE)
	endif

	return
	end

	function MX$HARDCOPY_OPEN(filename, flags)

	implicit none

	include 'headers.inc'
	include 'types.inc'
	include 'xtypes.inc'

c Arguments
	character*(*)	filename
	integer*4	flags
c Locals

	character*(L_max_ascii) s, s2
	character		ch
	integer*4	stat, item, item2, MX$HARDCOPY_CLOSE_
	integer*4	interact
	integer*4	i, j, k, ls, lfilename

	save
	record /HEADER/	HCB

	call M$INITIALIZE (HCB)
	HCB.file_name = filename

	interact = 0
	if (flags .lt. 0) then
	  item = MX$MENU(2, '~HARDCOPY;PostScript...,Cancel')
	  if (item .eq. 2) then
	    MX$HARDCOPY_OPEN = .FALSE.
	    return
	  else
	    item2 = MX$MENU(1, 'Use Defaults?;Yes,No')
	    if (item2 .eq. 2) then
	      call MX$PROMPT('Name of file? ', HCB.file_name)
	      if (M$LENGTH(HCB.file_name).eq.0) then
		MX$HARDCOPY_OPEN = .FALSE.
		return
	      endif
	      interact = 1
	    endif
	  endif
	endif

	HCB.extension = 'PS'

	call M$EXISTENCE(HCB, 2)

	call MX$PSOPEN(HCB.file_name, stat, s, interact)

	if (LEN(filename).gt.1) filename = HCB.file_name  ! send back expanded

	if (stat .eq. 1) then
	  ls = M$LENGTH(s)
	  if (flags.lt.0) call MX$MESSAGE(s(1:ls), -1.0)
	  if (flags.gt.0) call M$WARNING(s(1:ls))
	endif  

	MX$HARDCOPY_OPEN = (stat .eq. 0)

	return

	entry MX$HARDCOPY_CLOSE_ ()

	MX$HARDCOPY_CLOSE_ = 1
	call MX$PSCLOSE ()

	lfilename = M$LENGTH(HCB.file_name)
	ls = M$IMPORT('XM_HCPRINTCMD', s)
	if (ls .le. 0) return

	j = 0
	s2 = ' '
	do i = 1, ls
	  ch = s(i:i)
	  if (ch .eq. '#') then
	    if (s(i+1:i+1).ne.'#') then
	      if (s(i-1:i-1) .eq. '#') then
		j = j + 1
		s2(j:j) = '#'
	      else
		s2(j+1:) = HCB.file_name
		j = j + lfilename
	      endif
	    endif
	  else
	    j = j + 1
	    s2(j:j) = ch
	  endif
	enddo

	call M$SYSTEM(s2, 1, 1)

	return
	end

	subroutine MX$HARDCOPY_CLOSE ()
	integer*4 i, MX$HARDCOPY_CLOSE_
	i = MX$HARDCOPY_CLOSE_ ()
	return
	end


	subroutine MX$TICS (dmin, dmax, dtic1, dtic, ndiv)
c
	real*8 dmin,dmax,dtic1,dtic,dran,df,ddf,sig,nseg
	integer*4 ndiv,nsig
c
c handle degenerate case
	dtic = 1.
	dtic1 = dmin
	if (dmax .eq. dmin) return
c
c split up range into about ndiv 'nice' chunks
c   zero is included only if   dmin < zero < dmax
	dran = dabs(dmax-dmin)
	df = dran/ndiv
	sig = dlog10( max(df,1.d-36) )
	nsig = sig
	if (sig .lt. 0.d0) nsig = nsig - 1
	ddf = df*(10.**(-nsig))
	sig = 10.d0**nsig
	if (ddf .lt. 1.75) then
	 dtic = sig
	else if (ddf .lt. 2.25) then
	 dtic = 2.d0*sig
	else if (ddf .lt. 3.5) then
	 dtic = 2.5d0*sig
	else if (ddf .lt. 7.0) then
	 dtic = 5.d0*sig
	else
	 dtic = 10.d0*sig
	endif
c
c redefine dmin and dmax to line up on 'nice' boundaries
	if (dtic .eq. 0.d0) dtic = 1.d0
	if (dmax .ge. dmin) then
	  if (dmin .ge. 0.d0) then
	    nseg = DINT(dmin/dtic + .995)
	  else
	    nseg = DINT(dmin/dtic - .005)
	  endif
	  dtic1 = nseg*dtic
	else
	  if (dmin .ge. 0.d0) then
	    nseg = DINT(dmin/dtic + .005)
	  else
	    nseg = DINT(dmin/dtic - .995)
	  endif
	  dtic1 = nseg*dtic
	  dtic = -dtic
	endif
	if (dtic1+dtic .eq. dtic1) dtic = dmax - dmin	! <<< 12/15/92
c
	return
	end


	subroutine MX$TTICS (dmin, dmax, dtic1, dtic, ndiv)
c
	real*8 dmin,dmax,dtic1,dtic,dran,df,dft,ddf,sig,nseg,dscl
	integer*4 ndiv,nsig
c
c handle degenerate case
	dtic = 1.
	dtic1 = dmin
	if (dmax .eq. dmin) return
c
c split up range into about ndiv 'nice' chunks
c   zero is included only if   dmin < zero < dmax
	dran = dabs(dmax-dmin)
	df = dran/ndiv
	sig = dlog10( max(df,1.d-36) )
	nsig = sig
	if (sig .lt. 0.d0) nsig = nsig - 1
	ddf = df*(10.**(-nsig))
	sig = 10.d0**nsig
	dft = ddf*sig
	if (dft.ge.5.d0 .and. dft.le.(59.5d0*3600*24)) then
	  if (dft.lt.17.5d0) then
	    dscl = 5.d0			! < 17 1/2 secs align to 5 sec tics
	  elseif (dft.lt.37.5d0) then
	    dscl = 15.d0		! < 37 1/2 secs align to 15 sec tics
	  elseif (dft.lt.(4.5d0*60)) then
	    dscl = 60.d0		! < 4 1/2 min align to 1 minute tics
	  elseif (dft.lt.(17.5d0*60)) then
	    dscl = 5.d0*60		! < 17 1/2 min align to 5 min tics
	  elseif (dft.lt.(37.5d0*60)) then
	    dscl = 15.d0*60		! < 37 1/2 min align to 15 min tics
	  elseif (dft.lt.(2.0d0*3600)) then
	    dscl = 1.d0*3600		! < 2 hrs align to 1 hour tics
	  elseif (dft.lt.(4.5d0*3600)) then
	    dscl = 3.d0*3600		! < 4 1/2 hrs align to 3 hour tics
	  elseif (dft.lt.(9.0d0*3600))	then
	    dscl = 6.d0*3600		! < 9 hrs align to 6 hour tics
	  elseif (dft.lt.(1.5d0*3600*24)) then
	    dscl = 12.d0*3600		! < 1 1/2 days align to 12 hour tics
	  elseif (dft.lt.(6.0d0*3600*24)) then
	    dscl = 1.d0*3600*24		! < 6 days align to 1 day tics
	  else
	    dscl = 1.d0*3600*24*7	! < 8 1/2 weeks align to 1 week tics
	  endif
	  dtic = DNINT(dft/dscl) * dscl
	elseif (ddf .lt. 1.75) then
	 dtic = sig	
	else if (ddf .lt. 2.25) then
	 dtic = 2.d0*sig
	else if (ddf .lt. 3.5) then
	 dtic = 2.5d0*sig
	else if (ddf .lt. 7.0) then
	 dtic = 5.d0*sig
	else
	 dtic = 10.d0*sig
	endif
c
c redefine dmin and dmax to line up on 'nice' boundaries
	if (dtic .eq. 0.d0) dtic = 1.d0
	if (dmax .ge. dmin) then
	  if (dmin .ge. 0.d0) then
	    nseg = DINT(dmin/dtic + .995)
	  else
	    nseg = DINT(dmin/dtic - .005)
	  endif
	  dtic1 = nseg*dtic
	else
	  if (dmin .ge. 0.d0) then
	    nseg = DINT(dmin/dtic + .005)
	  else
	    nseg = DINT(dmin/dtic - .995)
	  endif
	  dtic1 = nseg*dtic
	  dtic = -dtic
	endif
	if (dtic1+dtic .eq. dtic1) dtic = dmax - dmin	! <<< 12/15/92
c
	return
	end

	subroutine MX$MULT (end1,end2,xmult)
c
	real*8 end1,end2,xmult,absmax
c
c get the multiplier to keep range in scientific notation range
	ABSMAX = MAX (ABS(end1), ABS(end2))
	if (ABSMAX .EQ. 0.d0) then
	  XMULT = 1.0d0
	  return
	endif
	KENGR = INT (.1447648 * LOG(ABSMAX))
	IF (ABSMAX .LT. 1.d0) KENGR = KENGR - 1
	if (KENGR .lt. 0) then
	  XMULT = 1.0d0 / (10.d0 ** (-3*KENGR))
	else
	  XMULT = 10.d0 ** (3*KENGR)
	endif
c
	return
	end



	subroutine MX$LABEL (units,mult,label)
c
	include 'types.inc'
	integer*4 units
	real*8 mult
	character*(*) label
c
c get the plot label associated with the given units and multiplier
	label = M$UNITS_NAME(units)
	if (mult.eq. 1.0) return
c
	ll = LEN (label)
	i = M$SEARCH(label,'(')
	if (i.eq.0) then
	  i = M$LENGTH(label) + 2
	  if (i+2.le.ll) label(i:i+2) = '(U)'
	endif
	i = i+1
	if (i.gt.ll) return
	do n = M$LENGTH(label),i, -1
	  label(n+1:n+1) = label(n:n)
	end do
	if (mult.eq.1.d3) then
	  label(i:i) = 'K'
	else if (mult.eq.1.d-3) then
	  label(i:i) = 'm'
	else if (mult.eq.1.d6) then
	  label(i:i) = 'M'
	else if (mult.eq.1.d-6) then
	  label(i:i) = 'u'
	else if (mult.eq.1.d9) then
	  label(i:i) = 'G'
	else if (mult.eq.1.d-9) then
	  label(i:i) = 'n'
	else if (mult.eq.1.d12) then
	  label(i:i) = 'T'
	else if (mult.eq.1.d-12) then
	  label(i:i) = 'p'
	else
	  label(i:i) = '?'
	endif
c
	return
	end



	subroutine MX$LPROMPT (string,lval)
c
	include 'midas.inc'
	character*(*) string
	character*32  answer
	integer*4     lval
	real*8	      dval
	integer*4     junk
c
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  junk = M$L2A (lval,answer)
  1	  call MX$PROMPT (string,answer)
	  na = M$CLEAN(answer,answer(1:14))
	  if (.not. Mc.break .and. M$A2D(answer(1:na-1),dval).lt.0) then
 	    call MX$MESSAGE ('Unconvertable input string - RETRY',1.0)
	    answer(na:) = ' '
	    goto 1
	  endif
	  lval = NINT(dval)
#if _HEADLESS
	endif
#endif
	return
	end



	subroutine MX$FPROMPT (string,fval)
c
	include 'midas.inc'
	character*(*) string
	character*32  answer
	real*4	      fval
	real*8        dval
	integer*4     junk
c
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  junk = M$F2A (fval,answer)
  1	  call MX$PROMPT (string,answer(1:14))
	  na = M$CLEAN(answer,answer)
	  if (.not. Mc.break .and. M$A2D(answer(1:na-1),dval).lt.0) then
 	    call MX$MESSAGE ('Unconvertable input string - RETRY',1.0)
	    answer(na:) = ' '
	    goto 1
	  endif
	  fval = dval
#if _HEADLESS
	endif
#endif
	return
	end


	subroutine MX$DPROMPT (string,dval)
c
	include 'midas.inc'
	character*(*) string
	character*32  answer
	real*8        dval
	integer*4     junk
c
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  junk = M$D2A (dval,answer)
  1	  call MX$PROMPT (string,answer(1:30))
	  na = M$CLEAN(answer,answer)
	  if (.not. Mc.break .and. M$A2D(answer(1:na-1),dval).lt.0) then
 	    call MX$MESSAGE ('Unconvertable input string - RETRY',1.0)
	    answer(na:) = ' '
	    goto 1
	  endif
#if _HEADLESS
	endif
#endif
	return
	end

	subroutine MX$ORIGIN (inorigin, outorigin, instk, outstk)
	implicit none
	include 'xstructures.inc'

	record /STKSTRUCT/ instk, outstk
	integer*4 inorigin, outorigin
	integer*4 diff, sum, in, out
	real*8 temp

	call M$MOVE (instk, outstk, L_xstack)

	in  = max (1, inorigin)
	out = max (1, outorigin)
	if (in .ne. out) then
	  diff = abs (out - in)  ! used to simplify boolean logic
	  sum = out + in
	  if (diff.eq.2 .or. sum.ne.5) then  ! (1<->3) (2<->4) (1<->2) (3<->4)
	    outstk.xmin = instk.xmax
	    outstk.xmax = instk.xmin
	    outstk.xscl = -instk.xscl
	  endif
	  if (diff.eq.2 .or. sum.eq.5) then  ! (1<->3) (2<->4) (1<->4) (2<->3)
	    outstk.ymin = instk.ymax
	    outstk.ymax = instk.ymin
	    outstk.yscl = -instk.yscl
	  endif
	endif
	return
	end

c************
c Actual routine called by MX$PLOT passing the Mx structure.  
c MX$PLOT is a C jacket in gjackets.c that passes its global 
c pointer to the Mx structure along with the other arguments.  See HELP 
c MX$PLOT for more info.
c************

	subroutine MXF$PLOT (Mx, ic, x, y, npts, skip, line, dot, pix)
	implicit none
	include 'xprim.inc'
c Arguments
	real*8 x(*), y(*)
	integer*4 ic, npts, line, dot, skip, rad, symb
	record /PIXSTRUCT/ pix(*)

#if _HEADLESS
	if (Mx.headless .eq. 0) then
#endif
	  if (dot.eq.0) then
	    symb = 0
	    rad = 0
	  elseif (dot.gt.0) then
	    symb = L_CircleSymbol
	    rad = -dot
	  else
	    symb = L_SquareSymbol
	    rad = dot
	  endif

	  if (ic.ge.-2) then
	    call MXF$TRACE(Mx, ic, x, y, npts, skip, line, symb, rad, pix, 0)
	  else
	    if (dot.eq.0) symb = L_PixelSymbol
	    if (ic.eq.-3) then
	      call MXF$TRACE(Mx,L_XORColor,x,y,npts,skip,line,symb,rad,pix,2)
	    elseif (ic.eq.-4) then
	      call MXF$TRACE(Mx,L_XORColor,x,y,npts,skip,line,symb,rad,pix,4)
	    endif
	  endif
#if _HEADLESS
	endif
#endif

	return
	end


	subroutine MXF$TRACE (Mx, ic, xpoint, ypoint, npts,
     &			skip, line, symb, rad, pix, options)
c
	implicit none
	include 'xprim.inc'

c Arguments
	real*8 xpoint(*), ypoint(*)
	integer*4 ic, npts, line, options, skip, symb, rad
	record /PIXSTRUCT/ pix(*)

c Locals
	real*8 x, y, tE, tL, dx, dy, lx, ly
	real*8 xmin, ymin, xmax, ymax, xxmin, yymin, xscl, yscl
	integer*4 i, left, top, n, ib, origin
	logical*4 lvisible, visible, CLIPT, xor
	record /STKSTRUCT/ stk4

c Code

#if _HEADLESS
	if (Mx.headless .eq. 0) then
#endif
	  if (npts.le.0) return
	  if (line.eq.0 .and. symb.eq.0) return

	  call MX$ORIGIN (Mx.origin, 4, Mx.stk(Mx.level), stk4)

	  if (stk4.xscl.eq.0.d0 .or. stk4.yscl.eq.0.d0) then
	    call M$WARNING ('Illegal scaling value(s) found in MX$PLOT.')
	    return
	  endif

	  left = stk4.x1
	  top  = stk4.y1

	  xxmin = stk4.xmin
	  xscl = 1.d0 / stk4.xscl

	  yymin = stk4.ymin
	  yscl = 1.d0 / stk4.yscl

	  xor = (ic .eq. L_XORColor)

	  if (IAND(options,1).ne.0) then
	    ! no clipping
	  elseif (xor) then
	    call MX$RCLIP (left,top,stk4.x2-left+1,stk4.y2-top+1)
	  else
	    call MX$CLIP (left,top,stk4.x2-left+1,stk4.y2-top+1)
	  endif

	  dx = dabs (stk4.xmax - stk4.xmin)
	  dy = dabs (stk4.ymax - stk4.ymin)
	  xmin = min (stk4.xmin, stk4.xmax)
	  ymin = min (stk4.ymin, stk4.ymax)
	  xmax = xmin + dx
	  ymax = ymin + dy
	  dx = dx * 0.5d0
	  if (line.eq.-1 .or. line.eq.1) then
	    dy = dy * 10.d0
	  else
	    dy = dy * 0.5d0
	  endif
	  xmin = xmin - dx
	  ymin = ymin - dy
	  xmax = xmax + dx
	  ymax = ymax + dy

	  ib = 0
	  if (.not.xor .and. line.ne.0) call MX$DRAW_MODE(line)

c
c Draw Symbols only
c
	  if (line.eq.0) then
	    do n = 1, (npts-1)*skip+1, skip
	      x = xpoint(n)
	      y = ypoint(n)
	      if (x.ge.xmin.and.x.le.xmax.and.y.ge.ymin.and.y.le.ymax) then
	        ib = ib + 1
	        pix(ib).x = NINT((x - xxmin)*xscl) + left
	        pix(ib).y = NINT((y - yymin)*yscl) + top
	      endif
	    enddo
	    if (ib.gt.0) call MX$DRAW_SYMBOLS(ic, pix, ib, symb, rad)

c
c Draw vertical lines and symbols if indicated
c
	  elseif (IAND(options,2).ne.0) then
	    do n = 1, (npts-1)*skip+1, skip
	      x = xpoint(n)
	      y = ypoint(n)
	      if (x.ge.xmin.and.x.le.xmax) then
	        i = NINT((x - xxmin)*xscl) + left
	        call MX$DRAW_LINE(ic, i, 0, i, Mx.height)
	        if (y.ge.ymin.and.y.le.ymax) then
		  ib = ib + 1
		  pix(ib).x = i
		  pix(ib).y = NINT((y - yymin)*yscl) + top
	        endif
	      endif
	    enddo
	    if (ib.gt.0 .and. symb.ne.0)
     &	      call MX$DRAW_SYMBOLS(ic, pix, ib, symb, rad)

c
c Draw horizontal lines and symbols if indicated only
c
	  elseif (IAND(options,4).ne.0) then
	    do n = 1, (npts-1)*skip+1, skip
	      x = xpoint(n)
	      y = ypoint(n)
	      if (y.ge.ymin.and.y.le.ymax) then
	        i = NINT((y - yymin)*yscl) + top
	        call MX$DRAW_LINE(ic, 0, i, Mx.width, i)
	        if (x.ge.xmin.and.x.le.xmax) then
		  ib = ib + 1
		  pix(ib).x = NINT((x - xxmin)*xscl) + left
		  pix(ib).y = i
	        endif
	      endif
	    enddo
	    if (ib.gt.0 .and. symb.ne.0)
     &	      call MX$DRAW_SYMBOLS(ic, pix, ib, symb, rad)


	  else
c
c Draw connecting lines and symbols if indicated
c

c Prime the pump
	    x = xpoint(1)
	    y = ypoint(1)
	    lvisible = (x.ge.xmin.and.x.le.xmax.and.y.ge.ymin.and.y.le.ymax)
	    if (lvisible) then
	      pix(1).x = NINT((x - xxmin)*xscl) + left
	      pix(1).y = NINT((y - yymin)*yscl) + top
	      ib = 1	! start point is first point
	      if (symb.ne.0) call MX$DRAW_SYMBOLS(ic, pix, 1, symb, rad)
	    else
	      ib = 0	! no start point yet
	    endif

	    do n = 1+skip, 1+skip*(npts-1), skip

	      lx = x
	      ly = y
	      x = xpoint(n)
	      y = ypoint(n)
	      visible = (x.ge.xmin.and.x.le.xmax.and.y.ge.ymin.and.y.le.ymax)

	      if (lvisible .and. visible) then		! no clipping needed
	        ib = ib + 1
	        pix(ib).x = NINT((x - xxmin)*xscl) + left 
	        pix(ib).y = NINT((y - yymin)*yscl) + top
	      else					! clipping needed
	        lvisible = visible
	        dx = lx - x
	        dy = ly - y
	        if (dx.ne.0.d0 .or. dy.ne.0.d0) then
		  tL = 0.d0	! fraction from end of line where it leaves
		  tE = 1.d0	! fraction from end of line where it enters
		  if (CLIPT( dx, xmin-x, tL, tE)) then  ! inside xmin edge
		    if (CLIPT(-dx, x-xmax, tL, tE)) then  ! inside xmax edge
		      if (CLIPT( dy, ymin-y, tL, tE)) then  ! inside ymin edge
		        if (CLIPT(-dy, y-ymax, tL, tE)) then  ! inside ymax edge
			  if (tE.lt.1.d0) then	! new entry point
			    ib = 1
			    pix(1).x = NINT((x - xxmin + tE*dx)*xscl) + left
			    pix(1).y = NINT((y - yymin + tE*dy)*yscl) + top
			  endif
			  ib = ib + 1
			  if (tL.gt.0.d0) then	! new exit point, draw lines
			    pix(ib).x = NINT((x - xxmin + tL*dx)*xscl) + left 
			    pix(ib).y = NINT((y - yymin + tL*dy)*yscl) + top
			    call MX$DRAW_LINES (ic, pix, ib)
			    if (symb.ne.0 .and. ib.gt.2) 
     &			      call MX$DRAW_SYMBOLS(ic, pix(2), ib-2, symb, rad)
			    ib = 0
			  else			! new entry point set, continue
			    pix(ib).x = NINT((x - xxmin)*xscl) + left
			    pix(ib).y = NINT((y - yymin)*yscl) + top
			  endif
		        endif
		      endif
		    endif
		  endif
	        endif

	      endif	! Line must be clipped

	    enddo
	    if (ib.gt.0) then
	      call MX$DRAW_LINES (ic, pix, ib)
	      if (visible) ib = ib + 1
	      if (symb.ne.0 .and. ib.gt.2)
     &		  call MX$DRAW_SYMBOLS(ic, pix(2), ib-2, symb, rad)
	    endif
	  endif

	  if (IAND(options,1).ne.0) then
	    ! no clipping
	  elseif (xor) then
	    call MX$RCLIP (0,0,0,0)
	  else
	    call MX$CLIP  (0,0,0,0)
	  endif
#if _HEADLESS
	endif
#endif
c
	return
	end


c**************************************************************************
c
c  ~Function CLIPT (denom, num, tE, tL)
c
c  real*8     denom   Negative dot product or Normal to edge and line segment
c  real*8     num     Dot prdct of Norml to edge and vctr from pt on edge to P0
c  real*8     tE      Fraction of line where line enters region
c  real*8     tL      Fraction of linew where line leaves region
c  logical*4  CLIPT   TRUE: part of the line is in the clipping region
c
c  This function computes a new value of tE or tL for an interior 
c  intersection of a line segment and an edge.  It is called exclusively
c  by MXF$PLOT as part of its clipping algorithm.  It must be called
c  4 times, once for each edge.  At each call it trims (if needed) the
c  values of <tE> and <tL> which determine the fractional part of the line
c  still within the clipping region after each clip.  Parameters <denom> 
c  and <num> are the dot products illustrated by the following geometric 
c  construction:
c
c                           +---------------------------------------------
c                           |
c                         E o
c     OUTSIDE REGION        |      o P1         INSIDE REGION
c                           |     /
c                           |    /
c                           | C o - The dot product of Ni and the vector
c                           |  /    between this interior point and Pe is < 0
c                           | /
c                           |/
c                         B o - The dot product of Ni and the vector between
c                          /|   this edge point and Pe is 0
c                         / |
c  The dot product of    /  |
c  Ni and the vector    /   |
c     EA is > 0      A o    |
c                     /     |
c                    /      |
c                P0 o       |
c                           |
c     <---------------------| The vector Ni is the normal to the edge 
c             Ni            | directed outward.
c                           +---------------------------------------------
c 
c  <denom> is the - (Ni * (P1 - P0)) where * is the dot product.  Its sign
c  determines whether its intersection is entering or leaving the region,
c  i.e. as you move along the line containing the points P0 and P1 in
c  the direction from the first to the second point, when you cross the edge
c  are you entering or leaving the region?  Parameter <num> is Ni * (P0 - E)
c  for a particular edge/line combination, which reduces to directed
c  horizontal and vertical distances from P0 to an edge.  Its sign determines
c  visibility of P0 and is used to trivially reject horizontal or vertical 
c  lines.  If the line segment can be trivially rejected, FALSE is returned; 
c  if it cannot be, TRUE is returned and the value of tE or tL is adjusted,
c  if needed, for the portion of the segment that is inside the edge. tE and
c  tL represents fractions of the line segment being clipped.  tE represents
c  the point along the line that the line segment enters the clip region, 
c  tL is the point along the line that the line segment leaves the region.
c  Before any clipping takes place these values are 0.d0 and 1.d0.
c
c  Below you'll notice 3 cases that correspond to the diagram above, remember
c  that <denom> denotes whether the line is moving in the direction from
c  OUTSIDE to INSIDE (>0), INSIDE to OUTSIDE (<0) or if the line is 
c  parallel to the edge and is doing neither (0).  <num> is the directed
c  distance from P0 to the edge (if <num> > 0 P0 is outside the region).
c
c
c**************************************************************************

	logical*4 function CLIPT (denom, num, tE, tL)

	real*8 denom, num, tE, tL, t
	logical*4 accept

	accept = .true.
	if (denom .gt. 0.d0) then	! Intersection entering region
	  t = num/denom			! Value of t at intersection
	  if (t.gt.tL) then		! tE and tL crossover, reject line
	    accept = .false.
	  elseif (t .gt. tE) then	! A new entering point has been found
	    tE = t
	  endif
	elseif (denom .lt. 0.d0) then	! Intersection leaving region
	  t = num/denom			! Value of t at intersection
	  if (t .lt. tE) then		! tE and tL crossover, reject line
	    accept = .false.
	  elseif (t .lt. tL) then	! A new leaving point has been found
	    tL = t
	  endif
	else				! Line on outside of edge
	  if (num .gt. 0.d0) accept = .false.
	endif
	CLIPT = accept
c
	return
	end



	subroutine MX$CONTOUR (zs,zd,nz,work,chk,lines,nk,ibuf,
     &			mi,mj,xs,xd,ys,yd)

	implicit none

	include 'midas.inc'
! args
	real*4    zs,zd		! z-level start and delta
	integer*4 nz		! # of z-levels
	real*4 	  work(*)	! array of z-levels
	integer*4 chk(*)	! dummy array of markers 
	real*4    lines(*)	! return array of contour lines
	integer*4 nk		! # of pairs of points output in lines
	integer*4 ibuf		! actual size of lines array (in bytes)
	integer*4 mi,mj		! x,y dimensions of 2-d grid
	real*4    xs, ys	! real world upper corner of grid
	real*4    xd, yd	! real world delta between grid elements
! locals
	real*4 z
	integer*4 i,j,ii,n
! parameters
	integer*4 P_L,P_T,P_R,P_B
	parameter (P_L=1,P_T=2,P_R=3,P_B=4)
! common
	integer*4 ni,nj,maxk
	real*4 x_start,x_delta,y_start,y_delta
	common /mx$box/ ni,nj,x_start,x_delta,y_start,y_delta,maxk
! init
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  nk = 0
	  ni = mi
	  nj = mj
	  x_start = xs
	  x_delta = xd
	  y_start = ys
	  y_delta = yd
	  maxk = ibuf/4
!
!  loop through z levels 
	  do n = 1,nz
	    z = zs + (n-1)*zd
	    do i = 1,NI*NJ
	     chk(i) = 0
	    enddo
! check left and right edges
	    do j = 1,nj-1
	      ii = (j-1)*ni+1
	      if (chk(ii).eq.0  .and. 
     &		  (z.gt.work(ii) .xor. z.gt.work(ii+ni))) 
     & 	        call contourline (1,j,P_L,z,work,chk,lines,nk)
	      ii = ii + ni-2
	      if (chk(ii).eq.0  .and. 
     &		  (z.gt.work(ii+1) .xor. z.gt.work(ii+1+ni))) 
     & 	        call contourline (ni-1,j,P_R,z,work,chk,lines,nk)
	    enddo
! check top and bottom edges
	    do i = 1,ni-1
	      ii = i
	      if (chk(ii).eq.0  .and. 
     &		  (z.gt.work(ii) .xor. z.gt.work(ii+1))) 
     & 	        call contourline (i,1,P_T,z,work,chk,lines,nk)
	      ii = ii + ni*(nj-2)
	      if (chk(ii).eq.0  .and. 
     &		  (z.gt.work(ii+ni) .xor. z.gt.work(ii+ni+1))) 
     & 	        call contourline (i,nj-1,P_B,z,work,chk,lines,nk)
	    enddo
! check top edge of all internal cells 
	    do j = 2,nj-1
	      ii = (j-1)*ni+1
	      do i = 1,ni-1
	        if (chk(ii).eq.0  .and. 
     &		    (z.gt.work(ii) .xor. z.gt.work(ii+1))) 
     & 	          call contourline (i,j,P_T,z,work,chk,lines,nk)
	        ii = ii+1
	      enddo
	    enddo
	  enddo
	  nk = nk/2
#if _HEADLESS
	endif
#endif
!
	return
	end



	subroutine contourline (ini,inj,inside,z,work,chk,lines,kout)
c
c           z1      s2       z2
c             +-------------+
c             |             |
c             |             |
c             |             |
c          s1 |             | s3
c             |             |
c             |             |
c             |             |
c             +-------------+
c           z4      s4       z3
c
	implicit none
! args
	real*4    z,work(*),lines(*)
	integer*4 ini,inj,inside,chk(*),kout
! locals	
	real*4	  z1,z2,z3,z4,rr
	integer*4 i,j,k,ii,side,newside,state
	logical*4 inbounds
! parameters
	integer*4 P_L,P_T,P_R,P_B
	parameter (P_L=1,P_T=2,P_R=3,P_B=4)
! tables
	integer*4 state_array(8,4)/ 0,4,0,3,0,2,0,2,
     +				    0,0,0,0,3,1,4,1,
     +				    0,0,4,1,2,4,0,0,
     +				    0,1,3,0,0,3,2,0 /
! common
	integer*4 ni,nj,maxk
	real*4 x_start,x_delta,y_start,y_delta
	common /mx$box/ ni,nj,x_start,x_delta,y_start,y_delta,maxk

! make sure there is enough room in the output array
	if (maxk-kout.lt.10) return

!  initialize parameters 
	k = kout+6
	i = ini
	j = inj
	side = inside
	ii = i + ni*(j-1)
	inbounds = .true.

!  trace through adjacent boxes
	do while (k.lt.maxk .and. chk(ii).ne.side .and. inbounds) 
	  chk(ii) = side
	  ! grab the corners 
	  z1 = work(ii)
	  z2 = work(ii+1)
	  z3 = work(ii+1+ni)
	  z4 = work(ii+ni)
	  ! calculate entry point
	  if (k.eq.kout+6) then 
	   if     (side.eq.P_L) then
	    rr = ( z-z1 )/( z4-z1 )
	    lines(k+1) = x_start + (i-1)*x_delta
	    lines(k+2) = y_start + (j-1+rr)*y_delta
	   elseif (side.eq.P_T) then
	    rr = ( z-z1 )/( z2-z1 )
	    lines(k+1) = x_start + (i-1+rr)*x_delta
	    lines(k+2) = y_start + (j-1)*y_delta
	   elseif (side.eq.P_R) then
	    rr = ( z-z2 )/( z3-z2 )
	    lines(k+1) = x_start + (i)*x_delta
	    lines(k+2) = y_start + (j-1+rr)*y_delta
	   elseif (side.eq.P_B) then
	    rr = ( z-z4 )/( z3-z4 )
	    lines(k+1) = x_start + (i-1+rr)*x_delta
	    lines(k+2) = y_start + (j)*y_delta
	   endif
	   k = k+2
	  endif
	  ! determine relationship of z to corners
	  state = 1
	  if (z.gt.z1) state = state + 8
	  if (z.gt.z2) state = state + 4
	  if (z.gt.z3) state = state + 2
	  if (z.gt.z4) state = state + 1
	  ! the state array is symmetrical
	  if (state.gt.8) state = 17 - state
	  ! decide where to exit based on state and side entered 
	  newside = state_array( state,side )
  	  if (newside.eq.P_L) then
	    rr = ( z-z1 )/( z4-z1 )
	    lines(k+1) = x_start + (i-1)*x_delta
	    lines(k+2) = y_start + (j-1+rr)*y_delta
	    i = i-1
	    side = P_R
	    inbounds = i.ge.1
	  elseif (newside.eq.P_T) then
	    rr = ( z-z1 )/( z2-z1 )
	    lines(k+1) = x_start + (i-1+rr)*x_delta
	    lines(k+2) = y_start + (j-1)*y_delta
	    j = j-1
	    side = P_B
	    inbounds = j.ge.1
	  elseif (newside.eq.P_R) then
	    rr = ( z-z2 )/( z3-z2 )
	    lines(k+1) = x_start + (i)*x_delta
	    lines(k+2) = y_start + (j-1+rr)*y_delta
	    i = i+1
	    side = P_L
	    inbounds = i.lt.ni
	  elseif (newside.eq.P_B) then
	    rr = ( z-z4 )/( z3-z4 )
	    lines(k+1) = x_start + (i-1+rr)*x_delta
	    lines(k+2) = y_start + (j)*y_delta
	    j = j+1
	    side = P_T
	    inbounds = j.lt.nj
	  endif
 	  k = k+2
	  ii = i + ni*(j-1)
	enddo

! finish trace segment header and return
 	lines(kout+1) = (k-kout-6)/2
	lines(kout+2) = z
	if (x_delta.ge.0) then
	  lines(kout+3) = x_start
	  lines(kout+5) = x_start + (ni-1)*x_delta
	else
	  lines(kout+5) = x_start
	  lines(kout+3) = x_start + (ni-1)*x_delta
	endif
	if (y_delta.ge.0) then
	  lines(kout+4) = y_start
	  lines(kout+6) = y_start + (nj-1)*y_delta
	else
	  lines(kout+6) = y_start
	  lines(kout+4) = y_start + (nj-1)*y_delta
	endif
	kout = k
!
	return
	end



c************
c Actual routine called by MX$DRAWAXIS passing the Mx structure.  
c MX$DRAWAXIS is a C jacket in gjackets.c that passes its global 
c pointer to the Mx structure along with the other arguments.  See HELP 
c MX$DRAWAXIS for more info.
c************

	subroutine MXF$DRAWAXIS (Mx,ixdiv,iydiv,ixlab,iylab,flagsarg)

	implicit none
	include 'xprim.inc'
	include 'types.inc'

	integer*4 flagsarg, flags
	real*8 xtic1,ytic1,xtic,ytic,xmult,ymult
	real*8 x,y,fact,fmul
c DR 11689 SAR 10/1/02
	character*34 xlabel,ylabel
c	character*20 xlabel,ylabel
c end DR 11689
	character string*12, string2*35, string3*35
	logical*4 grid,sp,inside
	logical*4 xtimecode,xticlabels,ytimecode,yticlabels
	integer*4 ixdiv,iydiv,ixlab,iylab
	integer*4 width,height,iscl,isct,iscr,iscb
	integer*4 ls2,ls3,ix,iy,lx,ly,itext,jtext,itexti,i,j,k
	record /STKSTRUCT/ stk1
c
c handle flags backward compatible modes
#if _HEADLESS
	if (Mx.headless .eq. 0) then
#endif
	  flags = flagsarg
	  if (flagsarg.eq.-1) flags = 1
	  if (ixlab.lt.0 .or. iylab.lt.0) then
	    if (ixlab.le.-1) flags = IOR(flags,L_noxplab)
	    if (ixlab.le.-2) flags = IOR(flags,L_noxtlab)
	    if (iylab.le.-1) flags = IOR(flags,L_noyplab)
	    if (iylab.le.-2) flags = IOR(flags,L_noytlab)
	    if (iylab.le.-3) flags = IOR(flags,L_noaxisbox)
	  endif
c
c get time axis modes
	  grid = IAND(flags,L_gridlines) .ne. 0
	  inside = IAND(flags,L_insidelab) .ne. 0
	  xtimecode = ixlab .eq. 4 .or. ixlab .le. -3
	  ytimecode = iylab .eq. 4 
	  xticlabels = IAND(flags,L_noxtlab) .eq. 0
	  yticlabels = IAND(flags,L_noytlab) .eq. 0
c
c set origin
	  call MX$ORIGIN (Mx.origin, 1, Mx.stk(Mx.level), stk1)
c
c  set ranges
	  if (IAND(flags,L_exactbox).ne.0) then
	    iscl = stk1.x1 
	    isct = stk1.y1 
	    iscr = stk1.x2 
	    iscb = stk1.y2 
	    width = iscr - iscl 
	    height = iscb - isct
	  else
	    iscl = stk1.x1 - 2
	    isct = stk1.y1 - 2
	    iscr = stk1.x2 + 2
	    iscb = stk1.y2 + 2
	    width = iscr - iscl - 4
	    height = iscb - isct - 4
	  endif
c
c  plot box
	  if (IAND(flags,L_noaxisbox).eq.0) then
	    call MX$TEXTLINE (iscl,isct,iscr,isct)
	    call MX$TEXTLINE (iscr,isct,iscr,iscb)
	    call MX$TEXTLINE (iscr,iscb,iscl,iscb)
	    call MX$TEXTLINE (iscl,iscb,iscl,isct)
	  endif
c
c form nice tic marks
	  if (ixdiv.lt.0) then
	    xTIC1 = stk1.xmin
	    xTIC = (stk1.xmin - stk1.xmax) / ixdiv
	  elseif (xtimecode) then
	    call MX$TTICS( stk1.xmin, stk1.xmax, xTIC1, xTIC, ixdiv )
	  else
	    call MX$TICS( stk1.xmin, stk1.xmax, xTIC1, xTIC, ixdiv )
	  endif
	  xmult = 1.d0
	  if (.not. xtimecode) call MX$MULT (stk1.xmin, stk1.xmax, xmult)
	  if (iydiv.lt.0) then
	    yTIC1 = stk1.ymin
	    yTIC = (stk1.ymin - stk1.ymax) / iydiv
	  elseif (ytimecode) then
	    call MX$TTICS( stk1.ymin, stk1.ymax, yTIC1, yTIC, iydiv )
	  else
	    call MX$TICS( stk1.ymin, stk1.ymax, yTIC1, yTIC, iydiv )
	  endif
	  ymult = 1.d0
	  if (.not. ytimecode) call MX$MULT (stk1.ymin, stk1.ymax, ymult)
c
c  add labels
	  ix = max (0, iscl - 4*Mx.text_w)
	  if (IAND(flags,L_xontop).ne.0) then
	    iy = min (Mx.height, INT(iscb + 1.5*Mx.text_h))
	  else
	    iy = max (Mx.text_h, INT(isct - .5*Mx.text_h))
	  endif
	  if (iy.gt.0) then
	    ly = 0
	    if (IAND(flags,L_noyplab).eq.0) then
	      call MX$LABEL (iylab, YMULT, YLABEL)
	      ly = M$LENGTH(ylabel)
	      if (ly.gt.0) call MX$TEXT(ix,iy,ylabel(1:ly))
	    endif
	    if (IAND(flags,L_noxplab).eq.0) then
	      call MX$LABEL (ixlab, XMULT, XLABEL)
	      lx = M$LENGTH(xlabel)
	      if (lx.gt.0) then
	        if (ly.gt.0) then
		  call MX$TEXT(ix+ly*Mx.text_w,iy,' vs ')
		  ix = ix + (ly+4)* Mx.text_w
	        endif
	        call MX$TEXT(ix,iy,xlabel(1:lx))
	      endif
	    endif
	  endif
c
c  add x tic marks
	  if (grid) call MX$DRAW_MODE (801) 	! dashed lines for grid
	  itext = 5.5*Mx.text_w
	  if (IAND(flags,L_xontop).ne.0) then
	   if (inside) then
	    jtext = isct + 1.0*Mx.text_h
	   else
	    jtext = isct - 0.2*Mx.text_h
	   endif
	  else
	   if (inside) then
	    jtext = iscb - 0.5*Mx.text_h
	   else
	    jtext = iscb + 1.0*Mx.text_h
	   endif
	  endif
	  if (stk1.xmin .ne. stk1.xmax) fact = width / (stk1.xmax - stk1.xmin)
	  if (stk1.xmin .eq. stk1.xmax) fact = width / 1.0
	  if (xmult.ne.0.) fmul = 1./xmult
	  if (xmult.eq.0.) fmul = 1.
	  if (xticlabels) then
	    if (xtimecode) then
	      ls2 = M$SEC2TOD (xtic1,string2)
	      sp = (ls2*Mx.text_w .lt. (iscr - iscl) / 2)
	      if (sp) itext = Mx.text_w * ls2 / 2
	    else
	      sp = dabs(xtic)/max(dabs(xtic1),dabs(xtic)) .gt. 1.d-6
	    endif
	  endif
	  if (xtic .eq. 0.d0) xtic = stk1.xmax - xtic1 + 1.d0
	  do x = xtic1,stk1.xmax,xtic
	    i = iscl + NINT(fact*(x - stk1.xmin)) + 2
	    if (grid) then
	      call MX$TEXTLINE (i,iscb,i,isct)
	    else
	      call MX$TEXTLINE (i,iscb-2,i,iscb+2)
	      call MX$TEXTLINE (i,isct-2,i,isct+2)	  
	    endif
	    if (xticlabels) then
	      if (sp) then
	        if (xtimecode) then
		  if (x.eq.xtic1 .or. i.gt.ix) then
		    if (x .ne. xtic1) ls2 = M$SEC2TOD (x,string2)
		    k = INDEX(string2(1:ls2),'.')
		    do while (k.gt.0 .and. string2(ls2:ls2).eq.'0')
		      ls2 = ls2 -1	! trim trailing zeros
		    enddo
		    itexti = float(2+ls2)/2 * Mx.text_w
		    if (inside) then
		      i = max(iscl+itexti,i)
		      i = min(iscr-itexti,i)
		    endif
		    call MX$TEXT (i-itexti,jtext,string2(1:ls2))
		    ix = i + (ls2+1) * Mx.text_w
		  endif
	        else
		  write(string,1000) x*fmul
		  call TRIMLABEL (string,j,k,.true.)
		  itexti = float(2+k-j)/2 * Mx.text_w
		  if (inside) then
		    i = max(iscl+itexti,i)
		    i = min(iscr-itexti,i)
		  endif
		  call MX$TEXT (i-itexti,jtext,string(j:k))
	        endif
	      elseif (x.eq.xtic1) then
	        if (xtimecode) then
		  ls3 = M$SEC2TOD (xtic,string3)
		  if (inside) i = max(iscl+itext,i)
		  call MX$TEXT (i-itext,jtext,
     &			  string2(1:ls2)//' += '//string3(1:ls3))
	        else 
		  write(string2,1001) xtic1*fmul,xtic*fmul 
		  if (inside) i = max(iscl+itext,i)
		  call MX$TEXT (i-itext,jtext,string2)
	        endif
	      endif
	    endif
	  enddo
c
c  add y tic marks
	  if (IAND(flags,L_yonright).ne.0) then
	   if (inside) then
	    itext = min (iscr - 6*Mx.text_w, Mx.width - 5*Mx.text_w)
	   else
	    itext = min (iscr + Mx.text_w, Mx.width - 5*Mx.text_w)
	   endif
	  else
	   if (inside) then
	    itext = max (0, iscl + Mx.text_w)
	   else
	    itext = max (0, INT(iscl - 5.5*Mx.text_w))
	   endif
	  endif
	  jtext = 0.4*Mx.text_h
	  if (stk1.ymin .ne. stk1.ymax) fact = -height/(stk1.ymax - stk1.ymin)
	  if (stk1.ymin .eq. stk1.ymax) fact = -height/1.0
	  if (ymult.ne.0.) fmul = 1./ymult
	  if (ymult.eq.0.) fmul = 1.
	  if (ytic .eq. 0.d0) ytic = stk1.ymax - ytic1 + 1.d0
	  do y = ytic1,stk1.ymax,ytic
	    i = iscb + NINT(fact*(y-stk1.ymin)) - 2
	    if (grid) then
	      call MX$TEXTLINE (iscl,i,iscr,i)
	    else
	      call MX$TEXTLINE (iscl-2,i,iscl+2,i)
	      call MX$TEXTLINE (iscr-2,i,iscr+2,i)	  
	    endif
	    if (yticlabels) then
	      if (inside .and. 
     &	        (i.lt.isct+Mx.text_h .or. i.gt.iscb-Mx.text_h*2)) then
		  ! out of range for inside labels
	      elseif (ytimecode) then
	        ls2 = M$SEC2TOD (y,string2)
	        j = INDEX(string2(1:ls2),'::')
	        if (j.gt.0) then
	          k = i+jtext-Mx.text_h
		  if (k.gt.isct .and. k.lt.iscb)
     &	          call MX$TEXT (itext,k,string2(max(1,j-5):j-1))
	          j = j+1
	        endif
	        call MX$TEXT (itext,min(iscb,i+jtext),string2(j+1:j+5))
	        k = i+jtext+Mx.text_h
	        if (k.gt.isct .and. k.lt.iscb .and. 
     &			string2(j+7:ls2).ne.'00') then
		  if (ls2.eq.j+8) string2(ls2+1:ls2+3) = '.00'
		  call MX$TEXT (itext,k,string2(j+7:j+11))
	        endif
	      else
	        write(string,1000) y*fmul
	        call TRIMLABEL (string,j,k,inside)
	        call MX$TEXT (itext,min(iscb,i+jtext),string(j:k))
	      endif
	    endif
	  enddo
	  if (grid) call MX$DRAW_MODE (800) 	! dashed lines off
c
#if _HEADLESS
	endif
#endif
	return
1000    format (f12.6)
1001    format (f15.9,'  +=  ',f12.9)
	end

	subroutine TRIMLABEL (string,j,k,inside)
	character string*(*)
	integer*4 j,k
	logical*4 inside
	if (string(6:9).eq.'.000000') then 
	  k = 5
	else
	  k = 12
	  do while (string(k:k).eq.'0')
	    k = k - 1
	  enddo
	endif
	j = 1
	do while (string(j:j).eq.' ' .and. (k-j+1.gt.5 .or. inside))
	  j = j + 1
	enddo
	return
	end


c************
c Actual routine called by MX$AXIS passing the Mx structure.  
c MX$AXIS is a C jacket in gjackets.c that passes its global 
c pointer to the Mx structure along with the other arguments.  See HELP 
c MX$AXIS for more info.
c************

	subroutine MXF$AXIS (Mx,xmin,ymin,xmax,ymax,xtic1,ytic1,xtic,ytic,
     &		xmult,ymult,left,top,width,height,xlabel,ylabel,grid)
c
	real*8 xmin,ymin,xmax,ymax,xtic1,ytic1,xtic,ytic,xmult,ymult
	real*8 x,y,fact,fmul
	character*(*) xlabel,ylabel
	character*9 string
	character*35 string2
	integer*4 left,top,width,height
	logical*4 grid,sp
c
	include 'types.inc'
	include 'xprim.inc'
c
c  set ranges
#if _HEADLESS
	if (Mx.headless .eq. 0) then
#endif
	  iscl = left - 2
	  isct = top - 2
	  iscr = iscl + width + 4
	  iscb = isct + height + 4
c
c  plot box
	  call MX$TEXTLINE (iscl,isct,iscr,isct)
	  call MX$TEXTLINE (iscr,isct,iscr,iscb)
	  call MX$TEXTLINE (iscr,iscb,iscl,iscb)
	  call MX$TEXTLINE (iscl,iscb,iscl,isct)
c
c  add labels
	  ll = M$LENGTH(ylabel)
	  ix = max (0, iscl - 4*Mx.text_w)
	  iy = max (Mx.text_h, INT(isct - .5*Mx.text_h))
	  if (ll.gt.0) then
	    call MX$TEXT(ix,iy,ylabel(1:ll))
	    ix = ix + Mx.text_w*ll
	  endif
	  ll = M$LENGTH(xlabel)
	  if (ll.gt.0) then
	    call MX$TEXT(ix,iy,' vs ')
	    ix = ix + Mx.text_w*4
	    call MX$TEXT(ix,iy,xlabel(1:ll))
	  endif
c
c  add x tic marks
	  if (grid) call MX$DRAW_MODE (801) 	! dashed lines for grid
	  itext = 5.5*Mx.text_w
	  jtext = iscb + 1.0*Mx.text_h
	  if (xmin.ne.xmax) fact = width/(xmax-xmin)
	  if (xmin.eq.xmax) fact = width/1.0
	  if (xmult.ne.0.) fmul = 1./xmult
	  if (xmult.eq.0.) fmul = 1.
	  sp = dabs(xtic)/max(dabs(xtic1),dabs(xtic)) .gt. 1.d-5
	  do x = xtic1,xmax,xtic
	    i = iscl + fact*(x-xmin) + 2
	    if (grid) then
	      call MX$TEXTLINE (i,iscb,i,isct)
	    else
	      call MX$TEXTLINE (i,iscb-2,i,iscb+2)
	      call MX$TEXTLINE (i,isct-2,i,isct+2)	  
	    endif
	    if (sp) then
	      write(string,1000) x*fmul
	      call MX$TEXT (i-itext,jtext,string)
	    elseif (x.eq.xtic1) then
	      write(string2,1001) x*fmul,xtic*fmul
	      call MX$TEXT (i-itext,jtext,string2)
	    endif
	  enddo
c
c  add y tic marks
	  itext = max (0, INT(iscl - 5.5*Mx.text_w))
	  jtext = 0.4*Mx.text_h
	  if (ymin.ne.ymax) fact = -height/(ymax-ymin)
	  if (ymin.eq.ymax) fact = -height/1.0
	  if (ymult.ne.0.) fmul = 1./ymult
	  if (ymult.eq.0.) fmul = 1.
	  do y = ytic1,ymax,ytic
	    i = iscb + fact*(y-ymin) - 2
	    if (grid) then
	      call MX$TEXTLINE (iscl,i,iscr,i)
	    else
	      call MX$TEXTLINE (iscl-2,i,iscl+2,i)
	      call MX$TEXTLINE (iscr-2,i,iscr+2,i)	  
	    endif
	    write(string,1000) y*fmul
	    if (string(6:9).ne.'.000') then 
	      k = 9
	      do while (string(k:k).eq.'0')
	        k = k - 1
	      enddo
	      j = 1
	      do while (string(j:j).eq.' ' .and. k-j+1.gt.5)
	        j = j + 1
	      enddo
	      call MX$TEXT (itext,i+jtext,string(j:k))
	    else
	      call MX$TEXT (itext,i+jtext,string(1:5))
	    endif
	  enddo
	  if (grid) call MX$DRAW_MODE (800) 	! dashed lines off
#if _HEADLESS
	endif
#endif
c
	return
1000    format (f9.3)
1001    format (f15.9,'  +=  ',f12.9)
	end


c************
c Actual routine called by MX$MHELP passing the Mx structure.  
c MX$MHELP is a C jacket in gjackets.c that passes its global 
c pointer to the Mx structure along with the other arguments.  See HELP 
c MX$MHELP for more info.
c************

	subroutine MXF$MHELP (Mx, menu, item)
c
	include 'xprim.inc'
	include 'types.inc'
	character*(*)   menu,item
	character*80    expfile
	character*90    heading
	character*80    line
	character*2048  buffer
	integer*4       lm,li,lb,ll,lf
	logical*4	done

#if _HEADLESS
	if (Mx.headless .eq. 0) then
#endif
c
c get string lengths and explain file name
	  lm = M$LENGTH(menu)
	  li = M$LENGTH(item)
	  if (li.eq.0 .or. lm.eq.0) return
	  if (menu(1:1).eq.'~') then 
	    le = M$FILENAME ('EXP','XCOMMON','EXP',expfile)
	    heading = menu(2:lm)
	    lm = lm - 1
	  else
	    le = M$FILENAME ('EXP',Mx.name(1:M$LENGTH(Mx.name)),'EXP',expfile)
	    heading = menu(1:lm)
	  endif
	  lb = 0
c
c open explain file
	  if (M$FILE('OPEN/e',9,expfile).eq.0) goto 91
c
c find starting line
	  done = .false.
#if _PGF77|_HPUX|_IFC|_GFC
	  read (9,'(a)',err=90,end=90) line
#else
	  read (9,'(a)',err=90) line
#endif
	  do while (.not. done)
	    if (line(1:6).eq.'~Menu ') then
	      lstar = M$SEARCH(line(7:),'*') - 1
	      if (lstar.lt.0) done = line(7:lm+6) .eq. heading(1:lm)
	      if (lstar.eq.0) done = .true.
	      if (lstar.gt.0) done = line(7:lstar+6) .eq. heading(1:lstar)
	    endif
#if _PGF77|_HPUX|_IFC|_GFC
	    read (9,'(a)',err=90,end=90) line
#else
	    read (9,'(a)',err=90) line
#endif
	  enddo
	  do while (line(1:6).eq.'~Menu ')
#if _PGF77|_HPUX|_IFC|_GFC
	    read (9,'(a)',err=90,end=90) line
#else
	    read (9,'(a)',err=90) line
#endif
	  enddo

	  done = .false.
	  do while (.not.done) 
	    if (line(1:6).eq.'~Item ') then
	      lstar = M$SEARCH(line(7:),'*') - 1
	      if (lstar.lt.0) done = line(7:li+6) .eq. item(1:li)
	      if (lstar.eq.0) done = .true.
	      if (lstar.gt.0) done = line(7:lstar+6) .eq. item(1:lstar)
	    endif
#if _PGF77|_HPUX|_IFC|_GFC
	    read (9,'(a)',err=90,end=90) line
#else
	    read (9,'(a)',err=90) line
#endif
	    if (line(1:5).eq.'~Menu') goto 90
	  enddo
	  do while (line(1:6).eq.'~Item ')
#if _PGF77|_HPUX|_IFC|_GFC
	    read (9,'(a)',err=90,end=90) line
#else
	    read (9,'(a)',err=90) line
#endif
	  enddo
c
c add text into buffer
	  do while (line(1:1).ne.'~')
	    ll = M$LENGTH (line)
	    ! for generic * item matches, replace all *'s in help text with
	    ! the item pattern match.
	    if (lstar.ge.0) then
	      lrepl = M$SEARCH(line(1:ll),'*')
	      do while (lrepl.gt.0 .and. ll.le.80-(li-lstar))
	        line = line(1:lrepl-1)//item(1+lstar:li)//line(lrepl+1:ll)
	        ll = ll + li - lstar - 1
	        lrepl = M$SEARCH(line(1:ll),'*')
	      enddo
	    endif
	    if ((lb+ll+3) .gt. 2048) then
	      call MX$MESSAGE (buffer(1:lb)//'...', -1.0)
	      buffer(1:ll+3) = '...'//line(1:ll)
	      lb = ll + 3
	    elseif (ll.gt.0) then
	      buffer(lb+1:lb+ll+1) = ' '//line(1:ll)
	      lb = lb + ll + 1
	    endif
#if _PGF77|_HPUX|_IFC|_GFC
	    read (9,'(a)',err=90,end=90) line
#else
	    read (9,'(a)',err=90) line
#endif
	  enddo
c
  90	  close(9)
	  if (lb.le.0) then
	    call MX$MESSAGE ('No help available for this item', -1.0)
	  else
	    call MX$MESSAGE (buffer(1:lb), -1.0)
	  endif
#if _HEADLESS
	endif
#endif
	return
c
  91	lb =  M$LENGTH (expfile)
	call MX$MESSAGE ('Couldnt open explain file - '//expfile(1:lb),
     &                                                   -1.0)
	return

	end



	function MX$FILES (filename)

	implicit none
	include 'midas.inc'
	include 'types.inc'
	include 'xtypes.inc'
	character*(*) filename
	integer*4 length, item
	SAVE
	character*40  userargs	/'* TMP|PRM -1'/

#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif

	  length = 0
	  item = 1

	  do while (item.ne.0 .and. length.eq.0)
	    item = MX$MENU (0, '~FILES;Enter File Name...,ALL Files'//
     &		  ' List...,User Files List...,FILES Command...')
	    if (item.eq.1) then
	      call MX$PROMPT ('File: ', filename)
	      length = M$LENGTH (filename)
	    elseif (item.eq.2) then
	      length = MX$USERFILES (filename, '* TMP|PRM -1')
	    elseif (item.eq.3) then
	      length = MX$USERFILES (filename, userargs)
	    elseif (item.eq.4) then
	      call MX$PROMPT ('Command: FILES ', userargs)
	    endif
	  enddo

	  MX$FILES = length
#if _HEADLESS
	else
	  MX$FILES = 0
	endif
#endif

	return
	end


	function MX$USERFILES (filename, userargs)
c
	implicit none
	include 'midas.inc'
	include 'types.inc'

	character*(*) filename, userargs
	character*(L_max_ascii) path, fname, aux_list, temp_id
	character*(L_max_ascii) fullname, command, ext
	integer*4     i, j, k, n, lf, lc, lp, iaux, nopath
	integer*4     csize, lsize, ssize
	integer*4     llines, sindex, nselect, lines, maxlen, length
	logical*4     all
	integer*4     MX$USERFILES
	real*8        dval
	record /M_PTR/ fn, linep, selectp, cbufp

	structure /LINESTAT/
	  integer*4 i, l
	endstructure
	record /LINESTAT/ line(10)
	pointer (line_ptr, line)

c	integer*4 select(1)
	integer*4 select(*)	! _IFC
	pointer (select_ptr, select)

c	byte cbuf(1)
	byte cbuf(*)		! _IFC
	pointer (cbuf_ptr, cbuf)
c
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  i = M$CLEAN (userargs, command)

	  nselect = 1
	  ssize = 0
	  selectp.p = 0
	  lsize = 0
	  linep.p = 0
	  csize = 0
	  cbufp.p = 0
	  nopath = 0
	  sindex = 3
	  lp = 0

	  if (M$PARSE(command,1,fname).le.0) fname = '*'
	  if (M$PARSE(command,2,ext).le.0) ext = 'ALL'
	  if (ext.eq.'ALL') ext = 'TMP|PRM'
	  if (M$PARSE(command,3,aux_list).le.0) aux_list = '-1'
	  if (aux_list .eq. '-1') aux_list = 'ALL'

c Check to see if path is already provided, if so...bypass auxiliaries
#if _VMS
	  if (M$SEARCH(fname,':').gt.0) then
	    aux_list = '-2'
	    lp = M$SEARCHB(fname,']')
	    if (lp.eq.0) lp = M$SEARCHB(fname,':')
	  endif
#elif _UNIX
	  if (M$SEARCH(fname,'/').gt.0) then
	    aux_list = '-2'
	    lp = M$SEARCHB(fname,'/')
	  endif
#endif
	  if (M$PARSE(command,4,temp_id).le.0) temp_id = Mc.read_id
	  if (M$PARSE(command,5,fullname).gt.0) then
	    if (M$A2D(fullname, dval).gt.0) nselect = dval
	  endif
	  if (M$PARSE(command,6,fullname).gt.0) then
	    if (fullname.eq.'TRIM') then
	      nopath = 1
	    elseif (fullname.eq.'TAIL') then
	      nopath = 2
	    elseif (fullname.eq.'ROOT') then
	      nopath = 3
	    endif
	  endif
c
	  call BUFEXPAND(linep, lsize, 80, 8)
	  line_ptr = linep.p
	  call BUFEXPAND(cbufp, csize, 512, 1)
	  cbuf_ptr = cbufp.p
	  call BUFEXPAND(selectp, ssize, max(1,nselect)+2, 8)
	  select_ptr = selectp.p
c
	  fn.p = %loc(fullname)
	  line(1).i = 1				! Add widget title
	  line(1).l = 5
	  fullname(1:5) = 'FILES'
	  lc = 5
	  call M$MOVE(%val(fn.p), cbuf, lc)
	  lines = 1
	  maxlen = 0
	  n = 0

c
	  do while (M$LENGTH(aux_list).gt.0)
	    iaux = -1
	    n = n + 1
	    if (aux_list.eq.'ALL') then
	      if (n.le.Mc.read_auxs) iaux = Mc.read_aux(n)
	      if (n.eq.Mc.read_auxs) aux_list = ' '
	    else
	      i = M$SEARCH(aux_list, '|')
	      if (i.eq.0) i = M$LENGTH(aux_list) + 1
	      if (M$A2D(aux_list(1:i-1),dval).gt.0) iaux = dval
	      aux_list = aux_list(i+1:)
	    endif
	    if (iaux.ne.-1) then
	      ! parse out next extension
	      if (iaux.eq.-2) then
	        path = fname(1:lp)
	        fname = fname(lp+1:)
	        if (fname.eq.' ') fname = '*'
	      else
	        lp = M$FORM_PATH(iaux, temp_id, path)
	      endif
	      i = -1
	      llines = lines
	      do while (M$LDIRECTORY(path,fname,ext,fullname,i,j,k).gt.0)
CMMT 5-JUN-1998|LEB: We may write j+2 characters, if file names indented.
C.....        if ((lc+j).gt.csize) then
	        if ((lc+j+2).gt.csize) then
		  call BUFEXPAND(cbufp,csize,512,1)
		  cbuf_ptr = cbufp.p
	        endif
CMMT 5-JUN-1998|LEB: We may write two lines, directory and file name.
C.....        if (lines+1.eq.lsize) then
                if (lines+2.GE.lsize) then
		  call BUFEXPAND(linep,lsize,80,8)
		  line_ptr = linep.p
	        endif
	        if (nopath.eq.0) then		! include path
		  i = 1
	        elseif (nopath.eq.1) then
		  if (llines.eq.lines) then	! add path as a separate line
		    select(sindex) = -lines
		    sindex = sindex + 1
		    call BUFEXPAND(selectp, ssize, 10, 4)
		    select_ptr = selectp.p
		    lines = lines + 1
		    if (i-1.gt.maxlen) maxlen = i-1
		    line(lines).i = lc+1
		    line(lines).l = i-1
		    call M$MOVE(%val(%loc(fullname)), cbuf(lc+1), i-1)
		    lc = lc + i - 1
		  endif
		  fullname(i-2:i-1) = '  '	! indent filenames 2 characters
		  i = i - 2
	        elseif (nopath.eq.3) then		! strip off extension
		  lf = M$SEARCH(fullname(i:j), '.') - 1
		  if (lf.ge.0) j = i + lf - 1
	        endif
	        j = j - i + 1
	        lines = lines + 1
	        if (j.gt.maxlen) maxlen = j
	        line(lines).i = lc+1
	        line(lines).l = j
	        call M$MOVE(%val(fn.p+i-1), cbuf(lc+1), j)
	        lc = lc + j
	        if (lines-llines.gt.20) llines = lines
	      enddo
	    endif
	  enddo

	  lines = lines - 1		! subtract off title line
	  length = 0
	  lf = len(filename)
	  fn.p = %loc(filename)

	  if (nselect.lt.0) then		! calculate max # selections
	    nselect = lines - sindex + 3
	    call BUFEXPAND(selectp, ssize, nselect+2-ssize, 4)
	    select_ptr = selectp.p
	  endif

	  if (lines.le.0) then
	    call MX$MESSAGE('No files to list', 1.0)

	  elseif (nselect.eq.0) then		! view only
	    call MX$SCROLLBOX(cbuf, line, lines, maxlen, 3) 

	  elseif (nselect.gt.1 .or. nopath.eq.1) then	! multiple select/nopath
	    select(1) = lines
	    select(2) = nselect
	    select(sindex) = 0
	    nselect = maxlen
	    call MX$SCROLLBOX(cbuf, line, select, nselect, 6) 
	    maxlen = 0
	    n = 1
	    do while (n.le.nselect .and. length.lt.lf)
	      i = select(n+2) + 1
	      if (nopath.eq.1) then
	        ! find path and move it in
	        j = i - 1
	        do while (j.gt.2 .and. cbuf(line(j).i).eq.ICHAR(' '))
		  j = j - 1
	        enddo
	        maxlen = maxlen + line(j).l
	        line(j).l = min(line(j).l, lf-length)
	        call M$MOVE(cbuf(line(j).i), %val(fn.p+length), line(j).l) 
	        length = length + line(j).l
	        ! trim off indenting spaces from filename
	        line(i).i = line(i).i + 2
	        line(i).l = line(i).l - 2
	      endif

	      maxlen = maxlen + line(i).l
	      line(i).l = min(line(i).l, lf-length)
	      call M$MOVE(cbuf(line(i).i), %val(fn.p+length), line(i).l) 
	      length = length + line(i).l
	      if (n.lt.nselect) then
	        if (length.lt.lf) then
		  length = length + 1
		  filename(length:length) = '|'
	        endif
	        maxlen = maxlen + 1
	        if (nopath.eq.1) then
		  line(i).i = line(i).i - 2
		  line(i).l = line(i).l + 2
	        endif
	      endif
	      n = n + 1
	    enddo
	    if (n.lt.nselect .or. length.lt.maxlen) then
	      call MX$MESSAGE('File name truncated', 1.0)
	    endif
	    if (length.gt.0 .and. length.lt.lf) filename(length+1:) = ' '

	  else
	    call MX$SCROLLBOX(cbuf, line, lines, maxlen, 0) 
	    length = min (maxlen, lf)
	    if (length.lt.maxlen) then
	      call MX$MESSAGE('File name truncated', 1.0)
	    endif
	    call M$MOVE(cbuf(lines), %val(fn.p), length) 
	    if (length.gt.0 .and. length.lt.lf) filename(length+1:) = ' '

	  endif
c
	  call M$STMFREE(csize, cbufp)
	  call M$STMFREE(lsize*8, linep)
	  if (ssize.gt.0) call M$STMFREE(ssize*4, selectp)

	  MX$USERFILES = length
#if _HEADLESS
	else
	  MX$USERFILES = 0
	endif
#endif

	return
	end	

	subroutine BUFEXPAND (buf, size, chunk, bpe)
	implicit none
	include 'types.inc'
	record /M_PTR/ buf, temp
	integer*4 size, chunk, bpe
	size = max(0,size)
	if (chunk.lt.0) return
	call M$STMALLOC((size+chunk)*bpe, temp.p) 
	if (size.gt.0) then
	  call M$MOVE(%val(buf.p), %val(temp.p), size*bpe) 
	  call M$STMFREE(size*bpe, buf)
	endif
	buf.p = temp.p
	size = size + chunk
	return
	end
c
c
	function MX$GRAPHICS_MSG(Mx, MQH, MQD, msgid, mask)
	implicit none
	include 'xprim.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	integer*4 msgid, mask, sid, junk

	MX$GRAPHICS_MSG = 1

	if (MQH.name .eq. MQH_EXIT.name) then
	  Mx.breakflag = .true.
	elseif (MQH.name .eq. MQH_TITLE.name) then
	  if (MQH.info .eq. 0) then
	    call MX$TITLE(MQD.TITLE.text, 3)
	  else
	    call MX$TITLE(MQD.TITLE.text, MQH.info)
	  endif
	elseif (MQH.name .eq. MQH_MSGMASK.name) then
	  if (MQH.info .gt. 0) then
	    mask = IOR(MQD.MSGMASK.mask,mask)
	  elseif (MQH.info .lt. 0) then
	    mask = IAND(NOT(MQD.MSGMASK.mask),mask)
	  else
	    mask = MQD.MSGMASK.mask
	  endif
	elseif (MQH.name .eq. MQH_QUERY.name .and.
     +		MQD.QUERY.object .eq. MQH_MSGMASKINFO.name) then
	  sid = MQH.sender
	  MQD.MSGMASKINFO.mask = mask
	  MQH_MSGMASKINFO.msgid = msgid
	  call M$SEND_MSG (MQH_MSGMASKINFO, MQD.MSGMASKINFO, sid, 0)
	elseif (MQH.name .eq. MQH_SET.name) then
	  if (MQD.SET.object .eq. 'ICONIFY') then
	    if (MQH.info.eq.0 .or. (MQH.info.lt.0 .and. Mx.icon)) then
	      junk = MX$CLIENT_EVENT(0,L_Deiconify_Msg,0,0)
	    else
	      junk = MX$CLIENT_EVENT(0,L_Iconify_Msg,0,0)
	    endif
	  elseif (MQD.SET.object .eq. 'MSGID') then
	    msgid = MQH.info
	  else
	    MX$GRAPHICS_MSG = 0
	  endif
	else
	  MX$GRAPHICS_MSG = 0
	endif
	return
	end

c**************
c
c	RETURN FLAGS:
c	  1  matched '=', mimic id and message (cont)
c	  0  no '=' (cont)
c	 -1  matched '=' but didn't match message (done or cont)
c	 -2  matched '=' but mimic id did not match (done)
c
c*************

	function MX$MIMIC_MSG (MQH, MQD, mimic)
	implicit none
	include 'xprim.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	integer*4 mimic

	MX$MIMIC_MSG = 0
	if (MQH.name(1:1).ne.'=') return

	MX$MIMIC_MSG = -2
	if (mimic.lt.0 .or. (mimic.ne.0 .and. mimic.ne.MQH.sender)) return

	MX$MIMIC_MSG = 1
	if (MQH.name .eq. MQH_BOXINFO.name) then
	  if (MQH.info .le. 0) then
	    MQH.name = MQH_BOXDELETE.name
	    MQH.info = -MQH.info
	  else
	    MQH.name = MQH_BOXALTER.name
	  endif
	elseif (MQH.name .eq. MQH_COLORINFO.name) then
	  MQH.name = MQH_COLOR.name
	elseif (MQH.name .eq. MQH_COLORMAPINFO.name) then
	  MQH.name = MQH_COLORMAP.name
	elseif (MQH.name .eq. MQH_CXMODEINFO.name) then
	  MQH.name = MQH_CXMODE.name
	elseif (MQH.name .eq. MQH_EXITINFO.name) then
	  MQH.name = MQH_EXIT.name
	elseif (MQH.name .eq. MQH_MARKINFO.name) then
	  MQH.name = MQH_MARK.name
	elseif (MQH.name .eq. MQH_PANINFO.name) then
	  MQH.name = MQH_PAN.name
	elseif (MQH.name .eq. MQH_PLOTINFO.name) then
	  MQH.name = MQH_ZOOM.name
	elseif (MQH.name .eq. MQH_POINTINFO.name) then
	  if (MQH.info .le. 0) then
	    MQH.name = MQH_POINTDELETE.name
	    MQH.info = -MQH.info
	  else
	    MQH.name = MQH_POINTALTER.name
	  endif
	elseif (MQH.name .eq. MQH_SELECTINFO.name) then
	  MQH.name = MQH_SELECT.name
	elseif (MQH.name .eq. MQH_UNZOOMINFO.name) then
	  MQH.name = MQH_UNZOOM.name
	elseif (MQH.name .eq. MQH_ZOOMINFO.name) then
	  MQH.name = MQH_ZOOM.name
	else
	  MX$MIMIC_MSG = -1
	endif

	return
	end

	subroutine MX$XC (cmap, color, reqncolors)
	implicit none
	include 'types.inc'
	include 'midas.inc'
	include 'xstructures.inc'
	include 'qmessdef.inc'
c arguments
	record /COLORTYPE/ cmap
	record /MQD_COLOR/ color(*)
	integer*4 reqncolors
c locals
	character*(L_cmd_chars) switch
	character*(L_max_resname) str, istr
	integer*4 ncolors, lxc, n, i, is, ls, xcmax
	integer*2 position, iz, ival
	real*4    zf, zf1
	real*8    dval
c code
#if _HEADLESS
c	if (Mu.remote .eq. 0) then
	if (Mu.headless .eq. 0) then
#endif
	  ncolors = reqncolors
	  switch = ' '
	  lxc = M$GET_USWITCH('XC', switch)
	  if (lxc .le. 0) then
	    lxc = 3
	    switch = '( )'
	  endif

	  if (switch(1:1).eq.'(') then
	    n = 1
	    ncolors = min(ncolors, L_color)
	    do while (n.le.ncolors)
	      ls = M$PARSE(switch(2:lxc-1), n, str)
	      if (ls.gt.0) then
		 if (str(ls:ls).eq.'.') then
	        ls = ls - 1
	        ncolors = n
	      endif
	      endif
	      if (ls.le.0) then
	        if (color(n).position .lt. -1) then
		  if (reqncolors .gt. 0) then
		    color(n).position = NINT((n-1.0)*
     &              (100.0/(reqncolors-1.0)))
		  else
		    color(n).position = 0
		  endif
	        endif
	      elseif (str(1:1).eq.'(') then
	        color(n).position = -1
	        do i = 1, 3
		  ival = 0
		  if (M$PARSE(str(2:ls-1),i,istr).gt.0) then
		    if (M$A2D(istr, dval).lt.0) call M$ERROR('Parsing /XC')
		    ival = max(0, min(100, NINT(dval)))
		  endif
		  if (i.eq.1) color(n).red = ival
		  if (i.eq.2) color(n).green = ival
		  if (i.eq.3) color(n).blue = ival
	        enddo
	      elseif (M$A2D(str(1:ls),dval).gt.0) then	! RDA 21-May-98
	        color(n).position = max(0, min(100, NINT(dval)))
              else
	        call MX$COLORLAB(n, str(1:ls))
	        call MX$COLORTAB(n, color(n), -3)
	        color(n).position = -1			! RDA 21-May-98
	      endif
	      n = n + 1
	    enddo
	  else
	    color(1).position = max(0, M$GET_SWITCH('XC'))
	  endif
	  reqncolors = ncolors
#if _HEADLESS
	endif
#endif
	return
	end

