Télécharger ztacmz.eso

Retour à la liste

ztacmz
C ZTACMZ    SOURCE    CHAT      05/01/13    04:24:59     5004
      SUBROUTINE ZTACMZ (M,N,Q)
C
C  M=1
C          Q   CARACTERES A TRANSMETTRE
C          N   A PARTIR DU N IEME
C
C  M=2
C    N.GT.0
C          Q   DIMENSIONS DU GRAPHIQUE  (Q1,Q2)
C              A SORTIR SUR UNITE LOGIQUE N
C    N.LE.0
C              FIN DE GRAPHIQUE
C
C  M=3
C          Q   COORDONNEES DEBUT (Q1,Q2) ET FIN (Q3,Q4) D'UN TRAIT
C          N   0   PLUME HAUTE   CARACTERE EN FIN DE TRAIT
C              1   PLUME BASSE   PAS DE CARACTERE
C              2   PLUME BASSE   CARACTERE EN FIN DE TRAIT
C
C  M=4
C          Q   COORDONNEES DEBUT (Q1,Q2) ET FIN (Q3,Q4) D'UN TEXTE
C          N   NOMBRE DE CARACTERE + 256*NUMERO D ALPHABET
C
C  M=6
C          Q   SANS SIGNIFICATION
C          N   CARACTERISTIQUE HARDWARE DE TRACE (VOIR TAHRD)
C
C  M=8         TRACE HARDWARE D'ELEMENTS CIRCULAIRES
C          Q   COORDONNEES DU CENTRE DU CERCLE (Q1,Q2) ET RAYON (Q3=Q4)
C          N   CODE D'INTERPRETATION DES COORDONNEES
C
C  M=9         COLORATION D'AIRE
C          Q   SANS SIGNIFICATION AU PREMIER APPEL D'UN CONTOUR
C              PUIS COORDONNEES DES SOMMETS DANS (Q1,Q2) ENSUITE
C          N   0 - DEBUT D'AIRE , -1 - CONTOUR , 1 - FIN D'AIRE
C
C  M=10
C          Q   SANS SIGNIFICATION
C          N   CARACTERISTIQUES HARDWARE DE COLORATION (VOIR TAHRDR)
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      DIMENSION Q(4)
      DIMENSION I1(2),I2(2),M1(2),IP(2),MP(2)
C
C     AP2   2**20-1
C     IP2   2**19+1
C     NI    NOMBRE DE CODES OPERATION DU LGI + 2**8 + 1
C     ANI   FLOAT(NI)
C     LE NOMBRE DE CODES OP. DE L'ACTUEL LGI EST 12 (CODE DE 1 A 12)
C
      COMMON /CLGI/L6C
      CHARACTER*64 L6C
      CHARACTER*27 L7C
      CHARACTER*200 CHBUF
*     SAVE NP
      SAVE
      DATA L7C/':abcdefghijklmnopqrstuvwxyz'/
C
      DATA AP2,IP2,NI,ANI /1048575.,524289,269,269./
C
      DATA ILL/0/
C-----------------------------------------------------------------------
      DATA NCM / 8/
C
C      WRITE (6,*) ' ZTACMZ ',M,N,Q(1),Q(2),Q(3),Q(4)
C
      NCMM2=NCM-2
C
      M1(1)=M+256
C
      IF (M.GT.12)                                RETURN
C             1   2   3   4   5   6   7   8   9   10   11   12
      GO TO (100,200,300,400,100,600,100,800,900,1000,100,100), M
C
  100 CONTINUE
      WRITE(CHBUF,FMT='(50A4)') (Q(I),I=N,N+(NP-1)/4)
      DO 140 J1=1,NP,6
         II=0
         DO 130 J=J1,J1+5,3
            JJ=0
            DO 110 K=1,3
                  ICR=INDEX(L6C,CHBUF(J+K-1:J+K-1))
              IF (ICR.EQ.0) ICR=INDEX(L7C,CHBUF(J+K-1:J+K-1))
              ILL=MAX0(0,ICR-1)
               JJ=64*JJ+ILL
  110       CONTINUE
            II=II+1
            I1(II)=JJ*2+IP2
  130    CONTINUE
           CALL ZTAOUZ (0,I1)
  140 CONTINUE
                                                  GO TO 10000
C
  200 CONTINUE
      M1(2)=NI*2+IP2
      MP(1)=M1(1)
      MP(2)=M1(2)
      CALL ZTAOUZ (N,M1)
      IF (N.GT.0) THEN
       Q1=AINT(Q(1)+0.99999)
       Q2=AINT(Q(2)+0.99999)
       DCX=(AP2-ANI)/Q1
       DCY=(AP2-ANI)/Q2
       I2(1)=INT(Q1*Q(3))*2+IP2
       I2(2)=INT(Q2*Q(4))*2+IP2
       CALL ZTAOUZ (0,I2)
      ENDIF
                                                  GO TO 10000
  300 CONTINUE
      M1(2)=N*2+IP2
      I1(1)=INT(DCX*Q(1))+NI
      I1(2)=INT(DCY*Q(2))+NI
      I2(1)=INT(DCX*Q(3))+NI
      I2(2)=INT(DCY*Q(4))+NI
      IF (M1(1).NE.MP(1))                         GO TO 310
      IF (M1(2).NE.MP(2))                         GO TO 310
      IF (N.EQ.0)                                 GO TO 320
      IF (I1(1).NE.IP(1))                         GO TO 310
      IF (I1(2).NE.IP(2))                         GO TO 310
      IF (I1(1).NE.I2(1))                         GO TO 320
      IF (I1(2).NE.I2(2))                         GO TO 320
                                                  GO TO 330
  310 CONTINUE
      CALL ZTAOUZ (0,M1)
      CALL ZTAOUZ (0,I1)
  320 CONTINUE
      CALL ZTAOUZ (0,I2)
      MP(1)=M1(1)
      MP(2)=M1(2)
  330 CONTINUE
      IP(1)=I2(1)
      IP(2)=I2(2)
                                                  GO TO 10000
  400 CONTINUE
      M1(2)=N*2+IP2
      I1(1)=INT(DCX*Q(1))+NI
      I1(2)=INT(DCY*Q(2))+NI
      I2(1)=INT(DCX*Q(3))+NI
      I2(2)=INT(DCY*Q(4))+NI
      CALL ZTAOUZ (0,M1)
      CALL ZTAOUZ (0,I1)
      CALL ZTAOUZ (0,I2)
      MP(1)=M1(1)
      MP(2)=M1(2)
      NP=MOD(N,256)
                                                  GO TO 10000
  600 CONTINUE
  700 CONTINUE
      M1(2)=N*2+IP2
      CALL ZTAOUZ (0,M1)
                                                  GO TO 10000
  800 CONTINUE
      IF (N.LT.0)                                 GO TO 810
C   CREATION DE LA PREMIERE INSTRUCTION
      M1(2)=N*2+IP2
      MP(1)=M1(1)
      MP(2)=M1(2)
      CALL ZTAOUZ (0,M1)
C   CREATION DE LA DEUXIEME INSTRUCTION
C   DOMAINE D'INTERPRETATION EN X ET Y
      Q1=AINT(Q(1)+0.99999)
      Q2=AINT(Q(2)+0.99999)
      COFX=(AP2-ANI)/Q1
      COFY=(AP2-ANI)/Q2
      I1(1)=INT(Q1)*2+IP2
      I1(2)=INT(Q2)*2+IP2
      CALL ZTAOUZ (0,I1)
C   CREATION DE LA TROISIEME INSTRUCTION
C   CENTRE DU CERCLE EN X ET Y
      I1(1)=INT(COFX*Q(1))+NI
      I1(2)=INT(COFY*Q(2))+NI
      CALL ZTAOUZ (0,I1)
C   CREATION DE LA QUATRIEME INSTRUCTION
C   RAYON DU CERCLE
      Q2=AINT(Q(3)+0.99999)
      COF=(AP2-ANI)/Q2
      I2(1)=INT(Q2)*2+IP2
      I2(2)=INT(COF*Q(4))+NI
      CALL ZTAOUZ (0,I2)
C   INITIALISATION DU COEF DE CODAGE POUR LA
C   CREATION DE(S) INSTRUCTION(S) DE TYPE 5
      Q1=7.
      COF=(AP2-ANI)/Q1
                                                  GO TO 10000
  810 CONTINUE
C   CREATION DE(S) INSTRUCTION(S) DE TYPE 5
      I1(1)=INT(COF*Q(1))+NI
      I1(2)=INT(COF*Q(2))+NI
      CALL ZTAOUZ (0,I1)
                                                  GO TO 10000
  900 CONTINUE
      IF (N.LT.0)                                 GO TO  910
      M1(2)=N*2+IP2
      MP(1)=M1(1)
      MP(2)=M1(2)
      CALL ZTAOUZ (0,M1)
                                                  GO TO 10000
  910 CONTINUE
      I1(1)=INT(DCX*Q(1))+NI
      I1(2)=INT(DCY*Q(2))+NI
      CALL ZTAOUZ (0,I1)
                                                  GO TO 10000
 1000 CONTINUE
      M1(2)=N*2+IP2
      MP(1)=M1(1)
      MP(2)=M1(2)
      CALL ZTAOUZ (0,M1)
                                                  GO TO 10000
10000 CONTINUE
                                                  RETURN
      END
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales