home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTH / 4THPROG.ZIP / PLOT2.FOR < prev    next >
Encoding:
Text File  |  1985-10-30  |  2.5 KB  |  112 lines
  1. $TITLE: 'PLOT2 interlaced image'
  2.       SUBROUTINE PLOT2
  3.       CHARACTER*1 CHR
  4. C
  5. C     Similar graphics dump routine as "PLOT1" except
  6. C     printer image is twiceas high.  Every other line of 
  7. C     pixels on the printer is blank.  This can be changed
  8. C     so that each horizontal line of pixels is printed 
  9. C     twice.
  10. C
  11.       OPEN(9,FILE='LPT1:',STATUS='OLD')
  12.       CHR=CHAR(10)
  13.       WRITE(9,'(A\)') CHR
  14.       CHR=CHAR(3)
  15.       WRITE(9,'(A\)') CHR
  16.       CALL INQDRA(IXMX,IYMX)
  17. C
  18.       LINES= IYMX/7 + 1
  19.       DO 1000 J=1,LINES
  20.         IYLOW=(J-1)*7
  21.         DO 900  I=0,IXMX
  22.           ICHR=0
  23. C   ------------- special case 640 x 352
  24.           IF(J.EQ.LINES) THEN
  25.             MAX= MOD(IYMX,7) - 1
  26.           ELSE
  27.             MAX=3
  28.           ENDIF
  29. C
  30.           MM=0
  31.           DO 500 M=0,MAX
  32.             IY=IYLOW + M
  33.             CALL INQCLR(I,IY,ICOL)
  34.             IF(ICOL.NE.0) ICHR=ICHR + 2**MM
  35. C
  36. C     For an interlaced dump where each horizontal row of
  37. C    pixels is repeated      comment out the next line 
  38. C
  39.               MM=MM+2
  40. C
  41. C     and insert the following lines
  42. C             MM=MM+1
  43. C             IF(ICOL.NE.0) ICHR=ICHR + 2**MM
  44. C             MM=MM+1
  45. C
  46.  500      CONTINUE
  47. C
  48.           CHR=CHAR(ICHR)
  49.           WRITE(9,'(A\)') CHR
  50.  900    CONTINUE
  51. C
  52. C   line feed / CR
  53. C
  54.         CHR=CHAR(3)
  55.         WRITE(9,'(A\)') CHR
  56.         CHR=CHAR(14)
  57.         WRITE(9,'(A\)') CHR
  58. C
  59.         IF(J.NE.LINES) THEN
  60.           MAX=6
  61.           DO 1900  I=0,IXMX
  62.             ICHR=0
  63. C
  64.             MM=1
  65.             DO 1500 M=4,MAX
  66.               IY=IYLOW + M
  67.               CALL INQCLR(I,IY,ICOL)
  68.               IF(ICOL.NE.0) ICHR=ICHR + 2**MM
  69. C
  70. C     For an interlaced dump comment out the next line 
  71.               MM=MM+2
  72. C
  73. C     and insert the following lines
  74. C             MM=MM+1
  75. C             IF(ICOL.NE.0) ICHR=ICHR + 2**MM
  76. C             MM=MM+1
  77. C
  78.  1500       CONTINUE
  79. C
  80.             CHR=CHAR(ICHR)
  81.             WRITE(9,'(A\)') CHR
  82.  1900     CONTINUE
  83. C
  84. C   line feed / CR
  85. C
  86.           CHR=CHAR(3)
  87.           WRITE(9,'(A\)') CHR
  88.           CHR=CHAR(14)
  89.           WRITE(9,'(A\)') CHR
  90.         ENDIF
  91.  1000 CONTINUE
  92. C
  93. C  form feed
  94. C
  95.       CHR=CHAR(3)
  96.       WRITE(9,'(A\)') CHR
  97.       CHR=CHAR(12)
  98.       WRITE(9,'(A\)') CHR
  99. C
  100. C  exit graphics
  101. C
  102.       CHR=CHAR(3)
  103.       WRITE(9,'(A\)') CHR
  104.       CHR=CHAR(2)
  105.       WRITE(9,'(A\)') CHR
  106. C
  107.       CLOSE(9)
  108. C
  109. C  
  110.       RETURN
  111.       END
  112.