home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTH / 4THPROG.ZIP / PLOT1.FOR < prev    next >
Encoding:
Text File  |  1985-10-30  |  2.3 KB  |  95 lines
  1. $TITLE: 'PLOT1 bit image dump'
  2.       SUBROUTINE PLOT1
  3.       CHARACTER*1 CHR
  4. C
  5. C   This program requires MS-FORTRAN and the HALO Graphics
  6. C   subroutine library.
  7. C
  8. C       Copy the screen image to an IDS Microprism printer.
  9. C       Must be in HALO graphics mode to call this routine.
  10. C       Image is IXMX x IYMX (usually 640x200) pixels.  The 
  11. C       height of the printed
  12. C       copy appears about 1/2 as high as the screen image.
  13. C       Use "PLOT2" if you want the printed copy to have the 
  14. C       same aspect ratio as the video screen.
  15. C
  16.       OPEN(9,FILE='LPT1:',STATUS='OLD')
  17. C
  18. C   put the printer in graphics mode.
  19. C
  20.       CHR=CHAR(10)
  21.       WRITE(9,'(A\)') CHR
  22.       CHR=CHAR(3)
  23.       WRITE(9,'(A\)') CHR
  24. C
  25. C  Find out what the screen image size is
  26. C
  27.       CALL INQDRA(IXMX,IYMX)
  28. C
  29. C  The printer writes seven-pixel-high lines at a time.
  30. C    The print head will move across the paper LINES number
  31. C    of times.
  32. C
  33.       LINES=IYMX/7 + 1
  34. C
  35.       DO 1000 J=1,LINES
  36.         IYLOW=(J-1)*7
  37. C
  38. C  The printed image is IXMX pixels wide.
  39. C
  40.         DO 900  I=0,IXMX
  41.           ICHR=0
  42.           IF(J.EQ.LINES) THEN
  43. C
  44. C   handle the special case of the last rows of pixels
  45. C    where there may not be 7 rows left.
  46. C
  47.             MAX=MOD(IYMX,7) - 1
  48.           ELSE
  49.             MAX=6
  50.           ENDIF
  51. C
  52.           DO 500 M=0,MAX
  53.             IY=IYLOW + M
  54.             CALL INQCLR(I,IY,ICOL)
  55.             IF(ICOL.NE.0) ICHR=ICHR + 2**M
  56.  500      CONTINUE
  57. C
  58. C   Printer uses 03h as the 'escape' character when in graphics
  59. C    mode- two 03h characters must be sent to print this bit pattern.
  60. C
  61.           IF(ICHR.EQ.3) THEN
  62.             CHR=CHAR(3)
  63.             WRITE(9,'(A\)') CHR
  64.           ENDIF
  65.           CHR=CHAR(ICHR)
  66.           WRITE(9,'(A\)') CHR
  67.  900    CONTINUE
  68. C
  69. C   line feed / CR
  70. C
  71.         CHR=CHAR(3)
  72.         WRITE(9,'(A\)') CHR
  73.         CHR=CHAR(14)
  74.         WRITE(9,'(A\)') CHR
  75.  1000 CONTINUE
  76. C
  77. C  form feed
  78. C
  79.       CHR=CHAR(3)
  80.       WRITE(9,'(A\)') CHR
  81.       CHR=CHAR(12)
  82.       WRITE(9,'(A\)') CHR
  83. C
  84. C  exit graphics mode
  85. C
  86.       CHR=CHAR(3)
  87.       WRITE(9,'(A\)') CHR
  88.       CHR=CHAR(2)
  89.       WRITE(9,'(A\)') CHR
  90. C
  91. C  
  92.       CLOSE(9)
  93.       RETURN
  94.       END
  95.