c************
c  Description: HOST code for XRTRASTER primitive
c
c  Author:      SES   12/93
c
c  $Revision: 1.1 $
c  $Modtime:   15 Feb 1996 11:40:54  $
c
c************
#define _HOSTVERSION
	program XRTRASTER
c
	include 'xrtraster.inc'
	include 'midas.inc'
	include 'headers.inc'
	record /HEADER/ HCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn
c
	call M$CHECKIN()	! map to shared memory
c old	call MDF$XRTRASTER()	! get command line parameters/switches
	call MDFH$XRTRASTER()	! get command line parameters/switches
	call MX$OPEN('X-RTRaster') ! open window and get its id before M$SYNC
	call XRTRASTER_INIT(Mx, Gx) ! initialize other parameters
	call M$SYNC()		! end of preamble
c
	call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), 1)
c	
	do while (.not. Mc.break .and. .not. Mx.breakflag)
	  ! get msg/event/data
	  if (XRTRASTER_RUN(Mx,Gx).eq.0) call M$PAUSE(Mc.pause)
	enddo
c
	if (HCB.open) call M$CLOSE(HCB)
	call XRTRASTER_END(Mx, Gx, %val(Gx.sbuf.p))
	call M$RETURN ()
c
	end

	subroutine XRTRASTER_SPECS_ ()
	include 'xrtraster.inc'
	include 'headers.inc'
	record /HEADER/ HCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn
	call XRTRASTER_SPECS (Mx, Gx)
	return
	end

	integer*4 function MD$BUFTMP (bufid, nelem, itype)
	include 'xrtraster.inc'
	include 'headers.inc'
	integer*4 bufid, nelem, itype
	integer*4 ibpa

	record /HEADER/ HCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn

	ibpa = M$NPT(CHAR(itype))
	if (ibpa*nelem .gt. buftmpn(bufid)) then
	  if (buftmpn(bufid).gt.0) call M$FREE(buftmp(bufid).p)
	  buftmpn(bufid) = ibpa * nelem
	  call M$MALLOC(buftmpn(bufid), buftmp(bufid).p)
	endif
	MD$BUFTMP = buftmp(bufid).p

	return
	end

	subroutine MD$SETBUFXFER (bufid, xfer_len)
	include 'xrtraster.inc'
	include 'headers.inc'
	integer*4 bufid, xfer_len
	record /HEADER/ HCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn
	HCB.xfer_len = xfer_len
	return
	end

	integer*4 function MD$BUFOPEN (bufid)
	include 'xrtraster.inc'
	include 'headers.inc'
	integer*4 bufid
	logical*4 PIPE_OPEN
	record /HEADER/ HCB, PCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn
	pointer (PCB_ptr, PCB)
#if JEFF
	MD$BUFOPEN = 0
	if (HCB.pipe.eq.0) then
	  if (HCB.size - HCB.offset.gt.HCB.xfer_len) MD$BUFOPEN = 1
	elseif (lPCB.p.ne.0) then
	  PCB_ptr = lPCB.p
	  if (PCB.inlet.ge.0) MD$BUFOPEN = 1
	endif
#else
	MD$BUFOPEN = 1
#endif
	return
	end

	integer*4 function MD$BUFIN(bufid, nelem, type)
	include 'xrtraster.inc'
	include 'headers.inc'
	integer*4 bufid, nelem, type

	record /HEADER/ HCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn

	integer*4 bpa, MD$BUFTMP
	byte buf(1)
	pointer (buf_ptr, buf)

	! tmp buffer 2 on the HOST side is shared by GRABX and the routine
	! that reformats the data, allocate enough space for either
	bpa = max(HCB.bpa, HCB.spa*M$NPT(HCB.buf_type))
	
	buf_ptr = MD$BUFTMP(2, HCB.xfer_len*bpa, MP_BYTE)
	call M$GRABX(HCB, buf, nelem)
	MD$BUFIN = buf_ptr
	return
	end

	integer*4 function MD$BUFAVAILNEXT (bufid, nelem)
	include 'xrtraster.inc'
	include 'headers.inc'
	integer*4 bufid, nelem
	real*8 out_bytes, dbpe
	record /HEADER/ HCB, PCB
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HCB,Mx,Gx,lPCB,buftmp,buftmpn
	pointer (PCB_ptr, PCB)
#if JEFF
	if (HCB.pipe.eq.0) then
	  MD$BUFAVAILNEXT = HCB.size - HCB.offset
	elseif (lPCB.p.ne.0) then
	  PCB_ptr = lPCB.p
	  if (HCB.open) then
	    MD$BUFAVAILNEXT =
     &		(PCB.in_byte - PCB.out_bytes(HCB.outlet))/HCB.dbpe
	  else		! asynchronous read from pipe
c TODO: we need to keep our own local HCB.offset when /SETD/ FRAME message
c is received.
	    out_bytes = max (0.d0, PCB.in_byte - PCB.pipesize)
	    out_bytes = max (out_bytes, PCB.out_bytes(HCB.outlet))
	    if (nelem.gt.1) then
	      dbpe = nelem * HCB.dbpe
	      out_bytes = out_bytes + dbpe - mod(out_bytes-1.d0, dbpe) + 1.d0
	    endif
	    MD$BUFAVAILNEXT = (PCB.in_byte - out_bytes)/HCB.dbpe
	  endif
	else
	  MD$BUFAVAILNEXT = 0
	endif
#else
	call M$HCBFUNC(HCB,HCBF_AVAIL,MD$BUFAVAILNEXT)
#endif
	return
	end

#if _DEBUG
c These routines are here when I need debugging turned on

	subroutine DSMCLIENT ()
	return
	end

	subroutine M$MAP_DS_STRUCTS ()
	return
	end
#endif

c************
c  Description: DSEF for XRTRASTER routine
c
c  Author:	JGS   4/1/91
c
c  $Revision: 1.1 $
c  $Modtime:   01 May 1996 14:34:02  $
c  
c************
#if _HOSTVERSION
	subroutine MDFH$XRTRASTER
#else
	subroutine MDF$XRTRASTER
#endif
c
	include 'xrtraster.inc'
	include 'midas.inc'
	include 'headers.inc'
	include 'dseftypes.inc'
	record /HEADER/ HIN
#if _HOSTVERSION
	record /M_PTR/ lPCB,buftmp(2)
	integer*4 buftmpn(2)
	common /xrtraster/ HIN,Mx,Gx,lPCB,buftmp,buftmpn
#endif
	character cmode*2, ch
	real*4 dbscale
c
c open input file
	HIN.file_name =	M$APICK(1)
	HIN.type_allow = '1000,2000'
	HIN.format_allow = 'S*,C*'
	call M$INOK (HIN)
c
c get other specs
	Gx.zmin   = M$FPICK(2)
	Gx.zmax	  = M$FPICK(3)
	cmode     = M$APICK(4)
	Gx.mframe = M$LPICK(5)	
	Gx.ncolor = M$BPICK(6)
c
c get autoscaling and exponential length and init real time range
	Gx.iautom = max(0, M$GET_SWITCH('AUTO'))
	if (Gx.iautom.eq.0) then
	  if (.not.M$PPICK(2)) Gx.iautom = 1
	  if (.not.M$PPICK(3)) Gx.iautom = Gx.iautom+2
	  if (Gx.iautom.gt.1) Gx.zmax = 1.0
	endif
	Gx.iautom = min(3,Gx.iautom)
	Gx.iautol = M$GET_SWITCH_DEF ('AUTOL',5)
	Gx.bs = M$GET_SSWITCH('BS')
c
c figure out X and Y mouse results parameter labels
	Gx.imouse = M$GET_USWITCH('XMN',Gx.mouse)
	if (Gx.imouse.le.0)  then
	  Gx.mouse = 'MOUSE'
	  Gx.imouse = 5
	endif
c
c get complex mode from command line parameter
	Gx.cx = (HIN.format(1:1) .eq. 'C')
	if (Gx.cx) then
	  Gx.cmode = 1		! Default to magnitude mode for COMPLEX data
	  if (cmode.eq.'PH') Gx.cmode = 2	! These modes are valid only
	  if (cmode.eq.'RE') Gx.cmode = 3	! for complex data
	  if (cmode.eq.'IM') Gx.cmode = 4
	else
	  Gx.cmode = 3		! Default to real mode for SCALAR data
	  if (cmode.eq.'MA') Gx.cmode = 1
	endif
	if (cmode.eq.'LO' .or. cmode.eq.'D1') Gx.cmode = 5
	if (cmode.eq.'L2' .or. cmode.eq.'D2') Gx.cmode = 6
c
c convert 'LO' and 'L2' parameters to DB and set lower limit on DB values
	Gx.dbmin = 1e-20
	Gx.dbrange = M$GET_SWITCH('DBRANGE')
	if (Gx.dbrange.lt.0.0 .and. cmode(1:1).ne.'L') Gx.dbrange = 50.d0
	if (Gx.cmode .ge. 5) then
	  dbscale = 10.0
	  if (Gx.cmode.eq.6) dbscale = 20.0
	  if (cmode(1:1).eq.'L') then	! keep backwords compatible behavior
	    if (Gx.cx) then
	      Gx.zmin = amax1(Gx.zmin, 1e-10)
	      Gx.zmax = amax1(Gx.zmax, 1e-10)
	    else
	      Gx.zmin = amax1(Gx.zmin, 1e-20)
	      Gx.zmax = amax1(Gx.zmax, 1e-20)
	    endif
	    Gx.zmin = log10(Gx.zmin) * dbscale
	    Gx.zmax = log10(Gx.zmax) * dbscale
	  elseif (Gx.cx) then	! these values must be squared
	    Gx.zmin = amax1(-18.0 * dbscale, Gx.zmin)
	    Gx.zmax = amax1(-18.0 * dbscale, Gx.zmax)
	    Gx.dbmin = 1e-37		! smallest possible float
	  elseif (amin1(Gx.zmin,Gx.zmax) .lt. -20.0*dbscale) then
	    Gx.zmin = amax1(-37.0 * dbscale, Gx.zmin)
	    Gx.zmax = amax1(-37.0 * dbscale, Gx.zmax)
	    Gx.dbmin = 10**(amin1(Gx.zmin,Gx.zmax)/dbscale)
	  endif
	endif

c
c get the frame rate
	if (HIN.xdelta .eq. 0.d0) then
	  call M$WARNING ('File has 0.0 X abscissa delta, using 1.0')
	  Gx.xdelta = 1.0d0
	else
	  Gx.xdelta = HIN.xdelta
	endif
	if (HIN.class .eq.1) then
	  Gx.mframe = iabs(Gx.mframe)
	  Gx.xstart = 0.d0
	  Gx.ystart = HIN.xstart
	  Gx.ydelta = Gx.xdelta * Gx.mframe
	else
	  Gx.xstart = HIN.xstart
	  Gx.ystart = HIN.ystart
	  Gx.ydelta = HIN.ydelta
	  if (Gx.mframe.lt.0) then
	    Gx.mframe = -Gx.mframe
	    Gx.ydelta = HIN.ydelta/HIN.subsize*Gx.mframe
	  else
	    Gx.mframe = HIN.subsize
	  endif
	endif
	Gx.ymin = Gx.ystart
c
c get lines per screen switch
	Gx.lps = M$GET_SWITCH('LPS')
	Gx.lpf = max(1,M$GET_SWITCH('LPF'))
	Gx.lpb = M$GET_SWITCH_DEF('LPB',8)
	Gx.smooth = (Gx.lpb .ge. 0)
	Gx.lpb = max(1,abs(Gx.lpb))
	call M$FORCE1000 (HIN)
	HIN.xfer_len = Gx.mframe*Gx.lpb
c
c get widget control ids
        Gx.cntrls = M$GET_SWITCH_DEF ('XCNT',1)
c
c get other switches
	Gx.autoexit = .not. M$GET_SSWITCH('STAY')
	Gx.events = M$GET_SWITCH_DEF ('EVENTS',2)
C+++
C CMC - added compression
	Gx.cmp = M$GET_SWITCH_DEF ('CMP',1)
	Gx.cmp = min(max(1,Gx.cmp),5)
C---
	Gx.edge = .not. M$GET_SSWITCH ('NOEDGE')
	Gx.xf.msgmask = M$GET_SWITCH_DEF ('MASK',0)
	Gx.mimic = M$GET_SWITCH('MIMIC')
	Gx.xf.msgid = M$GET_SWITCH('MSGID')
	Gx.specs = .not. M$GET_SSWITCH('NOSPECS')
	Gx.wrap = Gx.lps.gt.0 .and. M$GET_SSWITCH('WRAP')
	Gx.ic = M$GET_SWITCH('XC')
#if _CNVX
c
c this is to handle a Convex compiler but, remove when fixed
	ch = HIN.format(2:2)
	Gx.type = ICHAR (ch)
#else
	Gx.type = ICHAR(HIN.format(2:2))
#endif
	Gx.fast = .not. M$GET_SSWITCH('EXACT')
	Gx.stretch = M$GET_SSWITCH('STRETCH')
	Gx.xlab = M$GET_SWITCH_DEF ('XLAB',HIN.xunits)
	Gx.ylab = M$GET_SWITCH_DEF ('YLAB',HIN.yunits)
	Gx.zlab = M$GET_SWITCH_DEF ('ZLAB',-1)
	if (M$GET_USWITCH('XFMT',Gx.xfmt) .le. 0)  Gx.xfmt = ' '
	if (M$GET_USWITCH('YFMT',Gx.yfmt) .le. 0)  Gx.yfmt = ' '
	if (M$GET_USWITCH('ZFMT',Gx.zfmt) .le. 0)  Gx.zfmt = ' '
c
c init parameters
	Gx.top   = 1
	Gx.rmin  = Gx.zmin
	Gx.rmax  = Gx.zmax
	Gx.jx1   = 1
	Gx.jx2   = Gx.mframe
	Gx.melem = 0
	Gx.hold  = 0
	Gx.ispec = 0
	Gx.nspec = 0
	Gx.nzspec = 0
	Gx.status = 0
	if (M$GET_USWITCH('SPECS',ch).lt.0) ch = ' '
	Gx.iabsc = M$SEARCH('IRS',ch)
	Gx.markm = 0
	if (M$GET_PSWITCH('MARK')) Gx.markm = -1
	Gx.marks = M$GET_SWITCH('MARK')
	if (M$GET_USWITCH('EDGEY',Gx.edgey) .le. 0) Gx.edgey = ' '
	Gx.ledgey = M$LENGTH(Gx.edgey)

#if _HOSTVERSION
c
c init the graphics setup
	call MX$GRAPHICSINIT ()
	call MXF$SETUP (Mx, Mc.width, Mc.height)
c
c the host version requires some tweeking of the input file header
c and if piped, a mapping to the pipe's header control block
c only go to asynchronous mode if default consume mode
	if (HIN.cons_len.eq.-1) HIN.cons_len = -2
	lPCB.p = 0
	if (HIN.pipe.ne.0) lPCB.p = M$PHEADLOC(HIN.file_lu)
	buftmpn(1) = 0
	buftmpn(2) = 0
	if (.not. M$GET_PSWITCH('LPB')) then	! default HOST behavior for no
	  Gx.lpb = 16				! LPB switch is 16 lines 
	  Gx.smooth = .true.
	endif
c
c let X-Midas do the reformatting for us
	HIN.buf_type = 'F'
	Gx.type = ICHAR('F')
	call M$VSTYPE('F')

#else

c
c init the graphics setup
	call MDX$SETUP (Mx, Mc.width, Mc.height)
c
c initialize dataflow structure counters
	call MD$INIT ()
c
c build data structure
	call MD$DATA (HIN)
c
c build block data structures, pass over command string for facilities switches
	call MD$BBLOCK (Mx,L_Mx)
	call MD$BBLOCK (Gx,L_Gx)
	call MD$ABLOCK (Mc.command_string(1:Mc.command_length))
c
c build results structures
	! no results
c
c submit the structure
	call MD$SUBMIT (MD_NODATA+MD_GRAPHIC)

#endif

c
c get autosync mode
	if (HIN.pipe.ne.0 .and. M$GET_SWITCH('ASYNC').gt.0) 
     &	  call M$CLOSE(HIN)
c
	return
	end


c************
c  Description: Host DSES for XRTRASTER routine
c
c  Author:	JGS   4/1/91
c
c  $Revision: 1.1 $
c  $Modtime:   17 May 1996 13:45:30  $
c  
c #_SUN OPTIMIZATION -O1
c
c************

#if !_HOSTVERSION

	subroutine MDS$XRTRASTER
c
	include 'xrtraster.inc'
	include 'midas.inc'
	include 'dsestypes.inc'
c
	record /M_PTR/ lMx,lGx,lcmd
	integer*4 invoke,lc
	common/md$context_xrtraster/ BOC,lMx,lGx,EOC
c
	invoke = MD$CHECKIN(BOC,EOC)
c
	if (invoke.eq.0) then

	  call MD$VSTYPE (MP_FLOAT)
	  lMx.p = MD$BLOCKDATA(1, lc)	  
	  lGx.p = MD$BLOCKDATA(2, lc)	  
	  lcmd.p = MD$BLOCKDATA(3, lc)
	  call M$MOVE(%val(lcmd.p), %val(%loc(Mc.command_string)), lc)
	  Mc.command_length = lc
	  Mc.switch_length = M$LENGTHD(Mc.command_string(1:lc)) + 1
	  call MX$SETCONTEXT (%val(lMx.p))
	  call XRTRASTER_INIT(%val(lMx.p), %val(lGx.p))
	  call XRTRASTER_REFRESH(%val(lMx.p),%val(lGx.p),0,1)

	elseif (invoke.gt.0) then

	  call MX$SETCONTEXT (%val(lMx.p))
	  if (XRTRASTER_RUN(%val(lMx.p),%val(lGx.p)).eq.0) call MD$PEBMODE(-2)

	elseif (invoke.eq.-1) then

	  call MX$SETCONTEXT (%val(lMx.p))
	  call XRTRASTER_END_ (%val(lMx.p),%val(lGx.p))

	endif
c
	return
	end

	subroutine XRTRASTER_SPECS_()
	implicit none
	include 'dses.inc'
	record /M_PTR/ lMx,lGx
	common/md$context_xrtraster/ BOC,lMx,lGx,EOC
	call XRTRASTER_SPECS (%val(lMx.p),%val(lGx.p))
	return
	end

	subroutine XRTRASTER_END_(Mx,Gx)
	include 'xrtraster.inc'
	call XRTRASTER_END(Mx, Gx, %val(Gx.sbuf.p))
	return
	end

#endif

	subroutine XRTRASTER_END (Mx, Gx, spec)
	include 'xrtraster.inc'
c Arguments
	record /SPECSTRUCT/ spec(*)
c Locals
	integer*4 is
c Code
	if (Gx.status .ge. 0) then
	  call M$FREE(Gx.map5.p)
	  call M$FREE(Gx.zspec.p)
	  call XRTRASTER_XF(Mx, Gx, 'A', L_CleanExit)
	  do is = 1, Gx.nspec
	    call M$FREE(spec(is).bsbuf.p)
	  enddo
	  call MX$CLOSE()
#if !_HOSTVERSION
	  call MD$PEBMODE(0)
#endif
	  call XRTRASTER_MSGDO(Mx, Gx, MSK_EXIT)
	  Gx.status = -1
	endif
c
	return
	end

	subroutine XRTRASTER_INIT (Mx, Gx)
	include 'xrtraster.inc'
	include 'midas.inc'
	integer*4 fps
c
c
c open window
	Mx.origin = 4
#if !_HOSTVERSION
	call MX$DOPEN (Mx,'X-RTRaster') 
#endif
c
c setup colormap and initial text size
	if (Gx.ncolor .lt.0) then	! greyscale
	  Gx.ic = 1
	  Gx.ncolor = -Gx.ncolor
	elseif (Gx.ic.lt.1 .or. Gx.ic.gt.4) then
	  Gx.ic = 2
	  if (Gx.cmode.eq.2) Gx.ic = 3
	endif
	call MX$COLORMAP (Mc.colormap(Gx.ic), Gx.ncolor)
	if (Gx.ncolor.eq.1) then
	  Mx.pixel(2) = Mx.pixel(1)
	  Mx.pixel(1) = Mx.black
	  Gx.ncolor = 2
	endif
	call MX$DRAW_MODE (901)         ! reset rubberband GC
c
c initialize counters and pointers, pre-allocate spec buf
	Gx.ispec = 0
	Gx.nspec = 0
	Gx.mspec = 10
	call M$MALLOC(Gx.mspec*L_SpecStruct, Gx.sbuf.p)
	Gx.nzspec = 0
	Gx.zspec.p = 0
	Gx.map5.p = 0
c
c init graphics stuff
	Mx.level = 1
	Gx.nelem = 0	! no data yet
	call XRTRASTER_XF(Mx, Gx, 'A', L_InitFacilities)
	call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 0)
	Gx.time = SECNDS(0.0)
	return
	end


c func
c	-1 - called to update Mx.stk and nothing else
c 	0 - INIT/RESIZE, called the first time to initialize the specs array
c 	    and called when a RESIZE occurs
c	1 - WRAP, called when the specs wrap around at the top
c	2 - CHANGE, called when parameters have changed through TRIM, REFRAME
c		or SET parameter messages
c	-999 - output debug information on specs array
c
	subroutine XRTRASTER_RESET (Mx, Gx, spec, func)
	include 'xrtraster.inc'
	include 'dsestypes.inc'
	integer*4 mtext, jx, jy, nx, ny, func, is, nbytes, jy_bs, ii
	integer*4 rwid, px, nnx
	record /SPECSTRUCT/ spec(*)
	real*8 rx,ry
	byte pbuf(1)
	pointer (pbuf_ptr, pbuf)

	if (func .eq. -999) then
	  do ii = 1, Gx.nspec
	    write(*,*) 'spec level ', ii
	    write(*,*) 'nx ', spec(ii).nx
	    write(*,*) 'x1 ', spec(ii).stk.x1
	    write(*,*) 'x2 ', spec(ii).stk.x2
	    write(*,*) 'xscl ', spec(ii).stk.xscl
	    write(*,*) 'xmin ', spec(ii).stk.xmin
	    write(*,*) 'xmax ', spec(ii).stk.xmax
	    write(*,*) 'xstart ', spec(ii).xstart
	    write(*,*) 'xdelta ', spec(ii).xdelta
	    write(*,*) 'y1 ', spec(ii).stk.y1
	    write(*,*) 'y2 ', spec(ii).stk.y2
	    write(*,*) 'ymin ', spec(ii).stk.ymin
	    write(*,*) 'ymax ', spec(ii).stk.ymax
	    write(*,*) 'ystart ', spec(ii).ystart
	    write(*,*) 'ydelta ', spec(ii).ydelta
	    write(*,*) 'nex ', spec(ii).nex
	    write(*,*) 'ney ', spec(ii).ney
	    write(*,*) 'bs ptr ', spec(ii).bsbuf.p
	    write(*,*) 'bs nbytes', spec(ii).nbytes
	    write(*,*) 'bs mbytes', spec(ii).mbytes
	    write(*,*) ' '
	  enddo
	  write(*,*) 'current spec level is ', Gx.ispec, ' out of ', Gx.nspec
	  write(*,*) ' '
	  return
	endif
c
c recompute the text width if called with init/resize function flag
	if (func.eq.0 .or. Mx.resize) then
	  mtext = min(8,Mx.width/67)
	  call MX$SETFONT (mtext)
	endif
c
c determine compression/expansion factors
	Gx.jx1 = max(1, min(Gx.jx1, Gx.mframe))
	Gx.jx2 = max(Gx.jx1, min(Gx.jx2, Gx.mframe))
	jx = max(1,Gx.jx2-Gx.jx1+1)
	rwid = max(1, Mx.width-2)
	if (jx .gt. rwid) then
	  Gx.ncx = 1 + NINT(float(jx-mod(jx,rwid)) / float(rwid))
	  Gx.nex = 1
	  rx = 1.0 / float(Gx.ncx)
	else
	  Gx.ncx = 1
	  Gx.nex = NINT(float(rwid - mod(rwid,jx)) / float(jx))
	  rx = float(Gx.nex)
	endif
	nx = rx*jx

	ry = max(1.0, float(Gx.lpf))
	jy_bs = 0
	if (Gx.lps.gt.0) then		! data frames per screen
	  jy = Gx.lps
	elseif (Gx.specs) then
	  jy = max(1,INT((Mx.height-Mx.text_h*2.75)/ry))
	  if (Gx.bs) jy_bs = max(1,INT((Mx.height-2)/ry)) - jy
	else
	  jy = max(1,INT((Mx.height-2)/ry))
	endif
	ny = jy*ry			! raster lines per screen
	Gx.ney = max(1,NINT(ry))

c
c update the spec() array depending on the func flag
	if (func.ge.0) then
	  if (Gx.ispec.gt.0 .and. func.ne.3) Gx.ymin = Gx.ymin +
     +		(Gx.top-spec(Gx.ispec).stk.y1) * spec(Gx.ispec).stk.yscl

	  if (func.eq.0) then			! init/reset
	    do is = 1, Gx.nspec
	      call M$FREE(spec(is).bsbuf.p)
	      spec(is).bsbuf.p = 0
	    enddo
	    Gx.ispec   = 1
	    Gx.nspec   = 1
	    Gx.top     = 1
	  else
	    is = Gx.ispec
c
c free up unused portion of current backing store buffer (if any)

	    if (spec(is).bsbuf.p .ne. 0) then
	      if (spec(is).nbytes .lt. spec(is).mbytes) then
		call M$MALLOC(spec(is).nbytes, pbuf_ptr)
		call M$MOVE(%val(spec(is).bsbuf.p), pbuf, spec(is).nbytes)
		call M$FREE(spec(is).bsbuf.p)
		spec(is).bsbuf.p = pbuf_ptr
		spec(is).mbytes = spec(is).nbytes
	      endif
	    endif

c
c Reset specs buffers for /STRETCH mode when window is resized.
	    if (Mx.resize) then
	      do is = 1, Gx.nspec
		px = min(spec(is).nx, spec(is).jx)
		if (Gx.stretch .and. mod(rwid,px).ne.0) then
		  nnx = rwid
		  spec(is).nex = -rwid
		elseif (px .gt. rwid) then
		  nnx = px / (1 + (px-1)/rwid)
		  spec(is).nex = -nnx
		else
		  spec(is).nex = rwid / px
		  nnx = spec(is).nex * px
		endif
		spec(is).stk.xscl = spec(is).xdelta * spec(is).jx / DBLE(nnx)
		spec(is).stk.x2 = spec(is).stk.x1 + nnx - 1
	      enddo
	    endif
c
c wrap around to the top of the screen
	    is = Gx.ispec
	    if (func.eq.1 .or. jy.le.NINT((Gx.top-1)/ry)) then
	      call M$MOVE(spec(1), spec(2), Gx.ispec*L_SpecStruct)
	      Gx.nspec = is + 1
	      Gx.ispec = 1
	      Gx.top = 1
c
c shift current specs down one and slip new one in
	    elseif (spec(is).stk.y2 .ge. spec(is).stk.y1) then
	      call M$MOVE(spec(is+1),spec(is+2),(Gx.nspec-is)*L_SpecStruct)
	      Gx.ispec = is + 1
	      Gx.nspec = Gx.nspec + 1
	    endif
	  endif
c
c initialize the plot ranges and set them into the spec() array
	  is = Gx.ispec
	  spec(is).jx = jx
	  spec(is).nx = nx
	  if (Gx.stretch .and. nx.ne.rwid) then
	    rx = DBLE(rwid) / DBLE(jx)
	    nx = rwid
	    Gx.nex = -rwid
	  endif

	  spec(is).stk.x1 = 1
	  spec(is).stk.x2 = 1+nx-1
	  spec(is).stk.xmin = Gx.xstart + (Gx.jx1-1)*Gx.xdelta
	  spec(is).stk.xmax = Gx.xstart + (Gx.jx2-1)*Gx.xdelta
	  spec(is).stk.xscl = Gx.xdelta/rx


	  spec(is).stk.y1 = Gx.top
	  spec(is).stk.y2 = Gx.top-1
	  spec(is).stk.ymin = Gx.ymin
	  jy = jy - NINT((Gx.top-1)/ry)
	  spec(is).stk.ymax = Gx.ymin + (jy-1)*Gx.ydelta
	  spec(is).stk.yscl = Gx.ydelta/ry

	  spec(is).xstart = Gx.xstart
	  spec(is).xdelta = Gx.xdelta
	  spec(is).ystart = Gx.ystart
	  spec(is).ydelta = Gx.ydelta
	  if (Gx.ledgey.gt.0) call M$DRSLT(Gx.edgey(1:Gx.ledgey), Gx.ystart)

	  spec(is).nex = Gx.nex
	  spec(is).ney = Gx.ney
	  spec(is).nbytes = 0
	  spec(is).bsbuf.p = 0
	  spec(is).mbytes = min(spec(is).nx,spec(is).jx) * (jy + jy_bs)

c
c We must always have at least one more spec() element than we are using
c if we do not, allocate 10 more slots and pass this address out to the
c datastreams context so it can be passed in to XRTRASTER_SPECS
	  if (Gx.nspec .ge. Gx.mspec) then
	    Gx.mspec = Gx.nspec + 10
	    call M$MALLOC(Gx.mspec*L_SpecStruct, pbuf_ptr)
	    call M$MOVE(%val(Gx.sbuf.p), pbuf, Gx.nspec*L_SpecStruct)
	    call M$FREE(Gx.sbuf.p)
	    Gx.sbuf.p = pbuf_ptr
	  endif

	endif

c
c Set up the stk structure to return pixel coordinates (not real coordinates)
	Mx.stk(1).x1 = 1
	Mx.stk(1).x2 = 1+nx-1
	Mx.stk(1).xmin = Mx.stk(1).x1
	Mx.stk(1).xmax = Mx.stk(1).x2
	Mx.stk(1).xscl = 1.d0

	Mx.stk(1).y1 = 1
	Mx.stk(1).y2 = 1+ny-1
	Mx.stk(1).ymin = Mx.stk(1).y1
	Mx.stk(1).ymax = Mx.stk(1).y2
	Mx.stk(1).yscl = 1.d0

	return
	end


c  func
c	A: unzoom all zoom levels and clear window
c	B: redraw image
c	C: draw specs and color bar
c
c   -1  Resize or init: ABC
c    0  Exposure: (no BS?) C, (zoomed ?) BC, else ABC
c    1  Reset due to changed parameters: C
c

	subroutine XRTRASTER_REFRESH (Mx, Gx, spec, func)
	include 'xrtraster.inc'
c Arguments
	integer*4 func
	record /SPECSTRUCT/ spec(*)
c Locals
	integer*4 ix,iy,j1,j2,i1,i2,ic,j,nx,ny,is,nxf

	! resize or expose
	if (func.le.0) then
	  if (func.lt.0 .or. (Gx.bs .and. Mx.level.eq.1)) then
	    nxf = Gx.nxf	! no need to erase and redraw annotations
	    Gx.nxf = 0		! since we're clearing the window anyways
	    call XRTRASTER_UNZOOM(Mx, Gx, 1)
	    call MX$CLEAR_WINDOW()
	    Gx.markp.x = -1
	    Gx.nxf = nxf
	  else
	    j1 = Mx.stk(1).y2+1 
	    j2 = Mx.height - j1
	    if (j2.gt.0) call MX$CLEAR_AREA (0, j1, Mx.width, j2)
	    if (Gx.nxf.gt.0) call XRTRASTER_XF(Mx, Gx, 'A', -2)
	  endif
	endif

	if (Mx.icon) return

	! refresh backing store
	if (func.le.0 .and. Gx.bs) then

	  if (Gx.bs) then
	    iy = spec(1).stk.y1
	    do is = 1, Gx.nspec
	      ny = (spec(is).stk.y2 - spec(is).stk.y1 + 1) / spec(is).ney
	      if (ny .gt. 0) then
		i1 = 0
		nx = min(spec(is).nx, spec(is).jx)
		if (spec(is).stk.y1 .lt. iy) then
		  j = (spec(is).stk.y2 - iy + 1) / spec(is).ney
		  i1 = nx * (ny - j)
		  ny = j
		else
		  iy = spec(is).stk.y1
		endif
		if (ny.gt.0) then
	          if (spec(is).nbytes .gt. 0) call MX$PUT_IMAGE(
     +			%val(spec(is).bsbuf.p+i1),
     +			nx, ny, spec(is).nex, spec(is).ney,
     +			spec(is).stk.x1, iy, 0)
		  iy = iy + ny * spec(is).ney
		endif
	      endif
	    enddo
	  endif

	  if (Gx.edge) then
	    if (Mx.level.eq.1 .or. Gx.top.lt.Mx.stk(2).y1 .or.
     +					Gx.top.gt.Mx.stk(2).y2) then
	      call MX$DRAW_LINE (-1, 1, Gx.top, Mx.stk(1).x2, Gx.top)
	    else
	      call MX$DRAW_LINE (-1, 1, Gx.top, 4, Gx.top)
	    endif
	  endif
	endif
c
c draw colormap bar and current specs
	Gx.ixlab = Gx.xlab
	Gx.iylab = Gx.ylab
	Gx.izlab = Gx.zlab	! TBD: adjust for complex modes
	if (Gx.specs) then
	  j1 = Mx.height - Mx.text_h*2.25
	  j2 = Mx.height - Mx.text_h*0.5
	  i1 = Mx.text_w*65.75
	  i2 = Mx.text_w*66.75
	  do j = j1,j2
	    ic = Gx.ncolor*(j2-j)/(j2-j1+1) + 1
	    call MX$DRAW_LINE (ic,i1,j,i2,j)
	  enddo
	  call MX$TEXTLINE (i1-2,j1-2,i2+2,j1-2)
	  call MX$TEXTLINE (i2+2,j1-2,i2+2,j2+2)
	  call MX$TEXTLINE (i2+2,j2+2,i1-2,j2+2)
	  call MX$TEXTLINE (i1-2,j2+2,i1-2,j1-2)

	  call XRTRASTER_SPECS (Mx,Gx)
	endif

	if (func.le.0 .and. Gx.nxf.gt.0) call XRTRASTER_XF(Mx, Gx, 'A', L_Draw)

	return
	end

	function XRTRASTER_RUN (Mx, Gx)
	include 'xrtraster.inc'
	include 'midas.inc'
	include 'dsestypes.inc'
	integer*4 nelem
	real*4 inbuf, fbuf
	pointer (inbuf_ptr, inbuf)
	pointer (fbuf_ptr, fbuf)
c
c handle events and messages
	Gx.status = 0
	call XRTRASTER_EVENT(Mx,Gx)
	call XRTRASTER_MSG(Mx,Gx)
c
c handle next block of data
	if (.not. Mx.breakflag .and. Gx.hold.lt.2 .and. Mu.todo.ne.0) then
	  nelem = MD$BUFAVAILNEXT(1,1)
	  nelem = min(nelem/Gx.mframe, Gx.lpb)
	  if (Mu.todo.gt.0 .and. nelem.ge.Mu.todo) then
	    nelem = Mu.todo
	  elseif (nelem.lt.Gx.lpb) then
	    if (.not. Gx.smooth .or. SECNDS(Gx.time).lt.0.05) nelem = 0
	  endif
	  if (nelem.gt.0) then
	    Gx.status = Gx.status + 1
	    call MD$SETBUFXFER(1, nelem*Gx.mframe)
	    inbuf_ptr = MD$BUFIN(1, Gx.nelem, Gx.type)
	    if (Mu.todo.gt.0) Mu.todo = Mu.todo - nelem
	    if (Gx.cx) then
	      fbuf_ptr = MD$BUFTMP(2, Gx.nelem*2, MP_FLOAT)
	    else
	      fbuf_ptr = MD$BUFTMP(2, Gx.nelem, MP_FLOAT)
	    endif
	    call XRTRASTER_PREP(Mx, Gx, inbuf, fbuf)
	    call XRTRASTER_PLOT(Mx, Gx, fbuf, %val(Gx.sbuf.p))
	  elseif (MD$BUFOPEN(1).eq.0 .and. Gx.autoexit) then
	    Mx.breakflag = .true.
	  endif
	endif

	if (Mx.breakflag) call XRTRASTER_END(Mx, Gx, %val(Gx.sbuf.p))
	XRTRASTER_RUN = Gx.status
c
	return
	end

	subroutine XRTRASTER_EVENT (Mx,Gx)
	include 'xrtraster.inc'
	include 'midas.inc'
	include 'dsestypes.inc'
	integer*4 ix1,iy1,ix2,iy2,item
	integer*4 imode,idef,lcolor,ls,evs,i,j,frame,optmask
	character cspec*20
	real*4 dbscale

	if (Gx.hold .ge. 2) return
	evs = 0
	do while (.not. Mx.breakflag .and. evs.lt.Gx.events)

	  if (.not. MX$IFEVENT()) return
	  Gx.status = Gx.status + 1
	  evs = evs + 1

	  if (Mx.motion_notify .or. Mx.resize .or. Mx.exposure) then
	    ! handled at the bottom of the routine

	  elseif (Mx.button_press.eq.1) then
	    call MX$RUBBERBOX (ix1,iy1,ix2,iy2,%val(Gx.xf.ROUTINE.p))
	    if (Mx.button_release.ne.1) then
	    elseif (ix2-ix1.lt.5 .and. iy2-iy1.lt.5) then	! set origin
              call XRTRASTER_SPECS (Mx,Gx)
	      Gx.xmrk = Gx.retx 
	      Gx.ymrk = Gx.rety
	      if (Gx.cntrls.eq.1) then
		call M$DRSLT (Mx.xtag,Gx.retx)
		call M$DRSLT (Mx.ytag,Gx.rety)
		call M$DRSLT (Mx.xytag,Gx.retx+Gx.rety)
	      endif
	      call XRTRASTER_MSGDO (Mx,Gx,MSK_MARK)
	    elseif (ix2-ix1.gt.5 .and. iy2-iy1.gt.5) then	! zoom
	      call XRTRASTER_ZOOM(Mx, Gx, ix1, iy1, ix2, iy2, %val(Gx.sbuf.p))
	    endif 

	  elseif (Mx.button_press.eq.3) then		! unzoom
	    call XRTRASTER_UNZOOM (Mx,Gx,Mx.level-1)

	  elseif (Mx.button_press.eq.2 .or. Mx.key_upchar.eq.'M') then	! menu

	    item = MX$MENU (0,'X-RTRASTER;Refresh,Cntrls...,'//
     &                    'CX Mode...,Frame...,Trim...,Scale...,'//
     &			  'Colormap...,Settings...,Annotate...,Exit')

	    if (item.eq.1) then				! refresh
	      if (Gx.bs) then
		Mx.exposure = .true.
	      else
		Mx.resize = .true.
	      endif


	    elseif (item.eq.2) then			! controls option

	      if (Gx.cntrls.ge.0) then
		item = MX$MENU (iabs(Gx.cntrls)+1,'CONTROLS OPTIONS;'//
     &		  'Off,LM Click,Continuous,Assign...')
	      else
		item = MX$MENU (iabs(Gx.cntrls)+1,'CONTROLS OPTIONS;'//
     &		  'Off,LM Click (Disabled),Continuous (Disabled),Assign...')
	      endif
              if (item.le.3) then
                Gx.cntrls = isign(item - 1, Gx.cntrls)
              else
		call MX$PROMPT ('Mouse X location -> ',Mx.xtag)
		call M$UPPERCASE (Mx.xtag)
		call MX$PROMPT ('Mouse Y location -> ',Mx.ytag)
		call M$UPPERCASE (Mx.ytag)
		call MX$PROMPT ('Mouse X+Y location -> ',Mx.xytag)
		call M$UPPERCASE (Mx.xytag)
	      endif

	    elseif (item.eq.3) then			! change complex mode
	      imode = MX$MENU (Gx.cmode,'COMPLEX MODE;Magnitude,'//
     &		'Phase,Real,Imaginary,10*Log10,20*Log10')
	      call XRTRASTER_CMODE(Mx, Gx, imode)

	    elseif (item.eq.4) then			! reframe
	      frame = Gx.mframe
	      call MX$LPROMPT ('Frame: ', frame)
	      if (frame.gt.0 .and. frame.ne.Gx.mframe) then
		call XRTRASTER_REFRAME (Mx, Gx, frame, 0)
		call XRTRASTER_RESET (Mx, Gx, %val(Gx.sbuf.p), 2)
	      endif
	      ! call MX$MESSAGE ('Not implemented yet',1.0)

	    elseif (item.eq.5) then			! trim
	      item = MX$MENU(0,'TRIM WINDOW;via Mouse,via Index...,Full Range')
	      ix1 = Gx.jx1
	      ix2 = Gx.jx2
	      if (item.eq.1) then
		call MX$MESSAGE('Click on left edge',-1.0)
		call XRTRASTER_SPECS (Mx,Gx)
		Gx.jx1  = (Gx.retx-Gx.xstart)/Gx.xdelta
		call MX$MESSAGE('Click on right edge',-1.0)
		call XRTRASTER_SPECS (Mx,Gx)
		Gx.jx2  = (Gx.retx-Gx.xstart)/Gx.xdelta
	      elseif (item.eq.2) then
		call MX$LPROMPT ('Left Edge Index:', Gx.jx1)
		call MX$LPROMPT ('Right Edge Index:',Gx.jx2)
	      elseif (item.eq.3) then
		Gx.jx1 = 1
		Gx.jx2 = Gx.mframe
	      endif
	      if (ix1.ne.Gx.jx1 .or. ix2.ne.Gx.jx2) then
		call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 2)
	      endif

	    elseif (item.eq.6) then			! scale
	      idef = Gx.iautom+2
	      item = MX$MENU(idef,'SCALING;Threshold...,Parameters...,'//
     &          'Auto Min...,Auto Max...,Auto Full...,Auto Fix...')
	      Gx.iautom = item-2
	      if (Gx.cmode.ge.5) then
		cspec = '(dB): '
		i = 6
	      else
		cspec = ': '
		i = 2
	      endif
	      if (Gx.iautom.eq.-1) then
		Gx.rmin = 0.5*(Gx.zmin+Gx.zmax)
		call MX$FPROMPT('Threshold'//cspec(1:i), Gx.rmin)
		Gx.rmax = Gx.rmin
	      elseif (Gx.iautom.eq.0) then
		call MX$FPROMPT('Minimum'//cspec(1:i), Gx.zmin)
		call MX$FPROMPT('Maximum'//cspec(1:i), Gx.zmax)
		Gx.rmin = Gx.zmin
		Gx.rmax = Gx.zmax
	      elseif (Gx.iautom.eq.4) then
		call MX$FPROMPT('AutoMin Fix'//cspec(1:i), Gx.rmin)
		call MX$FPROMPT('AutoMax Fix'//cspec(1:i), Gx.rmax)
	      else
		if (Gx.cmode.ge.5 .and.
     &		  (Gx.iautom.eq.1 .or. Gx.iautom.eq.3))
     &		  call MX$FVAL('dB Range: ',Gx.dbrange,0.0,
     &                          300.0,5.0,0)
		call MX$LPROMPT('Number lines in average: ',Gx.iautol)
	      endif
	      if (Gx.cmode.ge.5) then
		dbscale = 10.0
		if (Gx.cmode.eq.6) dbscale = dbscale * 2.0
		if (Gx.cx) dbscale = dbscale / 2.0
		Gx.rmin = max(Gx.rmin, -37*dbscale)
		Gx.rmax = min(Gx.rmax,  37*dbscale)
		if (Gx.iautom.eq.0) then
		  Gx.zmin = Gx.rmin
		  Gx.zmax = Gx.rmax
		endif
	      endif
	      call XRTRASTER_SPECS (Mx,Gx)

 	    elseif (item.eq.7) then			! color
	      item = MX$MENU(Gx.ic,'COLORMAP;Greyscale,Ramp Colormap,'//
     &          'Color Wheel,Spectrum,Local,Adjust...')
	      if (item.eq.5 .and. Gx.map5.p.eq.0) item = 6

	      if (item.eq.6) then
		if (Gx.map5.p.eq.0) call M$MALLOC(56, Gx.map5.p)
		if (Gx.ic.ne.5) then
		  call M$MOVE(Mc.colormap(Gx.ic), %val(Gx.map5.p), 56)
		  Gx.ic = 5
		endif
		call MX$COLORMAP(%val(Gx.map5.p), -1)
		call XRTRASTER_MSGDO (Mx,Gx,MSK_COLOR)
	      elseif (item.ne.Gx.ic) then
		Gx.ic = item
		if (item.eq.5) call MX$COLORMAP(%val(Gx.map5.p), Gx.ncolor)
		if (item.ne.5) call MX$COLORMAP (Mc.colormap(item), Gx.ncolor)
		call XRTRASTER_MSGDO (Mx,Gx,MSK_COLOR)
	      endif

	    elseif (item.eq.8) then			! settings menu

	      optmask = 0
	      if (Gx.bs) optmask = IBSET (optmask,t_bs)
	      if (Gx.edge) optmask = IBSET (optmask,t_edge)
	      if (Gx.smooth) optmask = IBSET (optmask,t_smooth)
	      if (Gx.specs) optmask = IBSET (optmask,t_specs)
	      if (Gx.wrap) optmask = IBSET (optmask,t_wrap)
C+++
C CMC - ADD Compression
	      i = MX$MENUPLUS (optmask, 'SETTINGS;AUTO Scaling...,'//
     &		'AUTOLines/Avg...,#Backing Store,Cntrls...,#EDGE,'//
     &		'EVENTS/Pass...,CoMPression...,Lines/Frame...,'//
     &		'Frames/Screen...,MARKer Mode...,MARKer Size...,'//
     &		'MIMIC Id...,MSGID...,#Smooth Plot,#SPECS,#WRAP Specs',
     &		   L_CBautomask, L_CBitem, 0)
C---
	      if (i.eq.t_auto) then
		j = MX$MENU(Gx.iautom+2,'SCALING;Threshold...,Parameter'//
     &		  's...,Auto Min...,Auto Max...,Auto Full...,Auto Fix...') - 2
	      elseif (i.eq.t_autol) then
		j = Gx.iautol
		call MX$LPROMPT ('Lines in Average: ', j)
	      elseif (i.eq.t_cntrls) then
		j = MX$MENU (Gx.cntrls+3,'CONTROLS OPTIONS;'//
     &		  'Continuous (Disabled),LM Click (Disabled),Off,'//
     &		  'LM Click,Continuous') - 3
	      elseif (i.eq.t_events) then
		j = Gx.events
		call MX$LPROMPT ('Events Processed Per Pass: ', j)
C+++
C CMC - ADD Compression
	      elseif (i.eq.t_cmp) then
	        j = MX$MENU (Gx.cmp,'COMPRESSION METHOD;Average,Min Value,'//
     &		    'Max Value,First Element,Max ABS Value')
	        Gx.cmp = min(max(1,j),5)
C---
	      elseif (i.eq.t_lpf) then
		j = Gx.lpf
		call MX$LPROMPT ('Lines/Frame: ', j)
	      elseif (i.eq.t_lps) then
		j = Gx.lps
		call MX$LPROMPT ('Lines/Screen: ', j)
	      elseif (i.eq.t_mimic) then
		j = Gx.mimic
		call MX$LPROMPT ('Primitive to MIMIC: ', j)
	      elseif (i.eq.t_msgid) then
		j = Gx.xf.msgid
		call MX$LPROMPT ('MSGID to report to: ', j)
	      elseif (i.eq.t_wrap .and. Gx.lps.le.0) then
		call M$BEEP (1, 0.0)
		call MX$MESSAGE ('/LPS=n (Lines/Screen) must be asserted '//
     &				 'to toggle this feature on.', -1.0)
	      elseif (i.eq.t_markm) then
		j = MX$MENU(min(4,Gx.markm+3),
     &			'MARKER MODE;Origin,Peak,Off,Index...')-3
		if (j.eq.1) call MX$LPROMPT
     &			('Marker Index: ', j)
	      elseif (i.eq.t_marks) then
		j = Gx.marks
		call MX$LPROMPT('Marker Size: ', j)
	      else
		j = -1
	      endif
	      call XRTRASTER_SETTINGS (Mx, Gx, i, j)

	    elseif (item.eq.9) then			! annotate
	      call XRTRASTER_XF(Mx, Gx, 'A', L_Interactive)

	    elseif (item.eq.10) then			! exit
	      if (Mx.noexit.gt.1) call MX$MESSAGE ('Exit disabled', 1.0)
	      if (Mx.noexit.le.1) Mx.breakflag = .true.
	    endif

	  elseif (Mx.key_char.ge.'0'.and.Mx.key_char.le.'9') then ! markers
	    call XRTRASTER_SPECS (Mx,Gx)
	    call M$DRSLT(Gx.mouse(1:Gx.imouse)//'_X'//Mx.key_char,Gx.retx)
	    call M$DRSLT(Gx.mouse(1:Gx.imouse)//'_Y'//Mx.key_char,Gx.rety)
	    call M$BEEP (1,0.0)

	  elseif (Mx.key_upchar.eq.'?') then      ! help
	    call MX$MHELP('X-RTRASTER','Primitive')

	  elseif (Mx.key_upchar.eq.'A') then 	! toggle abscissa
	    Gx.iabsc = mod(Gx.iabsc+1,4)

	  elseif (Mx.key_upchar.eq.'S') then 	! toggle specs
	    call XRTRASTER_SETTINGS (Mx, Gx, t_specs, -1)

	  elseif (Mx.key_upchar.eq.'X') then 	! show X
	    ls = M$D2A (Gx.aretx,cspec)
            if (Gx.iabsc.eq.1) then
              call MX$MESSAGE('INDEX = '//cspec(1:ls), -1.0)
            elseif (Gx.iabsc.eq.2) then
              call MX$MESSAGE('1/X = '//cspec(1:ls), -1.0)
            else
              if (Gx.ixlab.eq.4) ls = M$SEC2TSPEC (Gx.aretx,cspec,0)
              call MX$MESSAGE('X = '//cspec(1:ls), -1.0)
            endif

	  elseif (Mx.key_upchar.eq.'Y') then 	! show Y
	    ls = M$D2A (Gx.arety,cspec)
            if (Gx.iabsc.eq.2) then
              call MX$MESSAGE('1/Y = '//cspec(1:ls), -1.0)
            else
              if (Gx.iylab.eq.4) ls = M$SEC2TSPEC (Gx.arety,cspec,0)
              call MX$MESSAGE('Y = '//cspec(1:ls), -1.0)
            endif

	  elseif (Mx.key_upchar.eq.'C') then 	! toggle cntrls
	    Gx.cntrls = -Gx.cntrls

C+++
C CMC - ADD Compression
	  elseif (Mx.key_upchar.eq.'R') then 	! show compression
	    if (Gx.ncx.gt.1) then
	      write (cspec(1:5),'(i4,a)') Gx.ncx,'x'
              call MX$MESSAGE('X compression: '//cspec(1:5), -1.0)
	    elseif (Gx.nex.gt.1) then
	      write (cspec(1:5),'(i4,a)') Gx.nex,'x'
              call MX$MESSAGE('X expansion: '//cspec(1:5), -1.0)
	    else
              call MX$MESSAGE('Image fully resolved', -1.0)
	    endif
C---

	  elseif (Mx.key_press.eq.13) then	! the END (except in pipe)
	    if (Mx.noexit.le.0) Mx.breakflag = .true.

	  endif

	  if (Mx.resize) then
	    call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 2)
	    call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), 0)
	  elseif (Mx.exposure) then
	    call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), 0)
	  else
	    call XRTRASTER_SPECS (Mx,Gx)
	  endif

	  if (Mx.motion_notify .and. Gx.cntrls.eq.2) then
	    call M$DRSLT (Mx.xtag,Gx.retx)
	    call M$DRSLT (Mx.ytag,Gx.rety)
	    call M$DRSLT (Mx.xytag,Gx.retx+Gx.rety)
	  endif

	enddo

	return
	end


	subroutine XRTRASTER_MSG (Mx,Gx)

	include 'xrtraster.inc'
	include 'tables.inc'
	include 'midas.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	integer*4 nmodes
	parameter (nmodes=8)
	character*2 cxm(nmodes) /'MA','PH','RE','IM','LO','L2','D1','D2'/
	integer*4 i, j, x1, x2, y1, y2, info, sid, mimic, msgid
	integer*4 flag
	real*8 dval, dscl

	do while (Mu.todo.le.0 .and. .not. Mx.breakflag)

	  if (M$GET_MSG(MQH,MQD,L_mqd,0.0,0).le.0) return

	  Gx.status = Gx.status + 1

	  info = MQH.info
	  sid = MQH.sender
	  mimic = Gx.mimic
	  msgid = Gx.xf.msgid

	  Gx.xf.iarg = MQH.info
	  Gx.xf.mqdloc.p = %loc(MQD)

	  ! Do not echo actions caused by an id to that id, unless MSK_ECHO set
	  if (.not. BTEST(Gx.xf.msgmask,MSK_ECHO)) then
	    if (msgid.gt.0 .and. msgid.eq.sid) Gx.xf.msgid = -1
	    if (mimic.gt.0 .and. mimic.eq.sid) Gx.mimic = -1
	  endif

	  if (MX$MIMIC_MSG(MQH,MQD,mimic).lt.0) then
	    ! info message, but unrecognized or we're not mimicing

	  elseif (MX$GRAPHICS_MSG(Mx,MQH,MQD,msgid,Gx.xf.msgmask).ne.0) then
	    if (Mx.breakflag) return ! return now so that noecho works

	  elseif (MQH.name .eq. MQH_QUERY.name) then
	    Gx.xf.msgid = msgid
	    if (MQD.QUERY.object .eq. MQH_CXMODEINFO.name) then
	      call XRTRASTER_INFOMSG (Mx, Gx, MSK_CXMODE, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_COLORMAPINFO.name) then
	      call XRTRASTER_INFOMSG (Mx, Gx, MSK_COLOR, info, sid)
	    elseif (MQD.QUERY.object .eq. MQH_MARKINFO.name) then
	      call XRTRASTER_INFOMSG (Mx, Gx, MSK_MARK, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_PLOTINFO.name) then
	      call XRTRASTER_INFOMSG (Mx, Gx, -1, info+1, sid)
	    elseif (MQD.QUERY.object .eq. MQH_ZOOMINFO.name) then
	      call XRTRASTER_INFOMSG (Mx, Gx, MSK_ZOOM, info+1, sid)
	    endif

	  elseif (MQH.name .eq. MQH_ANNOTATE.name) then
	    call XRTRASTER_XF(Mx, Gx, 'A', 3)

	  elseif (MQH.name .eq. MQH_COLORMAP.name) then
	    if (info.le.4 .and. info.ne.Gx.ic) then
	      if (info.le.0) then
	        Gx.ic = 5
	        if (Gx.map5.p.eq.0) call M$MALLOC(56, Gx.map5.p)
	        call M$MOVE(MQD.COLORMAP, %val(Gx.map5.p), 56)
	        call MX$COLORMAP(%val(Gx.map5.p), Gx.ncolor)
	      else
		Gx.ic = info
		call MX$COLORMAP (Mc.colormap(Gx.ic), Gx.ncolor)
	      endif
	      call XRTRASTER_MSGDO (Mx,Gx,MSK_COLOR)
	    endif

	  elseif (MQH.name .eq. MQH_CXMODE.name) then
	    do i = 1, nmodes
	      if (cxm(i).eq.MQD.CXMODE.mode) call XRTRASTER_CMODE(Mx, Gx, i)
	    enddo

	  elseif (MQH.name .eq. 'DEBUG') then
	    call XRTRASTER_RESET(Mx,Gx,%val(Gx.sbuf.p),-999)

	  elseif (MQH.name .eq. MQH_MARK.name) then
	    Gx.xmrk = MQD.MARK.x
	    Gx.ymrk = MQD.MARK.y
	    if (Gx.cntrls.gt.0) then
	      call M$DRSLT (Mx.xtag, Gx.xmrk)
	      call M$DRSLT (Mx.ytag, Gx.ymrk)
	      call M$DRSLT (Mx.xytag, Gx.xmrk+Gx.ymrk)
	    endif
            call XRTRASTER_SPECS (Mx,Gx)
	    call XRTRASTER_MSGDO (Mx,Gx,MSK_MARK)

	  elseif (MQH.name .eq. MQH_NEWFILE.name) then
	    if (MQD.NEWFILE.arg1 .eq. 3) call XRTRASTER_XF(Mx, Gx, 'A', 6)

          elseif (MQH.name .eq. MQH_SET.name .or.
     +		  MQH.name .eq. MQH_SETD.name) then
	    if (MQH.name .eq. MQH_SETD.name) then
	      dval = MQD.SETD.value
	      info = dval
	    else
	      dval = info
	    endif
C+++
C CMC - ADD Compression
	    i = (M$SEARCH('AUTO    ,AUTOL   ,BS      ,CONTROLS,EDGE    ,'//
     +			  'EVENTS  ,CMP     ,LPF     ,LPS     ,MARKMODE,'//
     +                    'MARKSIZE,'//
     +			  'MIMIC   ,MSGID   ,SMOOTH  ,SPECS   ,WRAP    ,',  
     +			MQD.SET.object(1:8)//',') + 8) / 9
C---
	    if (i.eq.t_mimic) then
	      mimic = info
	    elseif (i.eq.t_msgid) then
	      msgid = info
	    elseif (i.ne.0) then
	      call XRTRASTER_SETTINGS (Mx, Gx, i, info)
	      if (i.eq.t_cntrls) call XRTRASTER_SPECS (Mx,Gx)
	    elseif (MQD.SET.object .eq. 'HOLD') then
	      Gx.hold = info
	    elseif (MQD.SET.object .eq. 'RESET') then
	      Mx.resize = .false.
	      call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 0)
	      call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), -1)
	    else
	      Mx.exposure = .true.
	      if (MQD.SETD.object .eq. 'FRAME') then
		i = MQD.SETD.value
		info = MQH.info
		call XRTRASTER_REFRAME (Mx, Gx, i, info)
	      elseif (MQD.SETD.object .eq. 'SCALEMIN') then
		Gx.zmin = dval
		Gx.rmin = Gx.zmin
		Mx.exposure = .false.
		call XRTRASTER_SPECS (Mx,Gx)
	      elseif (MQD.SETD.object .eq. 'SCALEMAX') then
		Gx.zmax = dval
		Gx.rmax = Gx.zmax
		Mx.exposure = .false.
		call XRTRASTER_SPECS (Mx,Gx)
	      elseif (MQD.SETD.object .eq. 'XSTART') then
		if (MQH.info.eq.0) then
		  x1 = NINT((Gx.xstart-dval)/Gx.xdelta)
		  Gx.jx1 = max(1, min(Gx.mframe, Gx.jx1+x1))
		  Gx.jx2 = max(1, min(Gx.mframe, Gx.jx2+x1))
		endif
		Gx.xstart = dval
	      elseif (MQD.SETD.object .eq. 'XDELTA') then
		if (dval .eq. 0.d0) dval = 1.d0
		if (MQH.info.eq.0) then
		  dscl = Gx.xdelta / dval
		  Gx.jx1 = max(1, min(Gx.mframe, NINT(dscl*Gx.jx1)))
		  Gx.jx2 = max(1, min(Gx.mframe, NINT(dscl*Gx.jx2)))
		endif
		Gx.xdelta = dval
	      elseif (MQD.SETD.object .eq. 'YSTART') then
		Gx.ymin = dval
		Gx.ystart = Gx.ymin
		call XRTRASTER_RESET(Mx,Gx,%val(Gx.sbuf.p),3)
		Mx.exposure = .false.
	      elseif (MQD.SETD.object .eq. 'YDELTA') then
		Gx.ydelta = dval
	      else
		Mx.exposure = .false.
	      endif
	      if (Mx.exposure) call XRTRASTER_RESET(Mx,Gx,%val(Gx.sbuf.p),2)
            endif

	  elseif (MQH.name .eq. MQH_TRIM.name) then
	    if (MQH.info .eq. 0) then		! index
	      x1 = NINT(MQD.TRIM.x1)
	      x2 = NINT(MQD.TRIM.x2)
	    elseif (MQH.info.gt.0) then		! abscissa
	      x1  = (MQD.TRIM.x1-Gx.xstart)/Gx.xdelta
	      x2  = (MQD.TRIM.x2-Gx.xstart)/Gx.xdelta
	    else				! full range
	      x1 = 1
	      x2 = Gx.mframe
	    endif
	    x1 = max (1, x1)	
	    x2 = min (Gx.mframe, x2)	
	    if (x1.le.x2 .and. (x1.ne.Gx.jx1 .or. x2.ne.Gx.jx2)) then
	      Gx.jx1 = x1
	      Gx.jx2 = x2
	      call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 2)
	    endif

	  elseif (MQH.name .eq. MQH_UNZOOM.name) then
	    call XRTRASTER_UNZOOM (Mx,Gx,info+1)

	  elseif (MQH.name .eq. MQH_ZOOM.name) then
	    if (Mx.level.lt.10) then			! Put Zoom
	      i = Mx.level
c TODO: need to convert the stk structure here to real world
	      if (MQD.ZOOM.xmin .lt. MQD.ZOOM.xmax) then
		dval = 1.d0 / Mx.stk(i).xscl
		if (dval .ge. 0.d0) then
		  x1 = Mx.stk(i).x1 + NINT((MQD.ZOOM.xmin-Mx.stk(i).xmin)*dval)
		  x2 = Mx.stk(i).x2 + NINT((MQD.ZOOM.xmax-Mx.stk(i).xmax)*dval)
		else
		  x1 = Mx.stk(i).x1 + NINT((MQD.ZOOM.xmax-Mx.stk(i).xmin)*dval)
		  x2 = Mx.stk(i).x2 + NINT((MQD.ZOOM.xmin-Mx.stk(i).xmax)*dval)
		endif
	      else
		x1 = Mx.stk(i).x1
		x2 = Mx.stk(i).x2
	      endif
	      if (MQD.ZOOM.ymin .lt. MQD.ZOOM.ymax) then
		dval = 1.d0 / Mx.stk(i).yscl
		if (dval .ge. 0.d0) then
		  y1 = Mx.stk(i).y1 + NINT((MQD.ZOOM.ymin-Mx.stk(i).ymin)*dval)
		  y2 = Mx.stk(i).y2 + NINT((MQD.ZOOM.ymax-Mx.stk(i).ymax)*dval)
		else
		  y1 = Mx.stk(i).y1 + NINT((MQD.ZOOM.ymax-Mx.stk(i).ymin)*dval)
		  y2 = Mx.stk(i).y2 + NINT((MQD.ZOOM.ymin-Mx.stk(i).ymax)*dval)
		endif
	      else
		y1 = Mx.stk(i).y1
		y2 = Mx.stk(i).y2
	      endif
	      call XRTRASTER_ZOOM(Mx, Gx, x1, y1, x2, y2, %val(Gx.sbuf.p))
	    endif

	  elseif (MQH.name .eq. MQH_XTODO.name) then
	    Mu.todo = NINT(MQD.XTODO.amount)
	    if (Mu.todo .gt. 0) Gx.hold = min(Gx.hold,1)

	  else
	    Gx.status = Gx.status - 1
	  endif

	  Gx.mimic = mimic
	  Gx.xf.msgid = msgid

	enddo

	return
	end


	subroutine XRTRASTER_PLOT (Mx, Gx, A, spec)

	include 'xrtraster.inc'
	include 'constants.inc'
	include 'dsestypes.inc'
	integer*4 L_bbuf
	parameter (L_bbuf=16)
	include 'buffers.inc'
c Parameters
	record /BUFFER/ A
	record /SPECSTRUCT/ spec(*)
c Locals
	record /BUFFER/ DB
C+++
C CMC - ADD Compression
	real*4    fmin, fmax, fscale, qmin, qmax, amax
	real*4	  fac, dbscale, rind, rdelt
	logical*4 threshold
	integer*4 k, i, n, j, nfr, nnf, nfro, lines, is, ndel
	integer*4 ix, nn, nnn
C---
	integer*2 idbmin, idbmax
	byte      t0, t1, pbuf(1)
	pointer (pbuf_ptr, pbuf)
	integer*4 idbmagindex       ! location of exponent in float value
	integer*4 imax		    ! mark max index
	byte pix(*)
	pointer (pix_ptr, pix)
	real*8   lineY		!djm Tracks the value of the "new data line"

#if _EEEI
	parameter (idbmagindex=2)   ! exponent in last 2 bytes
#else
	parameter (idbmagindex=1)   ! exponent in first 2 bytes
#endif
c
	if (Gx.nelem .le. 0) return
	lines = Gx.nelem / Gx.mframe
c
c remove old mark
	if (Gx.markp.x .ne. -1) then
	  call XRTRASTER_MARKER (Mx,Gx,0)
	endif
c
c calculate new marker X-location
	if (Gx.markm.ne.0) then
	   if (Gx.markm .gt. 0) then
	    imax = Gx.markm
	   elseif (Gx.markm .eq. -2) then
	    imax = NINT((Gx.xmrk-Gx.xstart)/Gx.xdelta) + 1
	    imax = max(1,min(Gx.mframe,imax))
	   else
	    j = (lines-1)*Gx.mframe + Gx.jx1
	    imax = Gx.jx1
	    fmax = A.fbuf(j)
	    do i = Gx.jx1,Gx.jx2
	      if (A.fbuf(j).gt.fmax) then
		fmax = A.fbuf(j)
		imax = i
	      endif
	      j = j+1
	    enddo
	   endif
	endif
c
c compress in X dimension using AVERAGE
	if (Gx.ncx.gt.1) then
	  fac = 1./Gx.ncx
	  nfr = Gx.mframe/Gx.ncx
C+++
C CMC - ADD Compression
	  if (Gx.cmp.eq.1) then    	! X compression average
	    do n = 0,lines-1
	      call M$VBLK(A.fbuf(n*Gx.mframe+1),A.fbuf(n*nfr+1),
     &                    Gx.ncx,Gx.mframe)
	    enddo
	    Gx.nelem = nfr * lines
	    call M$VSMUL (A.fbuf,fac,A.fbuf,Gx.nelem)
c
	  elseif (Gx.cmp.eq.2) then    	! X compression min
	    ix = 0
	    do n = 0,lines-1
              nnn = n*Gx.mframe+1
              nnf = (n+1)*nfr
	      do nn = n*Gx.mframe+1,(n+1)*Gx.mframe
	        if(nn.eq.nnn.and.ix.lt.nnf) then
	          ix = ix + 1
	          a.fbuf(ix) = A.fbuf(nn)
	          nnn = nnn + Gx.ncx	          
	        elseif (A.fbuf(nn).lt.A.fbuf(ix)) then
	          A.fbuf(ix) = A.fbuf(nn)
	        endif
	      enddo
	    enddo
	    Gx.nelem = nfr * lines
c
	  elseif (Gx.cmp.eq.3) then    	! X compression max
	    ix = 0
	    do n = 0,lines-1
              nnn = n*Gx.mframe+1
              nnf = (n+1)*nfr
	      do nn = n*Gx.mframe+1,(n+1)*Gx.mframe
	        if(nn.eq.nnn.and.ix.lt.nnf) then
	          ix = ix + 1
	          a.fbuf(ix) = A.fbuf(nn)
	          nnn = nnn + Gx.ncx	          
	        elseif (A.fbuf(nn) .gt. A.fbuf(ix)) then
	          A.fbuf(ix) = A.fbuf(nn)
	        endif
	      enddo
	    enddo
	    Gx.nelem = nfr * lines
c
	  elseif (Gx.cmp.eq.4) then    	! X compression first
	    do n = 0,lines-1
	      call M$VMOV(A.fbuf(n*Gx.mframe+1),Gx.ncx,
     &	                  A.fbuf(n*nfr+1),1,nfr)
	    enddo
	    Gx.nelem = nfr * lines
	  elseif (Gx.cmp.eq.5) then    	! X compression max abs
	    ix = 0
	    do n = 0,lines-1
              nnn = n*Gx.mframe+1
              nnf = (n+1)*nfr
	      do nn = n*Gx.mframe+1,(n+1)*Gx.mframe
	        if(nn.eq.nnn.and.ix.lt.nnf) then
	          ix = ix + 1
	          a.fbuf(ix) = A.fbuf(nn)
                  amax = ABS(a.fbuf(ix))
	          nnn = nnn + Gx.ncx	          
	        elseif (ABS(A.fbuf(nn)) .gt. amax) then
	          A.fbuf(ix) = A.fbuf(nn)
                  amax = ABS(a.fbuf(ix))
	        endif
	      enddo
	    enddo
	    Gx.nelem = nfr * lines
	  endif
C---
	else
	  nfr = Gx.mframe
	endif
c
c update Gx.rmin and Gx.rmax if in AUTOMIN(1), AUTOMAX(2) or AUTOFULL(3) modes
	if (Gx.cmode .ge. 5) then
	  dbscale = 10.0
	  if (Gx.cmode .eq. 6) dbscale = 20.0
	  if (Gx.cx) dbscale = dbscale * 0.5
	endif
	if (Gx.iautom.ge.1 .and. Gx.iautom.le.3 .and. Gx.cmode.ne.2) then
	  fac = 1./float(max(Gx.iautol,1))
	  call M$VMXMN(A.fbuf, qmax, qmin, j, i, Gx.nelem)
	  ! convert qmin,qmax from DB to magnitude before using them to
	  ! update Gx.rmin,rmax, this turns out to be better for autoscaling
	  if (Gx.cmode.ge.5) then
	    if (Gx.iautom.ge.2) then
	      if (.not. Gx.fast) qmax = 10**qmax
	      qmax = qmax*fac + 10**(Gx.rmax/dbscale)*(1.-fac)
	      Gx.rmax = dbscale * log10(qmax)
	    endif
	    if (Gx.iautom.ne.2) then
	      if (Gx.dbrange.gt.0) then
		Gx.rmin = Gx.rmax - Gx.dbrange
	      else
		if (.not. Gx.fast) qmin = 10**qmin
		qmin = qmin*fac + 10**(Gx.rmin/dbscale)*(1.-fac)
		Gx.rmin = dbscale * log10(qmin)
	      endif
	    endif
	  else
	    if (Gx.iautom.ne.2) Gx.rmin = qmin*fac + Gx.rmin*(1.-fac)
	    if (Gx.iautom.ge.2) Gx.rmax = qmax*fac + Gx.rmax*(1.-fac)
	  endif
	  call XRTRASTER_SPECS (Mx,Gx)
	endif
c
c get scaling constants
	threshold = (Gx.iautom.lt.0) .or. (Gx.rmin.eq.Gx.rmax)
	if (Gx.cmode .eq. 2) then
	  if (threshold) then
	    qmin = 0.0
	  else		! always scale from -180 to 180
	    qmin = -180.
	    qmax = 180.
	  endif
	elseif (Gx.fast .and. Gx.cmode.ge.5) then
	  DB.fbuf(1) = 10.0**(Gx.rmin/dbscale)
	  DB.fbuf(2) = 10.0**(Gx.rmax/dbscale)
	  idbmin = DB.ibuf(idbmagindex)
	  idbmax = DB.ibuf(2+idbmagindex)
	  if (idbmin.eq.idbmax) threshold = .true.
	elseif (Gx.cmode.ge.5) then
	  qmin = Gx.rmin / dbscale
	  qmax = Gx.rmax / dbscale
	else
	  qmin = Gx.rmin
	  qmax = Gx.rmax
	endif
c
c handle trim
	if (Gx.jx1 .ne. 1 .or. Gx.jx2 .ne. Gx.mframe) then
	  nfro = nfr
	  j = 1 + (Gx.jx1-1)/Gx.ncx
	  nfr = 1 + (Gx.jx2-Gx.jx1)/Gx.ncx
	  do n = 0, lines-1
	    call M$MOVE(A.fbuf(n*nfro+j), A.fbuf(n*nfr+1), nfr*4)
	  enddo
	  Gx.nelem = nfr * lines
	endif
c
c form pixel buffer
	pix_ptr = MD$BUFTMP(1, Gx.nelem, MP_BYTE) ! allocate new pix buf
	if (threshold) then			! Threshold
	  t0 = 1		!RDA: Mx.pixel(1)
	  t1 = Gx.ncolor	!RDA: Mx.pixel(Gx.ncolor)
	  if (Gx.cmode.ge.5 .and. Gx.fast) then	! fast DB threshold
	    i = idbmagindex
	    do n = 1, Gx.nelem
	      if (A.ibuf(i).gt.idbmin) then
		pix(n) = t1
	      else
		pix(n) = t0
	      endif
	      i = i + 2
	    enddo
	  else				! Exact, all modes, threshold
	    do n = 1, Gx.nelem
	      if (A.fbuf(n).gt.qmin) then
		pix(n) = t1
	      else
		pix(n) = t0
	      endif
	    enddo
	  endif
	else					! non-threshold mode
	  if (Gx.cmode.ge.5 .and. Gx.fast) then	! fast non-dB, non-threshold
	    i = idbmagindex
	    fscale = float(Gx.ncolor)/float(idbmax-idbmin)
	    fmin = idbmin - 1/fscale
	    do n = 1,Gx.nelem
	      j = (A.ibuf(i)-fmin)*fscale
	      pix(n) = max(1,min(Gx.ncolor,j))	!RDA: Mx.pixel( max(1,min(Gx.ncolor,j)) )
	      i = i + 2
	    enddo
	  else				! Exact, all modes, non-threshold
	    if (qmax-qmin .gt. 1e-32) then
	      fscale = float(Gx.ncolor)/(qmax-qmin)
	    else
	      fscale = 1
	    endif
	    fmin = qmin - 1/fscale
	    do n = 1,Gx.nelem
	      j = (A.fbuf(n)-fmin)*fscale
	      pix(n) = max(1,min(Gx.ncolor,j))	!RDA: Mx.pixel( max(1,min(Gx.ncolor,j)) )
	    enddo
	  endif
	endif

c
c draw image
	i = 1
	do while (lines.gt.0)
	  n = (Mx.stk(1).y2 - Mx.stk(1).y1 + 1) - (Gx.top - 1)
	  if (Gx.ney.gt.1) n = INT(n/Gx.ney)
	  n = min(lines,n)
	  if (Gx.top.lt.Mx.height) then
	    if (Gx.nxf .gt. 0) then
	      Gx.xf.clip = .true.
	      Gx.xf.x2 = Mx.width
	      Gx.xf.y1 = Gx.top
	      Gx.xf.y2 = Gx.top + Gx.ney * n + 1
	      call XRTRASTER_XF(Mx, Gx, 'A', -2)
	    endif
	    if (.not. Mx.icon)
     +	      call MX$PUT_IMAGE(pix(i),nfr,n,Gx.nex,Gx.ney,1,Gx.top,0)	
	    if (Gx.bs) then
	      if (spec(Gx.ispec).bsbuf.p .eq. 0)
     +		call M$MALLOC(spec(Gx.ispec).mbytes, spec(Gx.ispec).bsbuf.p)
	      pbuf_ptr = spec(Gx.ispec).bsbuf.p + spec(Gx.ispec).nbytes
	      call M$MOVE(pix(i), pbuf, n*nfr)
	      spec(Gx.ispec).nbytes = spec(Gx.ispec).nbytes + n*nfr
	    endif
	    j = Mx.stk(1).x2 + 1
	    if (Mx.level.gt.1) j = max(j,Mx.stk(2).x2+5)
c TODO: to avoid excessive clear_areas, create a variable in the
c globals structure.  I also need to consider how to clear out areas
c that are currently being stored in a pixmap under a zoom.
	    if (j.lt.Mx.width)
     +	      call MX$CLEAR_AREA (j, Gx.top, Mx.width-j, Gx.ney*n)
	  endif
	  j = Gx.top
	  Gx.top = Gx.top + Gx.ney * n
	  spec(Gx.ispec).stk.y2 = max(spec(Gx.ispec).stk.y2, Gx.top-1)

c check to see if we've completely covered any data sets so we can free up any
c associated memory, i.e. backing store buffers, or spec structs
	  is = Gx.ispec + 1
	  do while (is .le. Gx.nspec .and.
     +			spec(Gx.ispec).stk.y2 .ge. spec(is).stk.y2)
	    call M$FREE(spec(is).bsbuf.p)
	    call M$MOVE(spec(is+1), spec(is), (Gx.nspec-is)*L_SpecStruct)
	    Gx.nspec = Gx.nspec - 1
	  enddo

	  if (j.le.Mx.ypos.and.Gx.top.gt.Mx.ypos)
     +	    call XRTRASTER_SPECS(Mx,Gx)
	  lines = lines - n
	  i = i + nfr*n
	  if (Gx.top .gt. Mx.stk(1).y2) then
	    call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 1)
	  elseif (Gx.edge .and. lines.eq.0) then
	    if (Mx.level.eq.1 .or. Gx.top.lt.Mx.stk(2).y1) then
	      call MX$DRAW_LINE(-1, 1, Gx.top, Mx.stk(1).x2, Gx.top)
	    else
	      call MX$DRAW_LINE(-1, 1, Gx.top, 4, Gx.top)
	    endif
	  endif
	  if (Gx.nxf .gt. 0) then
	    call XRTRASTER_XF(Mx, Gx, 'A', L_Draw)
	    Gx.xf.clip = .false.
	  endif
	enddo
c
c convert "new data line" to real world coordinates & write out to widget
	if (Gx.ledgey.gt.0) then
	  lineY = spec(1).stk.ymin + (Gx.top-spec(1).stk.y1)*spec(1).stk.yscl
	  lineY = DINT((lineY-spec(1).ystart)/spec(1).ydelta)
	  if (Gx.wrap) lineY = mod(NINT(lineY),Gx.lps)
	  lineY = spec(1).ystart + lineY*spec(1).ydelta
	  call M$DRSLT(Gx.edgey(1:Gx.ledgey), lineY)
	endif
c
c draw marker
	if (Gx.markm .ne. 0 .and. Mx.level.eq.1) then
	  k = Gx.ispec
	  Gx.markp.y = Gx.top
	  Gx.markp.x = (spec(k).xstart+(imax-1)*spec(k).xdelta - 
     &		spec(k).stk.xmin) / spec(k).stk.xscl + spec(k).stk.x1
	  call XRTRASTER_MARKER (Mx,Gx,1)
	endif
c
	Gx.time = SECNDS(0.0)
c
	return
	end


	subroutine XRTRASTER_PIX2REAL (Mx, Gx, ix, iy, spec, nspec)
	include 'xrtraster.inc'
	record /SPECSTRUCT/ spec(*)
	integer*4 ix, iy, nspec, is
c
c which spec(*) area are we in
	is = 1
	do while (is.lt.nspec .and. iy.gt.spec(is).stk.y2)
	  is = is + 1
	enddo
c
c convert to real world coordinates
	! pixel->raw real: add .5 to x offset to get real x at center of pixel
	Gx.retx = spec(is).stk.xmin+(ix-spec(is).stk.x1+.5)*spec(is).stk.xscl
	Gx.rety = spec(is).stk.ymin+(iy-spec(is).stk.y1+.5)*spec(is).stk.yscl
	! raw real->index offset: subtract .5 and do a DNINT to get the FLOOR
	Gx.retx = DNINT((Gx.retx-spec(is).xstart)/spec(is).xdelta-.5)
	Gx.rety = DNINT((Gx.rety-spec(is).ystart)/spec(is).ydelta-.5)
	if (Gx.wrap) Gx.rety = mod(NINT(Gx.rety),Gx.lps)
	! index->real on multiples of abscissa
	Gx.retx = spec(is).xstart + Gx.retx * spec(is).xdelta
	Gx.rety = spec(is).ystart + Gx.rety * spec(is).ydelta
c
c adjust for abscissa mode
	Gx.aretx = Gx.retx
	Gx.arety = Gx.rety
	Gx.dretx = Gx.retx-Gx.xmrk
	Gx.drety = Gx.rety-Gx.ymrk
	if (Gx.iabsc.eq.1) then
	  Gx.aretx = NINT((Gx.aretx-spec(is).xstart)/spec(is).xdelta) + 1
	  Gx.dretx = NINT(Gx.dretx/spec(is).xdelta)
	  Gx.arety = NINT((Gx.arety-spec(is).ystart)/spec(is).ydelta) + 1
	  Gx.drety = NINT(Gx.drety/spec(is).ydelta)
	elseif (Gx.iabsc.eq.2) then
	  if (Gx.aretx.ne.0.d0) Gx.aretx = 1/Gx.aretx
	  if (Gx.arety.ne.0.d0) Gx.arety = 1/Gx.arety
	  if (Gx.dretx.ne.0.d0) Gx.dretx = 1/Gx.dretx
	  if (Gx.drety.ne.0.d0) Gx.drety = 1/Gx.drety
	endif
	return
	end

	subroutine XRTRASTER_SPECS (Mx,Gx)
	include 'xrtraster.inc'
	character*64 chara, charb
	character*2 cxm(6) /'Ma','Ph','Re','Im','Lo','L2'/
	character*6 cam(0:3) /'(absc)', '(indx)', '(1/ab)', '(dxdy)'/
	integer*4 ix,iy,k,ls
	real*8 zmin, zmax
c
c valid range check (none)
	ix = Mx.xpos
	iy = Mx.ypos
c
c which zoom window are we in
	k = Mx.level
	do while (k.gt.1 .and. (
     &     ix .lt. Mx.stk(k).x1  .or. ix .gt. Mx.stk(k).x2 .or.
     &     iy .lt. Mx.stk(k).y1  .or. iy .gt. Mx.stk(k).y2) )
	  k = k-1
	enddo
c
c convert to pixels in base levels reference frame
	if  (k.gt.1) then
	  ix = Mx.stk(k).xmin + (ix-Mx.stk(k).x1)*Mx.stk(k).xscl
	  iy = Mx.stk(k).ymin + (iy-Mx.stk(k).y1)*Mx.stk(k).yscl
	  call XRTRASTER_PIX2REAL(Mx, Gx, ix, iy, %val(Gx.zspec.p), Gx.nzspec)
	else
	  call XRTRASTER_PIX2REAL(Mx, Gx, ix, iy, %val(Gx.sbuf.p), Gx.nspec)
	endif
c
c get zrange specs
	if (Gx.cmode.eq.2) then
	  zmin = -180.0
	  zmax = 180.0
	else
	  zmin = Gx.rmin
	  zmax = Gx.rmax
	endif
c
c  display updated specs
	if (.not.Gx.specs) return
	write(chara,1001) Gx.arety,Gx.drety,k-1,cxm(Gx.cmode),zmax
 1001   format('y: ',1p1g16.9,' dy: ',g16.9,' L=',i1,a3,' zH: ',g12.5)
	write(charb,1002) Gx.aretx,Gx.dretx,cam(Gx.iabsc),zmin
 1002   format('x: ',1p1g16.9,' dx: ',g16.9,' ',a6,' zL: ',g12.5)
        if (Gx.iabsc.eq.3) then
          if (Gx.drety.eq.0.d0) then
            chara(21:40) = 'sl: Inf'
          else
            write(chara(21:40), '(4hsl: , g16.9)') Gx.dretx/Gx.drety
          endif
        endif
	if (Gx.iabsc.eq.0 .and. Gx.yfmt.ne.' ') then
	  ls = M$D2A_FORM (Gx.arety, chara( 4:19), Gx.yfmt)
	  ls = M$D2A_FORM (Gx.drety, chara(25:40), Gx.yfmt)
	elseif (Gx.iabsc.eq.0 .and. Gx.iylab.eq.4) then
	  ls = M$SEC2TSPEC(Gx.arety, chara( 4:19), 0)
	  ls = M$SEC2TSPEC(Gx.drety, chara(25:40), 1)
	endif
	if (Gx.iabsc.eq.0 .and. Gx.xfmt.ne.' ') then
	  ls = M$D2A_FORM (Gx.aretx, charb( 4:19), Gx.xfmt)
	  ls = M$D2A_FORM (Gx.dretx, charb(25:40), Gx.xfmt)
	elseif (Gx.iabsc.eq.0 .and. Gx.ixlab.eq.4) then
	  ls = M$SEC2TSPEC(Gx.aretx, charb( 4:19), 0)
	  ls = M$SEC2TSPEC(Gx.dretx, charb(25:40), 1)
	endif
	if (Gx.zfmt.ne.' ') then
	  ls = M$D2A_FORM (zmin, chara(53:64), Gx.zfmt)
	  ls = M$D2A_FORM (zmax, charb(53:64), Gx.zfmt)
	endif

	call MX$TEXT (Mx.text_w, NINT(Mx.height-Mx.text_h*1.5),chara)
	call MX$TEXT (Mx.text_w, NINT(Mx.height-Mx.text_h*.5),charb)
	ix = max (Mx.text_w*68, Mx.width-Mx.text_w*2)
	iy = Mx.height - Mx.text_h*0.5
	if (Gx.cntrls.gt.0) call MX$TEXT (ix,iy,'C')
	if (Gx.cntrls.le.0) call MX$TEXT (ix,iy,' ')
c
	return
	end

	subroutine XRTRASTER_ZOOM (Mx, Gx, ix1, iy1, ix2, iy2, spec)
	include 'xrtraster.inc'
	record /SPECSTRUCT/ spec(*)
	integer*4 ix1,iy1,ix2,iy2,k,ix12,iy12,inx,iny,iscw,isch
	integer*4 n,is

	k = Mx.level
	if (k.eq.L_stack) then
	  call MX$MESSAGE ('No more stack levels',1.0)
	else
	  ! clip on previous zoom level
	  iy1 = max(iy1,Mx.stk(k).y1)
	  iy2 = min(iy2,Mx.stk(k).y2)
	  ix1 = max(ix1,Mx.stk(k).x1)
	  if (k.gt.1) then
	    ix2 = min(ix2,Mx.stk(k).x2)
	  else
	    is = 1		! find top spec we're in
	    do while (is.lt.Gx.nspec .and. iy1.gt.spec(is).stk.y2)
	      is = is + 1
	    enddo

	    n = 1		! how many specs do we cross ?
	    inx = spec(is).stk.x2	! get max x2 for all specs in range
	    do while (is+n.le.Gx.nspec .and. iy2.ge.spec(is+n).stk.y1)
	      inx = max(inx,spec(is+n).stk.x2)
	      n = n + 1
	    enddo
	    ix2 = min(ix2,inx)
	    Gx.nzspec = n
	    call M$MALLOC(Gx.nzspec*L_SpecStruct, Gx.zspec.p)
	    call M$MOVE(spec(is), %val(Gx.zspec.p), Gx.nzspec*L_SpecStruct)
	  endif
	  ix12 = ix2-ix1+1
	  iy12 = iy2-iy1+1
	  iscw = Mx.width - Mx.stk(1).x1
	  isch = Mx.height - Mx.stk(1).y1 - Mx.text_w*2.25 - 2
	  if (ix12.gt.2 .and. iy12.gt.2) then
	    if (Gx.markp.x .ne. -1) then
	      call XRTRASTER_MARKER (Mx,Gx,0)
	    endif
	    if (k.gt.1) then
	      inx = max(1, (Mx.stk(2).x2 - Mx.stk(2).x1 - 4) / ix12 )
	      iny = max(1, (Mx.stk(2).y2 - Mx.stk(2).y1 - 4) / iy12 )
	    else
	      inx = max(1, NINT(iscw*.9) / ix12 )
	      iny = max(1, NINT(isch*.9) / iy12 )
	    endif
	    Mx.stk(k+1).xmin = Mx.stk(k).xmin + 
     &		(ix1-Mx.stk(k).x1)*Mx.stk(k).xscl
	    Mx.stk(k+1).xmax = Mx.stk(k).xmin + 
     &		(ix2-Mx.stk(k).x1)*Mx.stk(k).xscl
	    Mx.stk(k+1).ymin = Mx.stk(k).ymin + 
     &		(iy1-Mx.stk(k).y1)*Mx.stk(k).yscl
	    Mx.stk(k+1).ymax = Mx.stk(k).ymin + 
     &		(iy2-Mx.stk(k).y1)*Mx.stk(k).yscl
	    Mx.stk(k+1).xscl = Mx.stk(k).xscl/inx
	    Mx.stk(k+1).yscl = Mx.stk(k).yscl/iny
	    ix2 = (Mx.width-ix12*inx)/2
	    iy2 = (isch-iy12*iny)/2
	    if (Gx.nxf .gt. 0) call XRTRASTER_XF(Mx, Gx, 'A', -2)
	    call MX$ZOOM (ix1,iy1,ix12,iy12,ix2,iy2,inx,iny)
	    if (Gx.nxf .gt. 0) call XRTRASTER_XF(Mx, Gx, 'A', L_Draw)
	    Mx.stk(k+1).x1 = ix2
	    Mx.stk(k+1).y1 = iy2
	    Mx.stk(k+1).x2 = ix2 + ix12*inx - 1
	    Mx.stk(k+1).y2 = iy2 + iy12*iny - 1
	    Mx.level = k+1
	    call XRTRASTER_MSGDO (Mx,Gx,MSK_ZOOM)
	  endif
	endif
	return
	end



	subroutine XRTRASTER_PREP (Mx, Gx, IN, OUT)
	include 'xrtraster.inc'
	real*4 dbmin, IN(*), OUT(*)
	integer*4 ndo,i
c
	if (Gx.nelem .le. 0) return
c
c reformat to float
	ndo = Gx.nelem
	if (Gx.cx) ndo = Gx.nelem*2
	if (Gx.type .ne. MP_FLOAT) then
	  call M$RETYPE(IN, Gx.type, OUT, MP_FLOAT, ndo)
	else
	  call M$MOVE(IN, OUT, ndo*4)
	endif
c
c get complex/log modes into scalar array of values
	if (Gx.cx) then
	  if (Gx.cmode.eq.1) then		! CX MAGNITUDE
	    call M$CVMAG(OUT, OUT, Gx.nelem)
	  else if (Gx.cmode.eq.2) then		! CX PHASE
	    call M$CVRPHAD(OUT, OUT, Gx.nelem, 20)
	  else if (Gx.cmode.eq.3) then		! CX REAL
	    call M$VMOV(OUT, 2, OUT, 1, Gx.nelem)
	  else if (Gx.cmode.eq.4) then		! CX IMAGINARY
	    call M$VMOV(OUT(2), 2, OUT, 1, Gx.nelem)
	  elseif (Gx.cmode.ge.5) then		! CX LOG and LOG2
	    call M$CVMAG2(OUT, OUT, Gx.nelem)
	  endif

	elseif (Gx.cmode.eq.1) then		! SCALAR MAGNITUDE
	  do i = 1,Gx.nelem
	    OUT(i) = abs(OUT(i))
	  enddo
	endif

	! final LOG and LOG2 conversions for SCALAR and COMPLEX data
	if (Gx.cmode.ge.5) then
	  ! Fast Algorithm uses exponent bytes directly, no log needed
	  if (Gx.fast) then
	    dbmin = Gx.dbmin
	    do i = 1, Gx.nelem
	      if (OUT(i) .lt. dbmin) OUT(i) = dbmin
	    enddo
	  else
	    call M$VLOG10(OUT, Gx.dbmin, OUT, Gx.nelem)
	  endif
	endif
c
	return
	end


	subroutine XRTRASTER_UNZOOM (Mx,Gx,newlevel)
	include 'xrtraster.inc'
	integer*4 newlevel, level

	level = max(1,newlevel)

	if (level .lt. Mx.level) then
	  if (Gx.nxf .gt. 0) call XRTRASTER_XF(Mx, Gx, 'A', -2)
	  do while (Mx.level .gt. level)
	    call MX$UNZOOM ()
	    Mx.level = Mx.level - 1
	  enddo
	  if (Gx.nxf .gt. 0) call XRTRASTER_XF(Mx, Gx, 'A', L_Draw)
	  call XRTRASTER_MSGDO (Mx,Gx,MSK_UNZOOM)
	endif

	if (Mx.level.eq.1 .and. Gx.nzspec.gt.0) then
	  call M$MFREE(Gx.nzspec*L_SpecStruct, Gx.zspec.p)
	  Gx.zspec.p = 0
	  Gx.nzspec = 0
	endif

	return
	end

	subroutine XRTRASTER_MSGDO (Mx,Gx,bit)
	include 'xrtraster.inc'
	integer*4 bit

	if (Gx.xf.msgid.gt.0 .and. BTEST(Gx.xf.msgmask,bit)) 
     &		call XRTRASTER_INFOMSG (Mx, Gx, bit, Mx.level, Gx.xf.msgid)
	return
	end

	subroutine XRTRASTER_INFOMSG (Mx, Gx, bit, iarg, rid)

	include 'xrtraster.inc'
	include 'midas.inc'
	include 'qmessdef.inc'
	include 'qmessdecl.inc'
	character*2 cxm(6)  /'MA', 'PH', 'RE', 'IM', 'LO', 'L2'/
	integer*4 iarg, rid, i, bit
	real*8 d

	if (bit .eq. MSK_EXIT) then
	  call M$SEND_MSG (MQH_EXITINFO, MQD, rid, 0)
	elseif (bit .eq. MSK_COLOR) then
	  if (Gx.ic.eq.5) then
	    MQH_COLORMAPINFO.colormapid = -1
	    call M$MOVE(%val(Gx.map5.p), MQD.COLORMAP, 28*2)
	  else
	    MQH_COLORMAPINFO.colormapid = Gx.ic
	    call M$MOVE (Mc.colormap(Gx.ic), MQD.COLORMAP, 28*2)
	  endif
	  call M$SEND_MSG (MQH_COLORMAPINFO, MQD.COLORMAP, rid, 0)
	elseif (bit .eq. MSK_CXMODE) then
	  if (iarg.le.Mx.level) then
	    if (iarg.lt.1) i = max (1, Mx.level+iarg)
	    if (iarg.ge.1) i = min (iarg, Mx.level)
	    MQD.CXMODEINFO.mode = cxm(Gx.cmode)
	    MQH_CXMODEINFO.level = i - 1
	  else
	    MQD.CXMODEINFO.mode = cxm(Gx.cmode)
	    MQH_CXMODEINFO.level = Mx.level
	  endif
	  call M$SEND_MSG (MQH_CXMODEINFO, MQD.CXMODEINFO, rid, 0)
	elseif (bit .eq. MSK_MARK) then
	  MQD.MARKINFO.x = Gx.retx
	  MQD.MARKINFO.y = Gx.rety
	  MQD.MARKINFO.z = 0.d0
	  MQH_MARKINFO.info = Mx.state_mask
	  call M$SEND_MSG (MQH_MARKINFO, MQD.MARKINFO, rid, 0)
	else
	  if (iarg.lt.1) i = max (1, Mx.level+iarg)
	  if (iarg.ge.1) i = min (iarg, Mx.level)
	  MQD.PLOTINFO.xmin = min (Mx.stk(i).xmin, Mx.stk(i).xmax)
	  MQD.PLOTINFO.xmax = max (Mx.stk(i).xmin, Mx.stk(i).xmax)
	  MQD.PLOTINFO.ymin = min (Mx.stk(i).ymin, Mx.stk(i).ymax)
	  MQD.PLOTINFO.ymax = max (Mx.stk(i).ymin, Mx.stk(i).ymax)
	  if (bit .eq. MSK_ZOOM) then
	    MQH_ZOOMINFO.level = i - 1
	    call M$SEND_MSG (MQH_ZOOMINFO, MQD.PLOTINFO, rid, 0)
	  elseif (bit .eq. MSK_UNZOOM) then
	    MQH_UNZOOMINFO.level = i - 1
	    call M$SEND_MSG (MQH_UNZOOMINFO, MQD.PLOTINFO, rid, 0)
	  else
	    MQD.PLOTINFO.xunits = 0
	    MQD.PLOTINFO.yunits = 0
	    MQD.PLOTINFO.cxmode = cxm(Gx.cmode)
	    MQH_PLOTINFO.level = i - 1
	    MQD.PLOTINFO.xframe = Gx.jx2 - Gx.jx1 + 1
	    MQD.PLOTINFO.yframe = (Mx.stk(1).y2 - Mx.stk(1).y1 + 1)/Gx.ney
	    MQD.PLOTINFO.primname = 'XRTRASTER'
	    call M$SEND_MSG (MQH_PLOTINFO, MQD.PLOTINFO, rid, 0)
	  endif
	endif

	return
	end

	subroutine XRTRASTER_SETTINGS (Mx, Gx, flag, v)
	include 'xrtraster.inc'
	integer*4 flag, v, y
	logical*4 t, set

	t = v .lt. 0
	set = v .gt. 0
	if (flag.eq.t_auto) then
	  Gx.iautom = v
	elseif (flag.eq.t_autol) then
	  Gx.iautol = max (1, v)
	elseif (flag.eq.t_bs) then
          if (t .or. (Gx.bs .neqv. set)) then
	    Gx.bs = .not. Gx.bs
	    call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 2)
	  endif
	elseif (flag.eq.t_cntrls) then
	  Gx.cntrls = v
        elseif (flag.eq.t_edge) then
          if (t .or. (Gx.edge .neqv. set)) Gx.edge = .not. Gx.edge
	elseif (flag.eq.t_events) then
	  Gx.events = v
	  if (Gx.events.le.0) Gx.events = 2
C+++
C CMC - ADD Compression
	elseif (flag.eq.t_cmp) then
	  Gx.cmp = min(max(1,v),5)
C---
	elseif (flag.eq.t_lpf) then
	  Gx.lpf = v
	  call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 0)
	  call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), -1)
	elseif (flag.eq.t_lps) then
	  Gx.lps = v
	  call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 0)
	  call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), -1)
	elseif (flag.eq.t_mimic) then
	  Gx.mimic = v
	elseif (flag.eq.t_msgid) then
	  Gx.xf.msgid = v
	elseif (flag.eq.t_smooth) then
	  if (t .or. (Gx.smooth .neqv. set)) Gx.smooth = .not. Gx.smooth
	elseif (flag.eq.t_specs) then
	  if (t .or. (Gx.specs .neqv. set)) then
	    Gx.specs = .not. Gx.specs
	    y = Mx.height - Mx.text_h*2.25 - 2
	    if (Gx.specs) y = min(Mx.stk(1).y2+1,y)
	    call MX$CLEAR_AREA (0, y, Mx.width, Mx.height-y+1)
	    call XRTRASTER_RESET(Mx, Gx, %val(Gx.sbuf.p), 2)
	    call XRTRASTER_REFRESH(Mx, Gx, %val(Gx.sbuf.p), 1)
	  endif
	elseif (flag.eq.t_wrap) then
	  if (t .or. (Gx.wrap .neqv. set)) then
	    if (Gx.lps.gt.0) then
	      Gx.wrap = .not. Gx.wrap
	      call XRTRASTER_SPECS(Mx,Gx)
	    else
	      Gx.wrap = .false.
	    endif 
	  endif
	elseif (flag.eq.t_markm) then
	  Gx.markm = v
	elseif (flag.eq.t_marks) then
	  if (Gx.markp.x .ne. -1) then
	    call XRTRASTER_MARKER (Mx,Gx,0)
	  endif
	  Gx.marks = v
	endif
	return
	end

	subroutine XRTRASTER_MARKER (Mx,Gx,mode)
	include 'xrtraster.inc'
	integer*4 mode
	if (Gx.marks.lt.0) then
	  call MX$DRAW_DOTS(L_XORColor, Gx.markp, 1, -Gx.marks)
	elseif (Gx.marks.gt.0) then
	  if (mode.eq.1) then
	    Gx.markp.y = Gx.markp.y + Gx.marks
	    if (Gx.markp.y+Gx.marks/2.gt.Mx.stk(1).y2) Gx.markp.x = -1
	    if (Gx.markp.x .ne. -1) call MX$DRAW_SYMBOLS
     &			(-1, Gx.markp,1,L_TriangleSymbol,-Gx.marks)
	  else
	    if (Gx.markp.x .ne. -1) call MX$DRAW_SYMBOLS
     &			(0, Gx.markp,1,L_TriangleSymbol,-Gx.marks)
	  endif
	endif
	if (mode.eq.0) Gx.markp.x = -1
	return
	end

	subroutine XRTRASTER_REFRAME (Mx, Gx, frame, mode)
	include 'xrtraster.inc'
	integer*4 frame, mode
	real*8 dscale

	if (frame.le.0) return
	if (frame .ne. Gx.mframe) then
	  if (mode.eq.0. .or. mode.eq.2) then
	    if (Gx.mframe.eq.1 .or. mode.eq.2) then
	      Gx.jx1 = 1
	      Gx.jx2 = frame
	    else
	      dscale = DBLE(frame-1) / DBLE(Gx.mframe-1)
	      Gx.jx1 = 1 + NINT((Gx.jx1-1)*dscale)
	      Gx.jx2 = 1 + NINT((Gx.jx2-1)*dscale)
	    endif
	  endif
	  Gx.mframe = frame
	  Gx.jx1 = min(Gx.mframe,max(1,Gx.jx1))
	  Gx.jx2 = min(Gx.mframe,max(Gx.jx2,Gx.jx1))
	  Gx.nelem = 0			! no data yet
	endif
	return
	end

	subroutine XRTRASTER_CMODE(Mx,Gx,imode)
	include 'xrtraster.inc'
	integer*4 imode, iimode
	real*4 dbscale

	iimode = imode
	if (imode .gt. 6) iimode = imode - 2	! DB and D2 = LO and L2

	if (Gx.cmode .ne. iimode) then
	  ! Both modes non-log, no changes needed
	  if (Gx.cmode.lt.5 .and. iimode.lt.5) then
	  ! Changing from log to log mode
	  elseif (Gx.cmode.ge.5 .and. iimode.ge.5) then
	    dbscale = 2.0
	    if (Gx.cmode .eq. 6) dbscale = 0.5
	    Gx.zmin = Gx.zmin * dbscale
	    Gx.zmax = Gx.zmax * dbscale
	    Gx.rmin = Gx.rmin * dbscale
	    Gx.rmax = Gx.rmax * dbscale
	  ! Changing from log to non-log mode
	  elseif (Gx.cmode.ge.5) then
	    dbscale = 10.0
	    if (Gx.cmode.eq.6) dbscale = 20.0
	    Gx.zmin = 10**(Gx.zmin/dbscale)
	    Gx.zmax = 10**(Gx.zmax/dbscale)
	    Gx.rmin = 10**(Gx.rmin/dbscale)
	    Gx.rmax = 10**(Gx.rmax/dbscale)
	  ! Changing from non-log to log mode
	  else
	    dbscale = 10.0
	    if (iimode.eq.6) dbscale = 20.0
	    Gx.zmin = log10(max(abs(Gx.zmin),Gx.dbmin)) * dbscale
	    Gx.zmax = log10(max(abs(Gx.zmax),Gx.dbmin)) * dbscale
	    Gx.rmin = log10(max(abs(Gx.rmin),Gx.dbmin)) * dbscale
	    Gx.rmax = log10(max(abs(Gx.rmax),Gx.dbmin)) * dbscale
	  endif
	  Gx.cmode = iimode
	  call XRTRASTER_SPECS(Mx,Gx)
	  call XRTRASTER_MSGDO (Mx,Gx,MSK_CXMODE)
	endif

	return
	end

	subroutine XRTRASTER_XF (Mx, Gx, type, mode)
	include 'xrtraster.inc'
	integer*4 mode
	character*(*) type
	external XRTRASTER_SPECS_

	if (mode .eq. L_InitFacilities) then
#if _PGF77|_HPUX
	  Gx.xf.ROUTINE.p = get_address(XRTRASTER_SPECS_)
#else
	  Gx.xf.ROUTINE.p = %loc(XRTRASTER_SPECS_)
#endif
	  Gx.xf.mannt = 20
	  Gx.xf.xy = .false.
	  call MX$FACILITIES(Gx.xf, type, L_InitFacilities)
	  Gx.xf.x1 = 0
	endif
	call MX$FACILITIES(Gx.xf, type, mode)
	Gx.nxf = 0
	if (Gx.xf.aview) Gx.nxf = Gx.xf.nannt

	return
	end
