Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/ltrplc.f4
There are no other files named ltrplc.f4 in the archive.
      SUBROUTINE LTRPLT(LWORD,LTRBGN,LTREND,KONTRL,KSCALE,LASTX,LASTY,
     1LX7,LY7)
C     (PDP-10 VERSION)
C     ADVANCED ALPHANUMERIC PLOTTING PROGRAM FOR GENPLT-II
C                                                               02/09/68
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 A6 FORMAT.
C     LTRBGN = FIRST LETTER IN WORD ARRAY TO BE PLOTTED.
C     LTREND = FINAL LETTER IN WORD ARRAY TO BE PLOTTED.
C     KONTRL = INDEX SELECTING LETTERING ANGLE.
C     KONTRL = NEGATIVE IS LETTERING ANGLE IN DEGREES FROM HORIZONTAL.
C     KONTRL = 0 SUPPRESSES LETTERING OF ARRAY.
C     KONTRL = 1 (OR -360) LETTERS HORIZONTALLY FROM LEFT TO RIGHT.
C     KONTRL = 2 (OR -270) 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
C     THIS VERSION DOES NOT PLOT $ AND ITS FOLLOWING CHARACTER IN ARRAY.
C     WHEN $ CHARACTER IS SENSED, FOLLOWING CHARACTER SELECTS OPTION.
C     THESE OPTIONS INCLUDE UPPER AND LOWER CASE ROMAN AND GREEK
C     LETTERING, SIZE MODIFICATION, SUPERSCRIPTING AND SUBSCRIPTING,
C     ITALIC LETTERING, BACKSPACING, AND SHIFTING TO NEW LINES.
C
       COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
     1IFREER,ILINE
      COMMON/FONT/LOCATN(128),KRD(950),ICHECK(2)
      DIMENSION LWORD(1),LCHECK(3)
      DIMENSION I32(3)
      DATA I32/33554432,32768,32/
      DATA KIND/1/,LEFT/10000/,KLEAR/100000000/
      DATA LCHECK/4HFONT,4H MIS,4HSING/
C
      IF(LCHECK(1)-ICHECK(1))50,1,50
    1 IF(LCHECK(2)-ICHECK(2))50,2,50
    2 MODE = ILINE
      IF(KONTRL)4,3,5
    3 IKIND=KIND
      ILEFT=LEFT
      IKLEAR=KLEAR
    4 ANGLE=0.0174532925*FLOAT(KONTRL)
      ASIN=SIN(ANGLE)
      ACOS=COS(ANGLE)
      GO TO 6
    5 ASIN=KONTRL-1
      ACOS=2-KONTRL
    6 LTRNEW=LTRBGN
      XSTART=LX7
      YSTART=LY7
      XDIST=0.0
    7 YDIST=0.0
      SCALE=FLOAT(KSCALE*6)/42.0
      XSCALE=SCALE
      YSCALE=1.5*SCALE
      SLANT=0.
C
C     ************DETERMINE BCD CODE OF LETTER TO BE PLOTTED************
    8 MULT=1
    9 IF(LTRNEW-LTREND)10,10,47
   10 LTR=IBCD(LWORD,LTRNEW)-63+(64*KIND)
      LTRNEW=LTRNEW+1
C
C     ******TEST IF $ CHARACTER IS USED TO INDICATE SPECIAL OPTION******
      INDEX=1+(LOCATN(LTR)/100000000)
      IF(MULT)20,20,18
   18 IF(INDEX-6)33,19,33
   19 MULT=0
      GO TO 9
   20 GO TO (47,23,24,25,26,28,29,30,31,32,21,22),INDEX
C
C     **********$( OPTION**********NARROW LETTER************************
   21 XSCALE=SCALE/1.5
      GO TO 8
C
C     **********$) OPTION**********WIDE LETTER**************************
   22 XSCALE=1.5*SCALE
      GO TO 8
C
C     **********$+ OPTION**********SUPERSCRIPT LETTERING****************
   23 YSCALE=SCALE
      YDIST=28.0*SCALE
      GO TO 8
C
C     **********$- OPTION**********SUBSCRIPT LETTERING******************
   24 YSCALE=SCALE
      YDIST=-14.0*SCALE
      GO TO 8
C
C     **********$* OPTION**********LETTER SIZE 3/2 NORMAL***************
   25 COMPAR=FLOAT(KSCALE*9)/(42.0*SCALE)
      GO TO 27
C
C     **********$/ OPTION**********LETTER SIZE 2/3 NORMAL***************
   26 COMPAR=FLOAT(KSCALE*4)/(42.0*SCALE)
   27 SCALE=SCALE*COMPAR
      YSCALE=YSCALE*COMPAR
      XSCALE=XSCALE*COMPAR
      YDIST=YDIST*COMPAR
      GO TO 8
C
C     **********$$ OPTION**********ITALIC LETTERING*********************
   28 SLANT=0.3
      GO TO 8
C
C     **********$, OPTION**********BACKSPACE****************************
   29 XDIST=XDIST-(28.0*XSCALE)-(14.0*SCALE)
      GO TO 8
C
C     **********$. OPTION**********BEGIN LETTERING NEXT LINE************
   30 XSTART=XSTART+(9.0*ASIN*FLOAT(KSCALE))
      YSTART=YSTART-(9.0*ACOS*FLOAT(KSCALE))
      XDIST=0.0
      GO TO 8
C
C     **********$1 OPTION**********UPPER CASE ROMAN LETTERING***********
C     **********$2 OPTION**********LOWER CASE ROMAN LETTERING***********
C     **********$3 OPTION**********UPPER CASE GREEK LETTERING***********
C     **********$4 OPTION**********LOWER CASE GREEK LETTERING***********
   31 LTR=LTR-(64*(KIND-1))
      KIND=LTR/2
      LEFT=10000-((LTR-(2*KIND))*9999)
      KLEAR=10000*LEFT
      GO TO 8
C
C     **********$= OPTION**********RETURN TO NORMAL LETTERING***********
   32 KIND=1
      LEFT=10000
      KLEAR=100000000
      GO TO 7
C
C     ***************************PLOT LETTER****************************
   33 MOVE=0
      KOMPAR=-1
      SCALEX=XSCALE
      KOUNT=(LOCATN(LTR)/LEFT)-(10000*(LOCATN(LTR)/KLEAR))
      KRDX=KRD(KOUNT)/33554432
      KRDY=(KRD(KOUNT)/1048576) -(32*KRDX)
      KOUNT=3*KOUNT
C
C                           ***  TEST FOR LETTERING SUPPRESSION
      IF(KONTRL)36,34,36
   34 IF(KRDX-29)41,35,41
   35 IF(KRDY-29)40,41,41
   36 IF(KRDX-29)43,37,42
   37 IF(KRDY-29)44,41,41
C     COORDINATE BELOW 29   ***  CONTINUE LINE TO COORDINATES
   38 CRDY=YSCALE*FLOAT(KRDY)
      CRDX=(SCALEX*FLOAT(KRDX))+(SLANT*CRDY)
      NEWX=XSTART+(ACOS*(CRDX+XDIST))-(ASIN*(CRDY+YDIST))
      NEWY=YSTART+(ACOS*(CRDY+YDIST))+(ASIN*(CRDX+XDIST))
      CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
C                           ***  SELECT NEXT COORDINATES
   39 KOUNT=KOUNT+1
      L=KOUNT/3
      K=1+KOUNT-3*L
      K=I32(K)
      KRDX=(KRD(L)/K)-(32*(KRD(L)/(K*32)))
      KRDY=(KRD(L)/(K/32))-(32*(KRD(L)/K))-MOVE
      IF(KRDX-KOMPAR)38,41,42
C     OPTION COORDINATE 29  ***  LETTER IS COMPLETED
   40 SCALEX=XSCALE*FLOAT(KRDY)/14.0
   41 XDIST=XDIST+(28.0*SCALEX)+(14.0*SCALE)
      GO TO 9
   42 IF(KRDX-30)43,45,46
C     COORDINATE BELOW 29   ***  START NEW LINE AT COORDINATES
   43 KOMPAR=29
      CRDY=YSCALE*FLOAT(KRDY)
      CRDX=(SCALEX*FLOAT(KRDX))+(SLANT*CRDY)
      NEWX=XSTART+(ACOS*(CRDX+XDIST))-(ASIN*(CRDY+YDIST))
      NEWY=YSTART+(ACOS*(CRDY+YDIST))+(ASIN*(CRDX+XDIST))
      CALL PENUP(LASTX,LASTY,NEWX,NEWY)
      GO TO 39
C     INITIAL COORDINATE 29 ***  VARIABLE WIDTH LETTER
   44 SCALEX=XSCALE*FLOAT(KRDY)/14.0
      GO TO 39
C     OPTION COORDINATE 30  ***  START NEW LINE WITH NEXT COORDINATES
   45 KOMPAR=-1
      MOVE=0
      GO TO 39
C     OPTION COORDINATE 31  ***  OFFSET COORDINATES TILL NEXT NEW LINE
   46 MOVE=9
      GO TO 39
C
C     *******************LETTERING OF ARRAY COMPLETED*******************
   47 IF(KONTRL)49,48,49
   48 KIND=IKIND
      LEFT=ILEFT
      KLEAR=IKLEAR
   49 LX7=XSTART+(ACOS*XDIST)+0.5
      LY7=YSTART+(ASIN*XDIST)+0.5
      RETURN
C
C     ***************************ERROR TRACE****************************
   50 WRITE(6,51)(LCHECK(I),I=1,3)
   51 FORMAT(27H0EXIT CALLED BY GENPLT-II - ,3A4)
      STOP
      END