Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0049/font1c.for
There is 1 other file named font1c.for in the archive. Click here to see a list.
SUBROUTINE LTRPLT(LWORD,LTRBGN,LTREND,KONTRL,KSCALE,LASTX,LASTY,
1LX7,LY7)
C (PDP-10 VERSION)
C SIMPLE ALPHANUMERIC PLOTTING PROGRAM FOR GENPLT-II PLOT PACKAGE
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C THIS SUBROUTINE IS NOT MEANT TO BE CALLED DIRECTLY BY USER
C CDC VERSION CALLS FUNCTION ISHIFT.
C
C SUBROUTINE LTRPLT ARGUMENT LIST DEFINITIONS.
C
C LWORD = WORD ARRAY TO BE PLOTTED, READ BY 12A6 FORMAT.
C LTRBGN = FIRST LETTER IN WORD ARRAY TO BE PLOTTED.
C LTREND = FINAL LETTER IN WORD ARRAY TO BE PLOTTED.
C PLOTTING OF ARRAY IS ALSO TERMINATED BY $ CHARACTER.
C KONTRL = INDEX SELECTING HORIZONTAL OR VERTICAL LETTERING.
C KONTRL = 0 OFFSETS LX7 TO RIGHT BUT SUPPRESSES ACTUAL LETTERING.
C KNOTRL = 1 LETTERS HORIZONTALLY FROM LEFT TO RIGHT.
C KONTRL = 2 LETTERS VERTICALLY FROM BOTTOM TO TOP.
C KSCALE = HEIGHT OF LETTERS TO BE PLOTTED IN GRID COORDINATES / 6.
C LASTX = LAST X GRID COORDINATE PLOTTED.
C LASTY = LAST Y GRID COORDINATE PLOTTED.
C LX7 = X GRID COORDINATE OF LOWER LEFT CORNER OF PLOTTED LETTER.
C LY7 = Y GRID COORDINATE OF LOWER LEFT CORNER OF PLOTTED LETTER.
C
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
.IFREER,ILINE
DIMENSION LWORD(12),KRD(250),LOCATN(64)
C
DATA (LOCATN(I), I=1, 64) / 3011, 54061, 127135, 29042,
1 157162, 190199, 21035, 51054, 27044, 38050, 300300,
2 152156, 163168, 164175, 164174, 300300, 200204, 142147,
3 63073, 3010, 15022, 77083, 78083, 1010, 82089,
4 54062, 300300, 170174, 18022, 300300, 300300, 300300,
5 200201, 90094, 97104, 77079, 103107, 109112, 3011,
6 68074, 3014, 68077, 300300, 301301, 148152, 300300,
7 300300, 300300, 300300, 125126, 131140, 121125, 89094,
8 95097, 106110, 112116, 116121, 124127, 300300, 170175,
9 5008, 121122, 176183, 184189/
C
C POINTER CHARACTER, BCD CODE/ 0 = 00 , 1 = 01 , 2 = 02 , 3 = 03 ,
C 4 = 04 , 5 = 05 , 6 = 06 , 7 = 07 , 8 = 08 , 9 = 09 , ****** ,
C = = 11 , @ = 12 , ****** , ****** , ****** , + = 16 , A = 17 ,
C B = 18 , C = 19 , D = 20 , E = 21 , F = 22 , G = 23 , H = 24 ,
C I = 25 , ****** , . = 27 , ) = 28 , ****** , ****** , ****** ,
C - = 32 , J = 33 , K = 34 , L = 35 , M = 36 , N = 37 , O = 38 ,
C P = 39 , Q = 40 , R = 41 , ****** , $ = 43 , * = 44 , ****** ,
C ****** , ****** , = 48 , / = 49 , S = 50 , T = 51 , U = 52 ,
C V = 53 , W = 54 , X = 55 , Y = 56 , Z = 57 , ****** , , = 59 ,
C ( = 60 ,VERTICAL,RITARROW,RITARROW/
C VERTICAL AND RITARROW ARE SPECIAL SYMBOLS.
C VERTICAL IS A SINGLE VERTICAL LINE.
C THE TWO RITARROW SYMBOLS ARE THE FEATHER END AND THE POINT END
C OF AN ARROW POINTING TO THE RIGHT.
C
DATA ( KRD(I), I=1,204) /33,43,41,30,10, 1, 5,16,36,45,41,77,22,
140,36, 6,-0,30,41,44,45,36,16, 5, 2,77,13, 2, 1,10,30,41,42,33,13,
277,33,44,45,36,16, 5, 4,13,33,44,41,30,10, 1, 5, 6,46,10,30,77,20,
326,77,16,26,36, 3,33,42,41,30, 0, 6,36,45,44,33, 3,77,33,40, 0, 6,
446,77, 3,43,77,46,40,77, 0, 6, 1,10,30,41,46, 6,20,46, 2,77,40,24,
577, 0, 6,23,46,40,23, 0, 6,40,46, 0,77,40, 6,23,46,77,23,20,26,77,
6 6,46, 0,40, 0, 1,44,45,36,16, 5, 4,42,41,30,10, 1, 2, 0,26,40,77,
733,13, 1,45,77, 5,41, 1,77, 4,44,40,44,77,46, 2,42,13,24,35,26,15,
824,77,20,11,22,31,20,88,43,23, 5, 6,33, 0, 1,23, 3,33, 6,53, 0,33,
946, 6, 3,14,34,43,41,30,10, 1, 3,43,77,25,21/
C
MODE = ILINE
DO 23 J=LTRBGN,LTREND
C
C ******************DETERMINE LETTER TO BE PLOTTED******************
LTR=IBCD(LWORD,J)
C
C ***************************PLOT LETTER****************************
7 KRDBGN=LOCATN(LTR+1)/1000
KRDEND=LOCATN(LTR+1)-(1000*KRDBGN)
IF(KONTRL-1)15,16,8
C
C KONTRL=2, VERTICAL LETTERING
8 IF(KRDBGN-300)9,14,24
9 NEWY=KRD(KRDBGN)/10
NEWX=KRD(KRDBGN)-(10*NEWY)
NEWY=LY7+(NEWY*KSCALE)
NEWX=LX7-(NEWX*KSCALE)
CALL PENUP(LASTX,LASTY,NEWX,NEWY)
KRDNEW=KRDBGN+1
DO 13 N=KRDNEW,KRDEND
IF(KRD(N)-77)12,10,11
10 KRDBGN=N+1
GO TO 9
11 NEWX=LX7+KSCALE
NEWY=LY7+KSCALE
GO TO 13
12 NEWY=KRD(N)/10
NEWX=KRD(N)-(10*NEWY)
NEWY=LY7+(NEWY*KSCALE)
NEWX=LX7-(NEWX*KSCALE)
13 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
14 LY7=LY7+(6*KSCALE)
GO TO 23
C
C KONTRL=1, HORIZONTAL LETTERING
15 IF(KRDBGN-300)22,22,24
16 IF(KRDBGN-300)17,22,24
17 NEWX=KRD(KRDBGN)/10
NEWY=KRD(KRDBGN)-(10*NEWX)
NEWX=LX7+(NEWX*KSCALE)
NEWY=LY7+(NEWY*KSCALE)
CALL PENUP(LASTX,LASTY,NEWX,NEWY)
KRDNEW=KRDBGN+1
DO 21 N=KRDNEW,KRDEND
IF(KRD(N)-77)20,18,19
18 KRDBGN=N+1
GO TO 17
19 NEWX=LX7+KSCALE
NEWY=LY7-KSCALE
GO TO 21
20 NEWX=KRD(N)/10
NEWY=KRD(N)-(10*NEWX)
NEWX=LX7+(NEWX*KSCALE)
NEWY=LY7+(NEWY*KSCALE)
21 CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
22 LX7=LX7+(6*KSCALE)
23 CONTINUE
24 RETURN
END