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