1 : C ZTACMZ SOURCE CHAT 05/01/13 04:24:59 5004 2 : SUBROUTINE ZTACMZ (M,N,Q) 3 : C 4 : C M=1 5 : C Q CARACTERES A TRANSMETTRE 6 : C N A PARTIR DU N IEME 7 : C 8 : C M=2 9 : C N.GT.0 10 : C Q DIMENSIONS DU GRAPHIQUE (Q1,Q2) 11 : C A SORTIR SUR UNITE LOGIQUE N 12 : C N.LE.0 13 : C FIN DE GRAPHIQUE 14 : C 15 : C M=3 16 : C Q COORDONNEES DEBUT (Q1,Q2) ET FIN (Q3,Q4) D'UN TRAIT 17 : C N 0 PLUME HAUTE CARACTERE EN FIN DE TRAIT 18 : C 1 PLUME BASSE PAS DE CARACTERE 19 : C 2 PLUME BASSE CARACTERE EN FIN DE TRAIT 20 : C 21 : C M=4 22 : C Q COORDONNEES DEBUT (Q1,Q2) ET FIN (Q3,Q4) D'UN TEXTE 23 : C N NOMBRE DE CARACTERE + 256*NUMERO D ALPHABET 24 : C 25 : C M=6 26 : C Q SANS SIGNIFICATION 27 : C N CARACTERISTIQUE HARDWARE DE TRACE (VOIR TAHRD) 28 : C 29 : C M=8 TRACE HARDWARE D'ELEMENTS CIRCULAIRES 30 : C Q COORDONNEES DU CENTRE DU CERCLE (Q1,Q2) ET RAYON (Q3=Q4) 31 : C N CODE D'INTERPRETATION DES COORDONNEES 32 : C 33 : C M=9 COLORATION D'AIRE 34 : C Q SANS SIGNIFICATION AU PREMIER APPEL D'UN CONTOUR 35 : C PUIS COORDONNEES DES SOMMETS DANS (Q1,Q2) ENSUITE 36 : C N 0 - DEBUT D'AIRE , -1 - CONTOUR , 1 - FIN D'AIRE 37 : C 38 : C M=10 39 : C Q SANS SIGNIFICATION 40 : C N CARACTERISTIQUES HARDWARE DE COLORATION (VOIR TAHRDR) 41 : C----------------------------------------------------------------------- 42 : IMPLICIT INTEGER(I-N) 43 : DIMENSION Q(4) 44 : DIMENSION I1(2),I2(2),M1(2),IP(2),MP(2) 45 : C 46 : C AP2 2**20-1 47 : C IP2 2**19+1 48 : C NI NOMBRE DE CODES OPERATION DU LGI + 2**8 + 1 49 : C ANI FLOAT(NI) 50 : C LE NOMBRE DE CODES OP. DE L'ACTUEL LGI EST 12 (CODE DE 1 A 12) 51 : C 52 : COMMON /CLGI/L6C 53 : CHARACTER*64 L6C 54 : CHARACTER*27 L7C 55 : CHARACTER*200 CHBUF 56 : * SAVE NP 57 : SAVE 58 : DATA L7C/':abcdefghijklmnopqrstuvwxyz'/ 59 : C 60 : DATA AP2,IP2,NI,ANI /1048575.,524289,269,269./ 61 : C 62 : DATA ILL/0/ 63 : C----------------------------------------------------------------------- 64 : DATA NCM / 8/ 65 : C 66 : C WRITE (6,*) ' ZTACMZ ',M,N,Q(1),Q(2),Q(3),Q(4) 67 : C 68 : NCMM2=NCM-2 69 : C 70 : M1(1)=M+256 71 : C 72 : IF (M.GT.12) RETURN 73 : C 1 2 3 4 5 6 7 8 9 10 11 12 74 : GO TO (100,200,300,400,100,600,100,800,900,1000,100,100), M 75 : C 76 : 100 CONTINUE 77 : WRITE(CHBUF,FMT='(50A4)') (Q(I),I=N,N+(NP-1)/4) 78 : DO 140 J1=1,NP,6 79 : II=0 80 : DO 130 J=J1,J1+5,3 81 : JJ=0 82 : DO 110 K=1,3 83 : ICR=INDEX(L6C,CHBUF(J+K-1:J+K-1)) 84 : IF (ICR.EQ.0) ICR=INDEX(L7C,CHBUF(J+K-1:J+K-1)) 85 : ILL=MAX0(0,ICR-1) 86 : JJ=64*JJ+ILL 87 : 110 CONTINUE 88 : II=II+1 89 : I1(II)=JJ*2+IP2 90 : 130 CONTINUE 90 : CALL ZTAOUZ (0,I1) 91 : 140 CONTINUE 92 : GO TO 10000 93 : C 94 : 200 CONTINUE 95 : M1(2)=NI*2+IP2 96 : MP(1)=M1(1) 97 : MP(2)=M1(2) 97 : CALL ZTAOUZ (N,M1) 98 : IF (N.GT.0) THEN 99 : Q1=AINT(Q(1)+0.99999) 100 : Q2=AINT(Q(2)+0.99999) 101 : DCX=(AP2-ANI)/Q1 102 : DCY=(AP2-ANI)/Q2 103 : I2(1)=INT(Q1*Q(3))*2+IP2 104 : I2(2)=INT(Q2*Q(4))*2+IP2 104 : CALL ZTAOUZ (0,I2) 105 : ENDIF 106 : GO TO 10000 107 : 300 CONTINUE 108 : M1(2)=N*2+IP2 109 : I1(1)=INT(DCX*Q(1))+NI 110 : I1(2)=INT(DCY*Q(2))+NI 111 : I2(1)=INT(DCX*Q(3))+NI 112 : I2(2)=INT(DCY*Q(4))+NI 113 : IF (M1(1).NE.MP(1)) GO TO 310 114 : IF (M1(2).NE.MP(2)) GO TO 310 115 : IF (N.EQ.0) GO TO 320 116 : IF (I1(1).NE.IP(1)) GO TO 310 117 : IF (I1(2).NE.IP(2)) GO TO 310 118 : IF (I1(1).NE.I2(1)) GO TO 320 119 : IF (I1(2).NE.I2(2)) GO TO 320 120 : GO TO 330 121 : 310 CONTINUE 121 : CALL ZTAOUZ (0,M1) 121 : CALL ZTAOUZ (0,I1) 122 : 320 CONTINUE 122 : CALL ZTAOUZ (0,I2) 123 : MP(1)=M1(1) 124 : MP(2)=M1(2) 125 : 330 CONTINUE 126 : IP(1)=I2(1) 127 : IP(2)=I2(2) 128 : GO TO 10000 129 : 400 CONTINUE 130 : M1(2)=N*2+IP2 131 : I1(1)=INT(DCX*Q(1))+NI 132 : I1(2)=INT(DCY*Q(2))+NI 133 : I2(1)=INT(DCX*Q(3))+NI 134 : I2(2)=INT(DCY*Q(4))+NI 134 : CALL ZTAOUZ (0,M1) 134 : CALL ZTAOUZ (0,I1) 134 : CALL ZTAOUZ (0,I2) 135 : MP(1)=M1(1) 136 : MP(2)=M1(2) 137 : NP=MOD(N,256) 138 : GO TO 10000 139 : 600 CONTINUE 140 : 700 CONTINUE 141 : M1(2)=N*2+IP2 141 : CALL ZTAOUZ (0,M1) 142 : GO TO 10000 143 : 800 CONTINUE 144 : IF (N.LT.0) GO TO 810 145 : C CREATION DE LA PREMIERE INSTRUCTION 146 : M1(2)=N*2+IP2 147 : MP(1)=M1(1) 148 : MP(2)=M1(2) 148 : CALL ZTAOUZ (0,M1) 149 : C CREATION DE LA DEUXIEME INSTRUCTION 150 : C DOMAINE D'INTERPRETATION EN X ET Y 151 : Q1=AINT(Q(1)+0.99999) 152 : Q2=AINT(Q(2)+0.99999) 153 : COFX=(AP2-ANI)/Q1 154 : COFY=(AP2-ANI)/Q2 155 : I1(1)=INT(Q1)*2+IP2 156 : I1(2)=INT(Q2)*2+IP2 156 : CALL ZTAOUZ (0,I1) 157 : C CREATION DE LA TROISIEME INSTRUCTION 158 : C CENTRE DU CERCLE EN X ET Y 159 : I1(1)=INT(COFX*Q(1))+NI 160 : I1(2)=INT(COFY*Q(2))+NI 160 : CALL ZTAOUZ (0,I1) 161 : C CREATION DE LA QUATRIEME INSTRUCTION 162 : C RAYON DU CERCLE 163 : Q2=AINT(Q(3)+0.99999) 164 : COF=(AP2-ANI)/Q2 165 : I2(1)=INT(Q2)*2+IP2 166 : I2(2)=INT(COF*Q(4))+NI 166 : CALL ZTAOUZ (0,I2) 167 : C INITIALISATION DU COEF DE CODAGE POUR LA 168 : C CREATION DE(S) INSTRUCTION(S) DE TYPE 5 169 : Q1=7. 170 : COF=(AP2-ANI)/Q1 171 : GO TO 10000 172 : 810 CONTINUE 173 : C CREATION DE(S) INSTRUCTION(S) DE TYPE 5 174 : I1(1)=INT(COF*Q(1))+NI 175 : I1(2)=INT(COF*Q(2))+NI 175 : CALL ZTAOUZ (0,I1) 176 : GO TO 10000 177 : 900 CONTINUE 178 : IF (N.LT.0) GO TO 910 179 : M1(2)=N*2+IP2 180 : MP(1)=M1(1) 181 : MP(2)=M1(2) 181 : CALL ZTAOUZ (0,M1) 182 : GO TO 10000 183 : 910 CONTINUE 184 : I1(1)=INT(DCX*Q(1))+NI 185 : I1(2)=INT(DCY*Q(2))+NI 185 : CALL ZTAOUZ (0,I1) 186 : GO TO 10000 187 : 1000 CONTINUE 188 : M1(2)=N*2+IP2 189 : MP(1)=M1(1) 190 : MP(2)=M1(2) 190 : CALL ZTAOUZ (0,M1) 191 : GO TO 10000 192 : 10000 CONTINUE 193 : RETURN 194 : END 195 :
© Cast3M 2003 - All rights reserved.
Disclaimer