c************
c  Description:	This module contains the non-XWindows graphics support
c		routines for the Boxes Mode Facility
c
c  Author:	JGS   4//90
c		Split from glibf2.for 3/95
c
c  $Revision: 1.3 $
c  $Modtime:   01 May 1996 16:21:16  $
c
c 11-03 EHG DR 500002 For Intel Compiler, need some additional casting of integers.	    
c  
c************

c*************************************************************************
c
c Actual routine called by MX$BOXES passing the Mx structure.  MX$BOXES is a 
c C jacket in gjackets.c that passes its global pointer to the Mx structure 
c along with the other arguments.  See HELP MX$BOXES for more info.
c
c This is actually another wrapper that calls MXU$BOXES so the user does not 
c have to keep track of the boxes array.  Provides access to the box 
c coords through modes 5,6 and allows boxes to be added non-interactively 
c through modes 3 and 4.
c
c    0: cleaned exit
c    1,2: plot boxes   			-1,-2: interactive mode
c    3,4: add specific boxes    	-3,-4: oneshot mode
c    4,5: return boxes coordinates
c
c Odd mode means (time,value,dtime,dvalue) boxes are to be plotted with
c time on the X axis and value on the Y axis (X-PLOT).  Even mode means 
c (time,value,dtime,dvalue) are plotted with time on the Y axis and value 
c on the X axis (X-RASTER).  Simply stated, if mode is odd, each box is
c stored and interpreted as (x,y,width,height); if even (y,x,height,width).
c
c In MXU$BOXES, all information stored here statically is located in a
c structure.  Also, the difference the (x,y) or (y,x) mode of plotting
c is stored as a field in this structure so the odd and even mode format
c is unnecessary.  MXF$BOXES simply initializes a statuc XFACILITIES
c structure and then calculates the (x,y) mode by reading the modeb
c argument and converting.  The flags to MXU$BOXES are the same as those
c to MXF$BOXES but divided in half.
c
c*************************************************************************

	subroutine MXF$BOXES (Mx,modeb,ROUTINE,iarg,dbox)

	implicit none

	include 'types.inc'
	include 'xprim.inc'
	include 'xfacilities.inc'

	integer*4	mbox
	parameter	(mbox=1024)
	external ROUTINE
	logical*4 xy
	integer*4 mode, modeb, iarg
	real*8    dbox(*)

	SAVE
	logical*4 uninitialized  /.true./
	record /XFBOX/ box(mbox)
	record /XFACILITIES/ Xf

	if (modeb .eq. 0) then
	  uninitialized = .true.
	  return
	elseif (uninitialized) then
	  Xf.bview = .true.
	  Xf.box.p = %loc(box)
	  Xf.nbox = 0
	  Xf.mbox = mbox
	  Xf.xy = MOD(iabs(modeb),2).eq.1
	  uninitialized = .false.
	endif


	mode = modeb / 2
	if (Xf.xy .and. modeb.gt.0) mode = mode + 1
	if (Xf.xy .and. modeb.lt.0) mode = mode - 1
	call MXU$BOXES (Mx, Xf, dbox, ROUTINE, modeb)

	return
	end

c*************************************************************************
c
c  ~Subroutine BOX_MSG (Xf, box, boxid)
c  
c  /XFACILITIES/ Xf	An XFACILITIES structure (SEE XFACILITIES.INC)
c  /XFBOX/	box(*)	The array of boxes used by MXU$BOXES
c  integer*4	boxid	The index into box(*) of the box that changed
c
c  This routine is called each time a box is added, changed or removed
c  from the box array.  If the Xf.msgid field is non-negative and the
c  MSK_BOXES bit is set in the Xf.mask field then a BOXINFO message is
c  sent out to the primitive whose Mu.id field is Xf.msgid.
c
c  If <boxid> is less than 0, then it indicates that the box located in
c  the <box(*)> array at slot abs(<boxid>) was deleted.  The boxinfo
c  message will also send out a negative boxid value.
c
c  Before sending out the coordinates in the BOXINFO message they must
c  be converted to <xmin,xmax,ymin,ymax>.  This is done by checking
c  the Xf.xy flag and adding the appropriate coordinates.
c
c*************************************************************************

	subroutine BOX_MSG (Xf, box, boxid)

	implicit none

	include 'types.inc'
	include 'xfacilities.inc'
	include 'msgmask.inc'
	include 'qmessdef.inc'
	record /XFACILITIES/ Xf
	record /XFBOX/ box(*)
	integer*4 boxid, id
	record /MQH_BOXINFO/ MQH
	record /MQD_BOXINFO/ dbox

	if (Xf.msgid.le.0 .or. .not.BTEST(Xf.msgmask,MSK_BOXES)) return
	MQH.boxid = boxid
	id = abs(MQH.boxid)
	if (id.ne.0) then
	  if (Xf.xy) then
	    dbox.xmin = box(id).xyX
	    dbox.xmax = box(id).xyX + box(id).xyW
	    dbox.ymin = box(id).xyY
	    dbox.ymax = box(id).xyY + box(id).xyH
	  else
	    dbox.xmin = box(id).yxX
	    dbox.xmax = box(id).yxX + box(id).yxW
	    dbox.ymin = box(id).yxY
	    dbox.ymax = box(id).yxY + box(id).yxH
	  endif
	endif
	call M$SEND_MSG (MQH, dbox, Xf.msgid, 0)
	return
	end

	subroutine MXU$BOXES (Mx, Xf, MQD, ROUTINE, modeb)

	implicit none

	include 'types.inc'
	include 'midas.inc'
	include 'xprim.inc'
	include 'xfacilities.inc'
	include 'qmessdef.inc'

	record /MQ_DATA/ MQD
	external ROUTINE

	record /XFACILITIES/ Xf
	integer*4 modeb, iarg, a, v, ix, iy, x1, x2, y1, y2, k, n
	integer*4 iw, ih, imode, bnumbers
	integer*4 ix1, ix2, iy1, iy2, i, l, t, b, r, w, h, x, y, xbnd, ybnd
	logical*4 view, xy, x1_gets_x2, x2_gets_x1, y1_gets_y2, y2_gets_y1 
	logical*4 exposure
	character*48 titlebar
	character*100 menu
	character*80 filename
	character*1 key
	record /STKSTRUCT/ stk4
	record /XFBOX/ box(1)
	pointer (box_ptr, box)

	if (modeb.eq.L_Draw .and. Xf.nbox.eq.0) return

	if (Xf.box.p .eq. 0) then
	  if (Xf.mbox.le.0 .or. modeb.eq.L_CleanExit) return
	  call M$STMALLOC(Xf.mbox * L_xfbox, Xf.box)
	endif

	xy = Xf.xy
	view = Xf.bview
	box_ptr = Xf.box.p

	call MX$ORIGIN (Mx.origin, 4, Mx.stk(Mx.level), stk4)
c
c modes for plotting the boxes, cleaning up, passing info through MQD.BOXINFO
c
	if (modeb.eq.L_Draw) then			! plot boxes
	  if (Xf.nbox.gt.0.and.view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
c
	elseif (modeb.eq.L_CleanExit) then		! cleaned exit
	  call M$STMFREE(Xf.mbox * L_xfbox, Xf.box)
	  Xf.box.p = 0
	  Xf.mbox = 0
	  Xf.nbox = 0
c
	elseif (modeb.eq.2) then	! add box from MQD.BOXINFO
	  if (Xf.iarg .le. 0) Xf.iarg = Xf.nbox + 1
	  if (Xf.iarg .gt. Xf.mbox) Xf.iarg = -1
	  if (view .and. Xf.iarg.le.Xf.nbox) 
     &		call BPLOT(Mx, Xf, stk4, Xf.iarg, Xf.iarg)
	  ! only overwrite altered coordinates if min .le. max
	  ! or if the box is not being overwritten
	  if (Xf.iarg.gt.Xf.nbox .or.
     +		MQD.BOXINFO.xmin.le.MQD.BOXINFO.xmax) then
	    if (xy) then
	      box(Xf.iarg).xyX = min (MQD.BOXINFO.xmin, MQD.BOXINFO.xmax)
	      box(Xf.iarg).xyW = dabs (MQD.BOXINFO.xmax - MQD.BOXINFO.xmin)
	    else
	      box(Xf.iarg).yxX = min (MQD.BOXINFO.xmin, MQD.BOXINFO.xmax)
	      box(Xf.iarg).yxW = dabs (MQD.BOXINFO.xmax - MQD.BOXINFO.xmin)
	    endif
	  endif
	  if (Xf.iarg.gt.Xf.nbox .or.
     +			MQD.BOXINFO.ymin.le.MQD.BOXINFO.ymax) then
	    if (xy) then
	      box(Xf.iarg).xyY = min (MQD.BOXINFO.ymin, MQD.BOXINFO.ymax)
	      box(Xf.iarg).xyH = dabs (MQD.BOXINFO.ymax - MQD.BOXINFO.ymin)
	    else
	      box(Xf.iarg).yxY = min (MQD.BOXINFO.ymin, MQD.BOXINFO.ymax)
	      box(Xf.iarg).yxH = dabs (MQD.BOXINFO.ymax - MQD.BOXINFO.ymin)
	    endif
	  endif
	  call BOX_MSG (Xf, box, Xf.iarg)
	  if (view) call BPLOT(Mx, Xf, stk4, Xf.iarg, Xf.iarg)
	  Xf.nbox = max (Xf.iarg, Xf.nbox)
c
	elseif (modeb.eq.3) then	! put box into MQD.BOXINFO
	  if (Xf.iarg.eq.0) Xf.iarg = Xf.nbox		! <<<11/20/92
	  if (Xf.iarg.lt.0) Xf.iarg = max (1, Xf.nbox+Xf.iarg+1)
	  if (Xf.iarg.le.Xf.nbox .and. Xf.iarg.ge.1) then
	    if (Xf.xy) then
	      MQD.BOXINFO.xmin = box(Xf.iarg).xyX
	      MQD.BOXINFO.xmax = box(Xf.iarg).xyX + box(Xf.iarg).xyW
	      MQD.BOXINFO.ymin = box(Xf.iarg).xyY
	      MQD.BOXINFO.ymax = box(Xf.iarg).xyY + box(Xf.iarg).xyH
	    else
	      MQD.BOXINFO.xmin = box(Xf.iarg).yxX
	      MQD.BOXINFO.xmax = box(Xf.iarg).yxX + box(Xf.iarg).yxW
	      MQD.BOXINFO.ymin = box(Xf.iarg).yxY
	      MQD.BOXINFO.ymax = box(Xf.iarg).yxY + box(Xf.iarg).yxH
	    endif
	  else
	    Xf.iarg = -1
	  endif
c
	elseif (modeb.eq.4) then	! delete box
	  if (Xf.iarg.eq.0) then
	    if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	    Xf.iarg = Xf.nbox
	    Xf.nbox = 0
	    call BOX_MSG (Xf, box, 0)
	  elseif (Xf.iarg.le.Xf.nbox) then
	    if (Xf.iarg.lt.0) Xf.iarg = max (1, Xf.nbox+Xf.iarg+1)
	    if (view) call BPLOT(Mx, Xf, stk4, Xf.iarg, Xf.nbox)
	    Xf.nbox = Xf.nbox - 1
	    if (Xf.iarg.le.Xf.nbox) then
	      i = Xf.iarg
	      call M$MOVE (box(i+1), box(i), (Xf.nbox-i+1)*L_xfbox)
	      if (view) call BPLOT(Mx, Xf, stk4, Xf.iarg, Xf.nbox)
	    endif
	    call BOX_MSG (Xf, box, -Xf.iarg)
	  else
	    Xf.iarg = -1
	  endif

	elseif (modeb.eq.5) then
	  if (MQD.SET.object .eq. 'BOXVIEW') then
	    if (Xf.iarg.eq.-1 .or. (Xf.bview .neqv. (Xf.iarg.ne.0))) then
	      if (Xf.nbox.gt.0) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      Xf.bview = .not. Xf.bview
	    endif
	  elseif (MQD.SET.object .eq. 'BOXNUMS') then
	    if (Xf.bnumbers .ne. Xf.iarg) then
	      if (Xf.bview) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      Xf.bnumbers = Xf.iarg
	      if (Xf.bview) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	    endif
	  endif

	elseif (modeb.eq.L_Preload) then		! preload file
	  call BOXES_FILE(Mx, Xf, stk4, MQD.NEWFILE.filename, 0)

	elseif (modeb.eq.6) then			! NEWFILE message
	  if (MQD.NEWFILE.filename .eq. ' ') then  ! erase all boxes
	    if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	    Xf.iarg = Xf.nbox
	    Xf.nbox = 0
	    call BOX_MSG (Xf, box, 0)
	  else
	    call BOXES_FILE(Mx, Xf, stk4, MQD.NEWFILE.filename, 1)
	  endif
	endif

	if (modeb.ne.L_Interactive .and. modeb.ne.L_OneShot) return

c
c mode for interactive create/delete boxes
	if (stk4.xscl .eq. 0.d0 .or. stk4.yscl .eq. 0.d0) then
	  call M$WARNING ('Illegal scaling values detected in Boxes Mode.')
	  return
	endif
	titlebar = 'Boxes Mode: LM-Add/Resize/moVe MM-Menu RM-Delete'
	call MX$SETBAR (titlebar)
c
	l = stk4.x1
	r = stk4.x2
	t = stk4.y1
	b = stk4.y2
	xbnd = Mx.width*2
	ybnd = Mx.height*2
	exposure = .false.
	bnumbers = Xf.bnumbers
	if (abs(bnumbers).gt.1) then
	  if (view.and.bnumbers.eq.-2) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	  Xf.bnumbers = ISIGN(1, bnumbers)
	  if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	endif
c
	do while (.true.)

	  Mx.button_press = 0
	  do while (Mx.button_press.eq.0)
	    call MX$EVENT ()
	    if (Mc.break) return 
	    key = Mx.key_upchar
	    if (Mc.sysunlock .or. Mx.breakflag) then	! system unlock (exit)
	      if (Mc.sysunlock) exposure = .true.	! or window Close
	      goto 999				! Add/Resize/Move
	    elseif (key.eq.'A'.or.key.eq.'R'.or.key.eq.'V') then 
	      Mx.button_press = 1
	    elseif (key.eq.'M') then		! Menu
	      Mx.button_press = 2
	    elseif (key.eq.'D') then		! Delete
	      Mx.button_press = 3
	    elseif (key.eq.'?') then		! Help
	      call MX$MHELP('~BOXES OPTIONS', 'Boxes Mode')
	    elseif (key.eq.'Q') then		! Resize/Quit
	      goto 999
	    endif
	    if (Mx.exposure) exposure = .true.
	    if (Mx.resize) goto 999 	! Resize (may be caught in mhelp)
	    if (Xf.ROUTINE.p .ne. 0) call ROUTINE
	  enddo

c
c add, move, alter or delete box
	  if (.not.view .and. (Mx.button_press.eq.1 .or.
     &		Mx.button_press.eq.3)) then
	    call MX$MESSAGE ('Display Toggled Off', -2.0)
c
	  elseif (view .and. Mx.xpos.ge.l .and. Mx.xpos.le.r .and.
     &		Mx.ypos.ge.t .and. Mx.ypos.le.b .and. (Mx.button_press.eq.1
     &		.or. Mx.button_press.eq.3) ) then
c
	    n = 1
	    if (key.eq.'A') n = Xf.nbox + 1
	    a = 0
	    v = 0
	    do while (n.le.Xf.nbox .and. a.eq.0)
	      call VBOXP (stk4, box(n), x1, y1, x2, y2, xy, 1, xbnd, ybnd)
	      ix1 = iabs(Mx.xpos-x1)
	      iy1 = iabs(Mx.ypos-y1)
	      ix2 = iabs(Mx.xpos-x2)
	      iy2 = iabs(Mx.ypos-y2)
	      if ((ix1.lt.10 .or. ix2.lt.10)) then
		if (iy1.lt.10 .or. iy2.lt.10) a=n
		if (v.eq.0 .and. (ix1.lt.5 .or. ix2.lt.5)) then
		  if (y1.lt.y2 .and. Mx.ypos.gt.y1 .and. Mx.ypos.lt.y2) v=n
		  if (y2.lt.y1 .and. Mx.ypos.gt.y2 .and. Mx.ypos.lt.y1) v=n
		endif
	      elseif (iy1.lt.5 .or. iy2.lt.5) then
		if (v.eq.0) then
		  if (x1.lt.x2 .and. Mx.xpos.gt.x1 .and. Mx.xpos.lt.x2) v=n
		  if (x2.lt.x1 .and. Mx.xpos.gt.x2 .and. Mx.xpos.lt.x1) v=n
		endif
	      endif
	      if (v.ne.0 .and. key.eq.'R') a = v
	      n = n + 1
	    enddo
	    if (a.ne.0) v = a
	    if (key.eq.'V') a = 0
	    if (v.ne.0) then
	      if (Mx.button_press.eq.3) then	! delete box
		call BPLOT(Mx, Xf, stk4, v, Xf.nbox)
		Xf.nbox = Xf.nbox-1
		if (v.le.Xf.nbox) then
		  call M$MOVE (box(v+1), box(v), L_xfbox*(Xf.nbox-v+1))
		  call BPLOT(Mx, Xf, stk4, v, Xf.nbox)
		endif
		call BOX_MSG (Xf, box, -v)
	      else
		if (a.ne.0) then 		! alter box
		  ix1 = x1
		  ix2 = x2
		  iy1 = y1
		  iy2 = y2
		  call MX$RUBBERWARPBOX (ix1, iy1, ix2, iy2, ROUTINE)
		  if (Mx.button_release .eq. 1) then
		    call BPLOT(Mx, Xf, stk4, a, a)

c Don't translate x or y coords unless they have changed.  The goal is to
c minimize changing real values when boxes are altered.  Up to 3 edges may not
c move. We don't want to recalculate the real world values of those edges since
c their original values may not have fallen on exact multiples of the current
c data field's x and y scales. Use the (x,y,w,h) box, and remember that VBOX
c first translates it to (x1,y1,x2,y2).  Each of the 4 pixel values
c (ix1,iy1,ix2,iy2) is translated to a real, only if it is within the window. 
c (x1,y1,x2,y2) are then translated back to (x,y,w,h).  Hence if we know that 
c our former x2 value is now our ix1 value (the pixel locations are the same), 
c we can simply move the x2 value into the x spot before we call VBOX and 
c flag the ix1 value to be off the screen so that value is not translated. 
		    x1_gets_x2 = (ix1.eq.x2 .and. ix2.ne.x1)
		    y1_gets_y2 = (iy1.eq.y2 .and. iy2.ne.y1)
		    x2_gets_x1 = (ix1.eq.ix2 .or. (ix2.eq.x1 .and. ix1.ne.x2))
		    y2_gets_y1 = (iy1.eq.iy2 .or. (iy2.eq.y1 .and. iy1.ne.y2))
		    if (xy) then
		      if (x1_gets_x2) box(a).xyX = box(a).xyX + box(a).xyW
		      if (y1_gets_y2) box(a).xyY = box(a).xyY + box(a).xyH
		      if (x2_gets_x1) box(a).xyW = 0.d0
		      if (y2_gets_y1) box(a).xyH = 0.d0
		    else
		      if (x1_gets_x2) box(a).yxX = box(a).yxX + box(a).yxW
		      if (y1_gets_y2) box(a).yxY = box(a).yxY + box(a).yxH
		      if (x2_gets_x1) box(a).yxW = 0.d0
		      if (y2_gets_y1) box(a).yxH = 0.d0
		    endif

		    if (ix1.eq.x1 .or. ix1.eq.x2) ix1 = 4*Mx.width	! Don't
		    if (ix2.eq.x2 .or. ix2.eq.x1) ix2 = 4*Mx.width	! trans
		    if (iy1.eq.y1 .or. iy1.eq.y2) iy1 = 4*Mx.height
		    if (iy2.eq.y2 .or. iy2.eq.y1) iy2 = 4*Mx.height

		    call VBOXP (stk4,box(a),ix1,iy1,ix2,iy2,xy,-1,xbnd,ybnd)
		    call BOX_MSG (Xf, box, a)
		    call BPLOT(Mx, Xf, stk4, a, a)
		  endif
		else 				! move box
		  call VBOXP (stk4, box(v), x1, y1, x2, y2, xy, 1, xbnd, ybnd)
		  ix1 = min(x1,x2)
		  iy1 = min(y1,y2)
		  iw = iabs (x2-x1)
		  ih = iabs (y2-y1)
		  x1 = ix1
		  y1 = iy1
		  call MX$DRAGBOX (ix1,iy1,iw,ih,l-iw,r,t-ih,b,ROUTINE)
		  if (Mx.button_release.eq.1) then
		    call BPLOT(Mx, Xf, stk4, v, v)
		    if (xy) then
		      box(v).xyX = box(v).xyX + (ix1-x1)*stk4.xscl
		      box(v).xyY = box(v).xyY + (iy1-y1)*stk4.yscl
		    else
		      box(v).yxX = box(v).yxX + (ix1-x1)*stk4.xscl
		      box(v).yxY = box(v).yxY + (iy1-y1)*stk4.yscl
		    endif
		    call BPLOT(Mx, Xf, stk4, v, v)
		    call BOX_MSG (Xf, box, v)
		  endif
		endif
	      endif

c 	add new box

	    elseif (Mx.button_press.eq.1.and.key.ne.'R'.and.key.ne.'V') then
	      if (Xf.nbox.eq.Xf.mbox) then
		call MX$MESSAGE ('No more boxes available', -2.0)
	      else 
		call MX$RUBBERBOX (x1, y1, x2, y2, ROUTINE)
		if (Mx.button_release.eq.1) then
		  if (x2-x1.gt.3 .or. y2-y1.gt.3) then
		    Xf.nbox = Xf.nbox + 1
		    box(Xf.nbox).x1 = stk4.xmin	! initialize memory with
		    box(Xf.nbox).x2 = stk4.xmin ! valid double prec values
		    box(Xf.nbox).y1 = stk4.ymin
		    box(Xf.nbox).y2 = stk4.ymin
		    call VBOXP (stk4,box(Xf.nbox),x1,y1,x2,y2,xy,-1,xbnd,ybnd)
		    call BPLOT(Mx, Xf, stk4, Xf.nbox, Xf.nbox)
		    call BOX_MSG (Xf, box, Xf.nbox)
		  endif
		endif
	      endif
	    endif
c
c menu options
c
 	  elseif (Mx.button_press.eq.2) then
	    menu = '~BOXES OPTIONS;Save to File...,Load File...,Clear '//
     &		   'All,- Toggle Boxes,Numbers...,Exit Boxes'
	    if (view) menu(55:55) = '+'
	    imode = MX$MENU (0, menu(1:m$length(menu)))
c
	    if (imode.eq.1) then				! save to file
	      filename = ' '
	      call MX$PROMPT ('~Boxes Filename: ', filename)
	      if (filename.ne.' ') call BOXES_FILE(Mx, Xf, stk4, filename, -1)
c
	    elseif (imode.eq.2) then				! load from file
	      if (Xf.nbox.ge.Xf.mbox) then
		call MX$MESSAGE('No more box slots available', 1.0)
	      else
		filename = ' '
		n = MX$FILES (filename)
		call MX$SETBAR (titlebar)
		if (n.gt.0) call BOXES_FILE(Mx, Xf, stk4, filename, 2)
	      endif
c
	    elseif (imode.eq.3) then				! clear boxes
	      if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      Xf.nbox = 0
	      call BOX_MSG (Xf, box, 0)
c
	    elseif (imode.eq.4) then				! toggle view
	      call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      view = .not.view
	      Xf.bview = view
c
	    elseif (imode.eq.5) then				! set #'s mode

	      n = MX$MENU(bnumbers+3, '~BOX NUMBERS;'//
     &		'XOR Box ID  / Boxes Off,XOR Box ID  / Boxes On,'//
     &		'No Numbers  / Boxes On,'//
     &		'Annotations / Boxes On,Annotations / Boxes Off') - 3

	      if (n.le.0 .and. Xf.mannt.le.0) then
		call MX$MESSAGE('Annotations not allocated/supported.', 1.0)
	      elseif (n.ne.bnumbers) then
		if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
		bnumbers = n
		Xf.bnumbers = n
		if (abs(n).gt.1) Xf.bnumbers = ISIGN(1, n)
		if (view) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      endif
c
	    elseif (imode.eq.6) then				! exit
	      goto 999
	    endif
c
	  endif
c
	  if (Mx.button_press.ne.0 .and. modeb.eq.-2) goto 999

	enddo
c
 999	call MX$UNSETBAR ()
	Mx.exposure = exposure
	if (view.and.abs(bnumbers).gt.1) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	Xf.bnumbers = bnumbers
	if (view.and.bnumbers.eq.-2) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	return
	end

c*************************************************************************
c
c  ~Subroutine BPLOT (Mx, Xf, stk4, istart, iend)
c  
c  /MX/		Mx	The Mx graphics structure
c  /STKSTRUCT/	stk4	An origin 4 stack structure
c  integer*4	istart	First box to start plotting from
c  integer*4	iend	Last box to plot
c  logical*4	xy	Indicates how box coordinates are interpreted.
c
c  This routine is called by MXU$BOXES to plot its array of boxes.  It
c  looks at the box structures in the <box(*)> array and plots the boxes
c  starting at the box at index <istart> up through the box at index <iend>.
c
c  Each box structure containing the real world specifications of the box
c  is converted to pixel coordinates by calling VBOXP.  These coordinates
c  are then used to plot the box in the plotting field.
c
c  This routine does minimal clipping by not plotting any boxes that have
c  no edges in the plotting field.  Clipping to the field is done through
c  MX$RCLIP.  The box id numbers are plotted next to the upper left corner
c  if that corner is visible.  Otherwise the next closest corner is used, 
c  or if no corner is visible the number is plotted next to where one of
c  the box edges enters the plotting field (either from the left or from
c  the top.)  Even in double thick mode, text can only be written in one
c  XOR graphics context.  Unfortunately the base XOR graphics context has
c  not proved a very good visibility wise, but that varies depending on
c  your currently installed colormap.
c
c*************************************************************************

	subroutine BPLOT (Mx, Xf, stk4, istart, iend)

	implicit none

	include 'types.inc'
	include 'xprim.inc'
	include 'xfacilities.inc'
	integer*4 istart,iend
	integer*4 l,t,r,b, n, x1,y1,x2,y2, xt,yt, w,h, ll
	character*4 label
	record /XFACILITIES/ Xf
	record /STKSTRUCT/ stk4
	record /XFBOX/ box(1)
	record /PIXSTRUCT/ pix(2)
	record /M_PTR/ ptr(1)
	record /XFANNOTATION/ annt
	pointer (box_ptr, box)
	pointer (ptr_ptr, ptr)
	pointer (annt_ptr, annt)

	box_ptr = Xf.box.p

	l = stk4.x1
	t = stk4.y1
	r = stk4.x2
	b = stk4.y2

	if (Xf.bnumbers.eq.2) then
	  ! no clipping since there will be no drawing of box
	elseif (Xf.clip) then
	  call MX$RCLIP(Xf.x1, Xf.y1, Xf.x2-Xf.x1+1, Xf.y2-Xf.y1+1)
	else
	  call MX$RCLIP(l-1, t-1, r-l+2, b-t+2)
	endif
c
	do n = istart, iend
	  call VBOXP(stk4, box(n), x1, y1, x2, y2, Xf.xy, 1, r, b)
	  w = x2 - x1
	  h = y2 - y1
	  if (w.lt.0) then
	    x2 = x1
	    x1 = x1 + w
	  endif
	  if (h.lt.0) then
	    y2 = y1
	    y1 = y1 + h
	  endif
	  if (Xf.bnumbers.gt.0 .and. n.le.Xf.nannt) then
	    ptr_ptr = Xf.annt.p
	    annt_ptr = ptr(n).p
	    annt.y = - annt.h
c--MODIFIED CODE: Intel Compiler, cast to integer	    
	    annt.mode = IOR(int(annt.mode), L_XFANoGravity)
c--	    
	  endif
	  if (x2.ge.l .and. x1.le.r .and. y2.ge.t .and. y1.le.b) then
	    if (Xf.bnumbers.gt.1 .or. Xf.bnumbers.lt.-1) then
	      ! Don't draw box, only number/annt
	    elseif (w.ne.0 .and. h.ne.0) then	! box
	      call MX$DRAW_BOX(L_XORColor, x1, y1, x2-x1, y2-y1)
	    elseif (w.ne.h) then
	      ! Though this code seems clunky (why not just call MX$DRAW_LINE)
	      ! it has to be here or Sun Fortran -O2 causes bus errors.
	      pix(1).x = x1
	      pix(1).y = y1
	      pix(2).x = x2
	      pix(2).y = y2
	      call MX$DRAW_LINES(L_XORColor, pix, 2)
	    else
	      call MX$DRAW_SYMBOL(L_XORColor, x1, y1, L_SquareSymbol, 1)
	    endif
	    if (Xf.bnumbers.ne.0) then
	      if (x1.lt.l) x1 = x2
	      if (y1.lt.t) y1 = y2
	      if (x1.gt.r .and. y1.le.b) x1 = l
	      if (y1.gt.b .and. x1.le.r) y1 = t
	      if (x1.ge.l .and. x1.le.r .and. y1.ge.t .and. y1.le.b) then
		if (Xf.bnumbers.lt.0) then
		  ll = M$L2A(n, label)			! label
		  if (Xf.bnumbers.eq.-1) then
		    xt = x1 - (ll+1) * Mx.text_w
		    yt = y1 - 4
		    if (xt.lt.l) xt = x1 + Mx.text_w
		    if (yt.lt.t+Mx.text_h) yt = y1 + Mx.text_h
		  else
		    xt = x1 - ll * Mx.text_w / 2
		    yt = y1 + Mx.text_w*.35
		  endif
		  call MX$COLORTEXT(L_XORColor, xt, yt, label(1:ll))
		elseif (n.le.Xf.nannt) then
		  annt.y = y1 - 4
		  if (annt.y .lt. t+annt.a) annt.y = y1 + annt.a + 4
c--MODIFIED CODE: Intel Compiler, cast to integer	    
		  if (IAND(int(annt.mode),L_XFAMidAnchor).ne.0) then
c--	    
		    annt.x = x1
		  elseif (x1-Mx.text_w.lt.l) then
		    annt.x = x1 - Mx.text_w
                    annt.mode = IAND(int(annt.mode),NOT(L_XFAEndAnchor))
		  else
		    annt.x = x1 - Mx.text_w
c--MODIFIED CODE: Intel Compiler, cast to integer	    		    
		    annt.mode = IOR(int(annt.mode),L_XFAEndAnchor)
c--	    
		  endif
		endif
	      endif
	    endif
	  endif
	enddo
c
	call MX$RCLIP(0, 0, 0, 0)
c
	end


c**************************************************************************
c
c   ~Subroutine VBOXP (stk4, box, x1, y1, x2, y2, xy, idir, xmax, ymax)
c
c  /STKSTRUCT/	stk4	An origin 4 stack structure
c  /XFBOX/	box	The real world coordinates of the box (IN or OUT)
c  integer*4	x1,y1   Upper left pixel corner of box (IN or OUT)
c  integer*4	x1,y1   Lower right pixel corner of box (IN or OUT)
c  logical*4	xy	Indicates how box coordinates are interpreted.
c  integer*4	idir	1: convert from real to pixel, -1: pixel to real
c  integer*4    xmax,ymax  Maximum range to convert from within
c
c  Routine to convert real world coordinate boxes to pixel coordinate boxes,
c  or if idir <= 0 to convert pixel boxes to real world boxes.  Boxes that
c  are out of range (>xmax or <(-xmax) for x, >ymax or <(-ymax) for y) are
c  not converted. i.e. if it is out of the virtual range, the pixel
c  is either set to -2*xmax,2*xmax or -2*ymax,2*ymax, if it is out of the
c  pixel range, the virtual point is simply not set.  That way we don't
c  lose true values after rubber warp box if they were originally plotted
c  way off the screen (minimize rounding error and errors that occur since
c  screen coordinates are finite).
c
c  xy indicates box coordinates are in (x,y,w,h) order, not (y,x,h,w)
c
c  REMEMBER! if the pixel coordinate is not within the -xmax,-ymax,xmax,ymax
c  boundaries, the virtual point value is NOT SET
c
c**************************************************************************

	subroutine VBOXP (stk4, box, x1, y1, x2, y2, xy, idir, xmax, ymax)

	implicit none

	include 'types.inc'
	include 'xstructures.inc'
	include 'xfacilities.inc'
	integer*4 idir, i, x, y, x1, y1, x2, y2, xmax, ymax
	record /XFBOX/ box, vbox
	record /STKSTRUCT/ stk4
	logical*4 xy
	real*8 dx, dy

c 	First of all translate the (x,y,w,h) box to an (x1,y1,x2,y2) 
c 	box.  This is an easier form to work with when certain edges are 
c	not in range and thus should not be translated.

	if (xy) then
	  vbox.x1 = box.xyX
	  vbox.y1 = box.xyY
	  vbox.x2 = box.xyX + box.xyW
	  vbox.y2 = box.xyY + box.xyH
	else
	  vbox.x1 = box.yxX
	  vbox.y1 = box.yxY
	  vbox.x2 = box.yxX + box.yxW
	  vbox.y2 = box.yxY + box.yxH
	endif

	if (idir.gt.0) then	! translate virtual box to pixel box

	  do i = 1,2

	    if (i.eq.1) then
	      dx = (vbox.x1 - stk4.xmin) / stk4.xscl
	      dy = (vbox.y1 - stk4.ymin) / stk4.yscl
	    else
	      x1 = x2
	      y1 = y2
	      dx = (vbox.x2 - stk4.xmin) / stk4.xscl
	      dy = (vbox.y2 - stk4.ymin) / stk4.yscl
	    endif

	    if (dx .gt. xmax) then
	      x2 = 2*xmax
	    elseif (dx .lt. -xmax) then
	      x2 = - 2*xmax
	    else
	      x2 = NINT(dx) + stk4.x1	! dx is added to stk.x1
	    endif

	    if (dy .gt. ymax) then
	      y2 = 2*ymax
	    elseif (dy .lt. -ymax) then
	      y2 = - 2*ymax
	    else
	      y2 = NINT(dy) + stk4.y1 	! dy is added to stk.y1
	    endif

	  enddo

	else			! translate pixel box to virtual box

	  if (abs(x1).lt.xmax) vbox.x1 = stk4.xmin + (x1-stk4.x1) * stk4.xscl
	  if (abs(x2).lt.xmax) vbox.x2 = stk4.xmin + (x2-stk4.x1) * stk4.xscl
	  if (abs(y1).lt.ymax) vbox.y1 = stk4.ymin + (y1-stk4.y1) * stk4.yscl
	  if (abs(y2).lt.ymax) vbox.y2 = stk4.ymin + (y2-stk4.y1) * stk4.yscl

	  if (xy) then
	    box.xyX = min (vbox.x1, vbox.x2)
	    box.xyY = min (vbox.y1, vbox.y2)
	    box.xyW = dabs (vbox.x2 - vbox.x1)
	    box.xyH = dabs (vbox.y2 - vbox.y1)
	  else
	    box.yxX = min (vbox.x1, vbox.x2)
	    box.yxY = min (vbox.y1, vbox.y2)
	    box.yxW = dabs (vbox.x2 - vbox.x1)
	    box.yxH = dabs (vbox.y2 - vbox.y1)
	  endif

	endif

	return

	end

	subroutine BOXES_FILE (Mx, Xf, stk4, filename, mode)
	implicit none
	include 'types.inc'
	include 'xprim.inc'
	include 'xfacilities.inc'
	include 'headers.inc'
c Arguments
	record /XFACILITIES/ Xf
	record /STKSTRUCT/ stk4
	character*(*) filename
	integer*4 mode
c Locals
	record /HEADER/ hcb
	integer*4 i, nget
	record /XFBOX/ box(*)
	pointer (box_ptr, box)
c Code
	call M$INITIALIZE (hcb)
	hcb.file_name = filename(1:M$LENGTH(filename))
	box_ptr = Xf.box.p

	if (mode .lt. 0) then
	  hcb.type = 3020
	  hcb.format = 'SD'
	  call M$ADDSREC(hcb,'ABS','SD')
	  call M$ADDSREC(hcb,'ORD','SD')
	  call M$ADDSREC(hcb,'DABS','SD')
	  call M$ADDSREC(hcb,'DORD','SD')
	  hcb.size = Xf.nbox
	  hcb.switch = 'NOABORT'
	  call M$ALLOCATE (hcb)
	  if (hcb.open) then
	    call M$FILAD (hcb,box,Xf.nbox)
	    call M$CLOSE (hcb)
	    call MX$MESSAGE ('File saved',1.0)
	  else
	    call MX$MESSAGE ('Aborted save',1.0)
	  endif
	else
	  hcb.type_allow = '3000'
	  hcb.format_allow = 'SD'
	  hcb.switch = 'NOABORT'
	  call M$INOK(hcb)
	  if (hcb.open) then
	    if (mode.eq.1 .and. Xf.iarg.eq.-1) then
	      if (Xf.bview) call BPLOT(Mx, Xf, stk4, 1, Xf.nbox)
	      Xf.nbox = 0
	      call BOX_MSG(Xf, box, 0)
	    endif
	    nget = min(INT(hcb.size), Xf.mbox-Xf.nbox)
	    call M$GRAB(hcb, box(Xf.nbox+1), 1.d0, nget, -1)
	    call M$CLOSE(hcb)
	    if (Xf.bview .and. mode.ne.0) then
	      call BPLOT(Mx, Xf, stk4, Xf.nbox+1, Xf.nbox+nget)
	    endif
	    if (Xf.msgid.gt.0) then
	      do i = Xf.nbox+1, Xf.nbox+nget
		Xf.nbox = Xf.nbox + 1
		call BOX_MSG(Xf, box, Xf.nbox)
	      enddo
	    else
	      Xf.nbox = Xf.nbox + nget
	    endif
	    if (nget.lt.INT(hcb.size)) then 
	      if (mode.eq.2) then
		call MX$MESSAGE('Boxes file truncated', 1.0)
	      else
		call M$WARNING('Boxes file truncated')
	      endif
	    endif
	    if (mode.eq.2 .and. .not.Xf.bview) then
	      call MX$MESSAGE('Display Toggled Off', 2.0)
	    endif
	  elseif (mode.eq.2) then
	    call MX$MESSAGE('Error opening file', 1.0)
	  endif
	endif

	return
	end
