Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0049/xrxhlt.for
There is 1 other file named xrxhlt.for in the archive. Click here to see a list.
      SUBROUTINE PENHLT (LASTX,LASTY,NEWX,NEWY)
C                                               5/24/70
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     GENPLT-II COUPLING ROUTINE FOR XEROX TELECOPIER II
C     THIS ROUTINE IS USED WITH REST OF PRINTER PACKAGE
C
      COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,
     1MODE,IPOINT,IFREER,ILINE
      COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,
     1IDWN,MISS,MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,
     2IDIVY
      DATA IPLOT/0/
C
      IF(IPLOT)1,1,8
    1 IPLOT=1
C
C     ASK USER FOR TAPE UNIT NUMBER AND FILE NAME
C     (ITTY IS TELETYPE UNIT NUMBER)
      ITTY=5
      WRITE(ITTY,2)
    2 FORMAT(27H WHAT IS OUTPUT UNIT NUMBER/1X)
      READ(ITTY,3)NTAPE
    3 FORMAT(I)
      WRITE(ITTY,4)
    4 FORMAT(25H WHAT IS OUTPUT FILE NAME/1X)
      READ(ITTY,5)NAME
    5 FORMAT(1A5)
      CALL OFILE(NTAPE,NAME)
C
C     DEFINE PLOT FORMAT
C
C     VARIABLES LTTRS, LINES, IRESOL AND LOOP CONTROL
C     PLOT FORMAT.  THESE CAN BE MODIFIED IF DIMENSION OF
C     THE NUMBER ARRAY IS INCREASED IF NECESSARY.  FORMAT
C     STATEMENTS WILL REQUIRE CHANGE IF KONTNT VARIABLE
C     IS INCREASED.  DIMENSION OF ITWO ARRAY MUST BE AT
C     LEAST THE VALUE OF THE IBITS VARIABLE.  THE NUMBER
C     AND ITWO ARRAYS MUST HAVE THE SAME DIMENSIONS IN
C     THE COMMON/PRINTR/ STATEMENTS IN THE PRINTER
C     COUPLING ROUTINES PENUP AND PENDWN AS IN THIS
C     ROUTINE.
C
C     LTTRS  = HORIZONTAL STRIP LENGTH IN TIME UNITS
C     LINES  = NUMBER OF HORIZONTAL STRIPS
C     IRESOL = HORIZONTAL RESOLUTION STATED IN TIME UNITS
C              (NUMBER OF TIME UNITS REPRESENTED PER BIT)
C     LOOP   = VERTICAL RESOLUTION AS NUMBER OF STRIPS
C              (NUMBER OF TIMES EACH STRIP APPEARS)
C     KONTNT = MAXIMUM TIME UNIT CONTENT OF OUTPUT RECORD
C     IBITS  = NUMBER OF BITS USED PER WORD
C
C     NOTE.....TELECOPIER COMPLETES 1 INCH OF HORIZONTAL
C              MOTION IN 40 TIME UNITS (MILLISECONDS)
C              AND 1 INCH OF VERTICAL MOTION WITH 96
C              STRIPS.  TO OBTAIN CONSTANT PLOTTED LINE
C              DENSITY AT ANY ANGLE, EACH BIT IN THE
C              STORAGE ARRAY MUST REPRESENT APPROXIMATELY
C              TWICE AS MANY HORIZONTAL STRIPS (EXACT
C              MULTIPLE IS LINES/LTTRS) AS TIME UNITS.
C              THEREFORE, LOOP (THE NUMBER OF STRIPS)
C              IS CALCULATED FROM IRESOL (THE NUMBER OF
C              TIME UNITS).  HOWEVER, LOOP AND IRESOL
C              COULD JUST AS WELL BOTH BE DEFINED IN
C              TERMS OF SPECIFIC CONSTANTS.
C
C     NOTE.....THE MINIMUM NUMBER ARRAY DIMENSION IS
C
C              LTTRS
C              ------  +  IBITS  -  1
C              IRESOL                     LINES
C              ----------------------  *  -----
C                      IBITS              LOOP
C
C     EACH RECORD IN OUTPUT FILE CONTAINS SINGLE DECIMAL
C     DIGIT INDICATING TONE TO BE SENT TO TELECOPIER
C     (0 = MINIMUM PRINTING DENSITY, 7 = MAXIMUM, 8 =
C     END OF PLOT) FOLLOWED BY 5 OCTAL DIGITS INDICATING
C     DURATION OF SIGNAL AT THIS LEVEL.
C
      LTTRS=333
      LINES=792
      IRESOL=2
      LOOP=(LINES*IRESOL)/LTTRS
      KONTNT=32767
      IBITS=30
C
C     INITIALIZE CONTENTS OF LABELED COMMON
      LTRS=LTTRS/IRESOL
      LINS=LINES/LOOP
      ICOL=(LTRS+IBITS-1)/IBITS
      LOST=(IBITS*ICOL)-LTRS
      LOSEX=LTTRS-(LTRS*IRESOL)
      LOSEY=LTTRS*(LINES-(LINS*LOOP))
      LIMIT=ICOL*LINS
      DO 6 I=1,LIMIT
    6 NUMBER(I)=0
      ITWO(1)=1
      KOMP=1
      DO 7 I=2,IBITS
      ITWO(I)=2*ITWO(I-1)
    7 KOMP=KOMP+ITWO(I)
      IUP=0
      IDWN=0
      MISS=0
      MINX=0
      MAXX=LTRS-1
      MINY=0
      MAXY=LINS-1
      IDIVX=LINS
      IDIVY=LTRS
      IADDX=IDIVX
      IADDY=(LTRS*LINS)+IDIVY-1
      FACTOR=(LTRS*LINS)-1
      OFSETX=0.0
      OFSETY=0.0
      IERR=0
      RETURN
C
C     TEST FOR PLOTTING SINCE LAST CALL TO PENHLT
    8 DO 9 I=1,LIMIT
      IF(NUMBER(I))9,9,10
    9 CONTINUE
      IRECRD=0
      IF(IUP)52,52,50
C
C     SUPPLY TIMING SIGNAL
   10 DO 11 I=1,45
   11 WRITE(NTAPE,12)
   12 FORMAT(6H000015/6H700500)
C     92 INCLUDES TIMING, LAST PLOTTING AND END RECORDS
      IRECRD=92
C
C     DECODE NUMBER ARRAY INTO TONE DURATIONS
      KIND=0
      INTRVL=1005
      KOUNT=0
      DO 41 K=1,LINS
      DO 39 L=1,LOOP
      DO 38 J=1,ICOL
      KOUNT=KOUNT+1
      INDEX=IBITS
C     TEST FOR WORD REPRESENTING ALL WHITE
      IF(NUMBER(KOUNT))13,13,16
   13 IF(J-ICOL)14,15,15
   14 JUMP=IBITS
      GO TO 19
   15 JUMP=IBITS-LOST
      GO TO 19
C     TEST FOR WORD REPRESENTING ALL BLACK
   16 IF(NUMBER(KOUNT)-KOMP)18,17,18
   17 JUMP=IBITS
      GO TO 21
   18 JUMP=1
C     TEST IF BIT IN WORD REPRESENTS BLACK OR WHITE
      KOMPAR=NUMBER(KOUNT)/ITWO(INDEX)
      IF(KOMPAR-2*(KOMPAR/2))19,19,21
   19 IF(KIND)20,20,26
   20 IF(INTRVL+(IRESOL*JUMP)-KONTNT)30,30,24
   21 IF(KIND)23,23,22
   22 IF(INTRVL+(IRESOL*JUMP)-KONTNT)30,30,27
   23 KIND=1
   24 WRITE(NTAPE,25)INTRVL
   25 FORMAT(1H0,1O5)
      GO TO 29
   26 KIND=0
   27 WRITE(NTAPE,28)INTRVL
   28 FORMAT(1H7,1O5)
   29 IRECRD=IRECRD+1
      INTRVL=0
   30 INTRVL=INTRVL+(IRESOL*JUMP)
      INDEX=INDEX-JUMP
      IF(J-ICOL)31,32,32
   31 IF(INDEX)38,38,18
   32 IF(INDEX-LOST)33,33,18
C     EXTEND STRIP TO DESIRED NUMBER OF TIME UNITS
   33 IF(INTRVL+LOSEX-KONTNT)34,34,35
   34 INTRVL=INTRVL+LOSEX
      GO TO 38
   35 IRECRD=IRECRD+1
      IF(KIND)36,36,37
   36 WRITE(NTAPE,25)INTRVL
      INTRVL=LOSEX
      GO TO 38
   37 WRITE(NTAPE,28)INTRVL
      INTRVL=LOSEX
   38 CONTINUE
   39 KOUNT=KOUNT-ICOL
C     ZERO PREVIOUS STRIP STORAGE AND ADVANCE SUBSCRIPT
      DO 40 L=1,ICOL
      KOUNT=KOUNT+1
   40 NUMBER(KOUNT)=0
   41 CONTINUE
C
C     SUPPLY DESIRED NUMBER OF LINES AND DUMP BUFFER
      IF(KIND)42,42,45
   42 IF(INTRVL+LOSEY-KONTNT)44,44,43
   43 WRITE(NTAPE,25)INTRVL
      IRECRD=IRECRD+1
      INTRVL=0
   44 INTRVL=INTRVL+LOSEY
      WRITE(NTAPE,25)INTRVL
      GO TO 48
   45 IF(INTRVL+LOSEY-KONTNT)47,47,46
   46 WRITE(NTAPE,28)INTRVL
      IRECRD=IRECRD+1
      INTRVL=0
   47 INTRVL=INTRVL+LOSEY
      WRITE(NTAPE,28)INTRVL
C
C     WRITE END-OF-PLOT RECORD ON TAPE AND SUMMARY ON TTY
   48 WRITE(NTAPE,49)
   49 FORMAT(6H800000)
   50 WRITE(ITTY,51)IPLOT,IUP,IDWN,IRECRD,IERR
   51 FORMAT(1H0,7X,4HPLOT,1I3,8H SUMMARY/
     11H ,1I6,16H PENUP  COMMANDS/
     21H ,1I6,16H PENDWN COMMANDS/
     31H ,1I6,16H OUTPUT  RECORDS/
     41H ,1I6,16H LINES NOT SHOWN)
      IERR=MISS
      MISS=0
      IUP=0
      IDWN=0
      IPLOT=IPLOT+1
   52 RETURN
      END