Directory of image this file is from
This file as a plain text file

      SUBROUTINE TKDASH(IX,IY)
      DIMENSION DTABL(10), U(9), WORK(10),ISIMHD(4)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     1 TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     2 TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(8),KPAD2,
     3 KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     4 KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     5 KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     6 KINLFT,KOTLFT,KUNIT
      DATA ISIMHD(1)),ISIMHD(2),ISIMHD(3),ISIMHD(4)/12,31212,32,52/
      DATA IDTYPE/-1/
      DATA U(1),U(2),U(3),U(4),U(5)/5.,-5.,10.,-10.,25./
      DATA U(6),U(7),U(8),U(9)/-25.,50.,-50.,0./
      DATA LASTX,LASTY/-1,-1/
      IF(KDASHT .LT. 0)GO TO 320
C * SET TERMINAL FOR HARDWARE DASHED LINES
C * THIS SECTION IS FOR 4014 ENHANCED
      IF(KDASHT .GT. 4)GO TO 101
      IF(KTERM .GE. 3)GO TO 103
      IF(KDASHT .EQ. 0)GO TO 330
C * HARDWARE DASH SIMULATION FOR TYPE 1 & 2 TERMINALS
      KDASHT=ISIMHD(KDASHT)
101   IF(KLINE .EQ. 0)GO TO 104
      KLINE=0
      CALL CWSEND
      GO TO 104
C * SET AND TRANSMIT HARDWARE DASH CODE
103   IF(KLINE .EQ. KDASHT)GO TO 330
      KLINE=KDASHT
      CALL CWSEND
      GO TO 330
104   CONTINUE
      IF(KDASHT .EQ. 0)GO TO 330
      IF(KDASHT .EQ. IDTYPE)GO TO 170
C * BUILD NEW DASH TABLE
      ICHAR=KDASHT
      DO 140 NO=1,10
120   IF(ICHAR)130,150,130
130   I=ICHAR-((ICHAR/10)*10)
      ICHAR=ICHAR/10
      IF(I)140,120,140
140   WORK(NO)=U(I)
      NO=11
150   NO=NO-1
C * INVERT TABLE AND STORE IN DTABLE
      DO 160 I=1,NO
      ISUB=NO+1-I
160   DTABL(I)=WORK(ISUB)
C * MODIFIY TABLE TO COMPENSATE FOR FLARE
      D1=DTABL(1)
      NUM=NO-1
      DO 165 K=1,NUM
      DCUR=DTABL(K)
      IF(DCUR*DTABL(K+1).GT.0. .OR. DCUR*D1 .LT.0.)GO TO 165
      DTABL(K)=DTABL(K)-1.
      DTABL(K+1)=DTABL(K+1)-1.
165   CONTINUE
      IDTYPE=KDASHT
      I=0
      SEGLEN=0
C * BRANCH FOR ALTERNATING AND SOLID
170   IF(NO-1)320,330,180
180   IF(LASTX-KBEAMX)200,190,200
190   IF(LASTY-KBEAMY)200,210,200
C * SET START OF SEQUENCE IF NOT INTERRUPTED BY A MOVE
200   SEGLEN=0
      I=0
C * COMPUTE NEXT SEGMENT LENGTH
210   X=FLOAT(KBEAMX)
      Y=FLOAT(KBEAMY)
      DX=FLOAT(IX-KBEAMX)
      DY=FLOAT(IY-KBEAMY)
      DIAG=SQRT(DX*DX+DY*DY)
      DIST=DIAG
      IF (SEGLEN-1.5)220,220,230
220   I=MOD(I,NO)+1
      SEGLEN=ABS(DTABL(I))
230   IF(SEGLEN-DIST)240,270,270
240   F=SEGLEN/DIAG
      X=X+DX*F
      Y=Y+DY*F
      IF (DTABL(I))250,250,260
C * OUTPUT A GS FOR A DARK VECTOR
250   CALL TOUTPT(29)
      KMOVEF=1
260   CALL XYCNVT(IFIX(X),IFIX(Y))
C * CALCULATE REMAINING DISTANCE TO POINT
      DIST=DIST-SEGLEN
      SEGLEN=0
      GO TO 220
270   IF(DTABL(I))280,280,290
280   CALL TOUTPT(29)
      KMOVEF=1
C * THAT WAS A GS FOR AN INVISIBLE LINE
290   CALL XYCNVT(IX,IY)
      LASTX=IX
      LASTY=IY
C * CALCULATE SEGMENT FRAGMENT UNUSED
      SEGLEN=SEGLEN-DIST
      GO TO 340
320   CALL TOUTPT(29)
      KMOVEF=1
330   CALL XYCNVT(IX,IY)
      NO=1-NO
      IDTYPE=KDASHT
340   RETURN
      END