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