      SUBROUTINE APMON(X,Y,IND)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 

      integer*2 strid             
      integer*4 status
      COMMON /OUTPUT/ IPAPER,IPAGE
      COMMON /DEVICE/ ITYPE, ISCRN, KOROFF
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
      SAVE strid
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*

*
*   CODES FOR IND:
*     IND = 0   =>  REMOVE ALL GRAPHICS TO QUIT
*     IND = 1   =>  ANY ONE TIME ONLY INITIALIZATION
*     IND = 2   =>  MOVE GRAPHICS TO POINT (X,Y) -- DO NOT DRAW LINE
*     IND = 3   =>  DRAW LINE FROM LAST POINT TO NEW (X,Y)
*     IND = 4   =>  DRAW DARK LINE
*     IND = 5   =>  DRAW BRIGHT SOLID LINE
*     IND = 6   =>  INITIALIZE & SET-UP FOR NEXT PICTURE
*     IND = 8   =>  TEMPORARY RELEASE FROM GRAPHICS
*     IND = 9   =>  RETURN TO GRAPHICS FROM TEMP RELEASE
*     IND =10   =>  DONE DRAWING PICTURE
*
*     IND =99   =>  SET COLOR TO VALUE IN X
*
*

         PIXROW = 500 / 26
         PIXCOL = 500 / 58
         MAXPIX = 26. * PIXROW
         PIXEL =  MAXPIX * IPAGE / 100.
         ISCRN = 28
         NCOLOR = 0
         IXL = 0
         IXR = 500
         IYT = 0
         IYB = 500
         IMAXC = 80
         IMAXR = 19
      IF (IND .EQ. 0) THEN
         call gpr_$terminate(.false., status)
	 INGRAF = 0
      ELSEIF (IND .EQ. 1) THEN
         INGRAF = 0
         call create_window(strid)
	 call set_line_color(0)
      ELSEIF (IND .EQ. 2) THEN
         IXLX = X * PIXEL
         IYLY = (1.0 - Y) * PIXEL
         call move_to_xy( IXLX, IYLY)
      ELSEIF (IND .EQ. 3) THEN
         IXLX = X * PIXEL
         IYLY = (1.0 - Y) * PIXEL
         call draw_to_xy( IXLX, IYLY)
      ELSEIF (IND .EQ. 4) THEN
	 RETURN
      ELSEIF (IND .EQ. 5) THEN
         RETURN
      ELSEIF (IND .EQ. 6) THEN
         call clear_frame(strid,7)
      ELSEIF (IND .EQ. 8) THEN 
         ingraf = 0
 	 RETURN
      ELSEIF (IND .EQ. 9) THEN
         ingraf = 0   
	 RETURN
      ELSEIF (IND .EQ. 10) THEN
         RETURN
      ELSEIF (IND .EQ. 99) THEN
         RETURN
      ELSE 
	 write (5,*) "Error in apmon. IND = ", IND 
      ENDIF                                        

      RETURN
      END


C ****************************************************************************


      subroutine bitmaps(strid)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 
%include '/sys/ins/pad.ins.ftn'

      integer*2  strid
      integer*2  event
      integer*4  key_set(8), status

      event = gpr_$entered_window
      call    gpr_$enable_input(event, key_set, status)
      call    pad_$set_auto_close(strid, int2(1), .true., status)
      call    gpr_$set_obscured_opt(gpr_$pop_if_obs, status)
      call    gpr_$set_auto_refresh(.true.,status)

      return
      end   


C ****************************************************************************


      subroutine create_window(strid)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 
%include '/sys/ins/pad.ins.ftn'

      integer*2  mode, strid, window(4), display_size(2), hi_plane
      integer*4  display, status

      parameter  (mode = gpr_$direct)
      parameter  (hi_plane = 3)

      data       window/0,0,500,500/
      data       display_size/500,500/


      call pad_$create_window('', int2(0), pad_$transcript, int2(1), 
     +                        window, strid, status)

      call gpr_$init(mode, strid, display_size, hi_plane,
     +               display, status)
      call gpr_$set_window_id('1', status)
      call bitmaps(strid)
      call gpr_$set_bitmap(display, status)

      return
      end


C ****************************************************************************


      subroutine draw_to_xy(x,y)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 

      integer*4 display, status
      integer*2 int_x, int_y
      integer   x, y
      logical   unobs                       

      int_x = int2(x)
      int_y = int2(y)     

      call    gpr_$set_bitmap(display, status)
      unobs = gpr_$acquire_display(status)
      call    gpr_$line(int_x,int_y, status)
      call    gpr_$release_display(status)

      return
      end                   
C ***************************************************************** 
      subroutine move_to_xy(x,y)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 

      integer*4 display, status
      integer*2 int_x, int_y
      integer   x, y
      logical   unobs                       
    
      int_x = int2(x)
      int_y = int2(y)      

      call    gpr_$set_bitmap(display, status)
      unobs = gpr_$acquire_display(status)
      call    gpr_$move(int_x, int_y, status)
      call    gpr_$release_display(status)

      return
      end           


C *************************************************************        


      subroutine clear_frame(strid,color)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/pad.ins.ftn'

        integer*4 display, status, color
        integer*2 strid                
	logical   unobs

        call    gpr_$set_bitmap(display, status)
        unobs = gpr_$acquire_display(status)
        call    gpr_$clear( color, status)
        call    gpr_$release_display(status)

        return
	end

C *************************************************************
C *************************************************************
C *************************************************************


      SUBROUTINE APCOL(X,Y,IND)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn' 

      integer*2 strid, color_list(64), i             
      integer*4 status, background
      COMMON /OUTPUT/ IPAPER,IPAGE
      COMMON /DEVICE/ ITYPE, ISCRN, KOROFF
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
      SAVE strid
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*

*
*   CODES FOR IND:
*     IND = 0   =>  REMOVE ALL GRAPHICS TO QUIT
*     IND = 1   =>  ANY ONE TIME ONLY INITIALIZATION
*     IND = 2   =>  MOVE GRAPHICS TO POINT (X,Y) -- DO NOT DRAW LINE
*     IND = 3   =>  DRAW LINE FROM LAST POINT TO NEW (X,Y)
*     IND = 4   =>  DRAW DARK LINE
*     IND = 5   =>  DRAW BRIGHT SOLID LINE
*     IND = 6   =>  INITIALIZE & SET-UP FOR NEXT PICTURE
*     IND = 8   =>  TEMPORARY RELEASE FROM GRAPHICS
*     IND = 9   =>  RETURN TO GRAPHICS FROM TEMP RELEASE
*     IND =10   =>  DONE DRAWING PICTURE
*
*     IND =99   =>  SET COLOR TO VALUE IN X
*
*

	 DO 1 i = 1, 64
	    color_list(i-1) = i
 1	 CONTINUE
           
	 background = 0
         PIXROW = 500 / 26
         PIXCOL = 500 / 58
         MAXPIX = 26. * PIXROW
         PIXEL =  MAXPIX * IPAGE / 100.
         ISCRN = 28
         NCOLOR = 64
         IXL = 0
         IXR = 500
         IYT = 0
         IYB = 500
         IMAXC = 80
         IMAXR = 19
      IF (IND .EQ. 0) THEN
         call gpr_$terminate(.false., status)
	 INGRAF = 0
      ELSEIF (IND .EQ. 1) THEN
         INGRAF = 0
         call create_window(strid)
      ELSEIF (IND .EQ. 2) THEN
         IXLX = X * PIXEL
         IYLY = (1.0 - Y) * PIXEL
         call move_to_xy( IXLX, IYLY)
      ELSEIF (IND .EQ. 3) THEN
         IXLX = X * PIXEL
         IYLY = (1.0 - Y) * PIXEL
         call draw_to_xy( IXLX, IYLY)
      ELSEIF (IND .EQ. 4) THEN
	 RETURN
      ELSEIF (IND .EQ. 5) THEN
         RETURN
      ELSEIF (IND .EQ. 6) THEN
         call clear_frame(strid, background)
      ELSEIF (IND .EQ. 8) THEN 
         ingraf = 0
 	 RETURN
      ELSEIF (IND .EQ. 9) THEN
         ingraf = 0   
	 RETURN
      ELSEIF (IND .EQ. 10) THEN
         RETURN
      ELSEIF (IND .EQ. 99) THEN
         call set_line_color( color_list(INT(X)) )
      ELSE 
	 write (5,*) "Error in apmon. IND = ", IND 
      ENDIF                                        

      RETURN
      END

C *************************************************************

        subroutine set_line_color(color)
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/pad.ins.ftn'  

        integer*4 status
	integer*2 color

        call gpr_$set_draw_value(color, status)
        return
        end


