1 : C KTRINI SOURCE CHAT 07/10/29 21:22:43 5940 2 : SUBROUTINE KTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA) 3 : C 4 : C INITIALISATION D'UN TRACE 5 : C 1 TATB 2 TEKTRO 3 GDDM (3179 G ) 6 : C 4 GKS 5 GDDM (FICHIER GDF) 7 : C 8 : C ATTENTION AVEC LE GKS IBM IL PEUT Y AVOIR UN PROBLEME EN CAS 9 : C D'UNDERFLOW QUI NE SONT PAS ACTUELLEMENT MASQUES PAR GKS 10 : C ET PROVOQUE DES ARITHMETICS ERRORS 11 : C 12 : C INITIALISATION D'UN TRACE 13 : C NOL : NON UTILISE 14 : C AX ,AYAX : DIMENSION POUR LA FEUILLE DE PAPIER 15 : C TITRE : TITRE (CHAINE DE CARACTERES) 16 : C HAUT : HAUTEUR DES CARACTERES 17 : C VALEUR : ECRAN OU ECRAN PLUS MARGE 18 : C NCOUMA : NOMBRE DE COULEUR DU TERMINAL 19 : C ICCOL : INDICE COULEUR COURANTE 20 : C ICOISO : 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : external long 24 : SAVE IWKIDLI,KMETA,WKTY,INWISS,INMETA,FENE 25 : SAVE ICCOL,ICOISI,WKID,X1,X2,Y1,Y2,WRATIO,INUSEG 26 : SAVE XINID,YINID,IDSG,SXMIN,SXXAX,SYMIN,SYYAX,RX,RY,AX,AY 27 : SAVE TEXTX,TEXTY,INCOOR,TEXTE,ICCLE,IACT,IDWISS,IWISS,VALEUR 28 : SAVE NHAUT,HAUT 29 : SAVE IPF 30 : DIMENSION IPF(24) 31 : CHARACTER*(*) TITRE 32 : DIMENSION XTR(*),YTR(*) 33 : DIMENSION RMAT(9) 34 : REAL SEGTM(2,3) 35 : CHARACTER*8 NAME 36 : CHARACTER*(*) CARACT 37 : LOGICAL VALEUR,FENET,VALEU,FENE 38 : CHARACTER*(*) LEGEND(*) 39 : C VALEURS POUR LES ENTRY 40 : CHARACTER*20 STRING 41 : DIMENSION SEGT(6),SEGMT(6),ROUT(6) 42 : C MEMOIRES DES POINTS COINS DES PAVES DE COULEUR DES MENUS 43 : DIMENSION PXA(4),PYA(4) 44 : C CORRESPONDING CERN COLOR INDICES - FOR CERN PURPOSE 45 : DIMENSION ICCC(10) 46 : C 47 : DIMENSION TEXTX(50),TEXTY(50) 48 : C VARIABLES CARACTERES POUR NOMMER LE FICHIER METAFILE 49 : CHARACTER*1 CARELE(10) 50 : CHARACTER*6 STR 51 : CHARACTER*4 STR1 52 : C 53 : CHARACTER*15 TEXTE(50) 54 : C 55 : C 56 : C ASF 57 : DIMENSION IASF(13) 58 : C INITIALISATION GKS (IDENTIFICATEUR, CONNECTION, TYPE) 59 : INTEGER WKID,WKCON,WKTY 60 : INTEGER STAT 61 : C 62 : *-INC CCOPTIO 63 : *-INC CCGEOME 64 : DATA ICCOUN/0/ 65 : C DATA POUR LE NOM DU FICHIER METAFILE 66 : DATA CARELE /'0','1','2','3','4','5','6','7','8','9'/ 67 : DATA STR1 /'META'/ 68 : C DATA POUR LE TABLEAU DES COULEURS ICCC(K) POUR GKS 69 : DATA ICCC/4,2,6,3,7,5,1,8,9,10/ 70 : C 71 : DATA WKID/3/ 72 : DATA ICCOL/7/ 73 : DATA IASF/1,1,1,1,1,1,1,1,1,1,1,1,1/ 74 : DATA IDSG/0/ 75 : DATA IACT/0/ 76 : DATA IDWISS/2/ 77 : DATA IWISS/0/ 78 : C NB DE COULEUR SI PAS AUTRE INDICATION 79 : NCOUMA=7 80 : C SAUVER HAUT 81 : HAUT=HAUTT 82 : NHAUT=31 83 : C SAUVER VALEUR 84 : VALEUR=VALEU 85 : C O SEGMENT POUR COMMENCER 86 : KSEGN=0 87 : C INITIALISATION DE L'UNITE PHYSIQUE 88 : AX=AXAX 89 : AY=AYAY 90 : DO 1 NBCR=72,2,-1 91 : IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2 92 : 1 CONTINUE 93 : 2 CONTINUE 94 : X1=0. 95 : X2=0. 96 : Y1=0. 97 : Y2=0. 98 : C POUR LA GESTION DES TEXTES 99 : INCOOR=0 100 : INUSEG=50+(100*(WKID-1)) 101 : IXSEG=0 102 : ICCLE=0 103 : C 104 : C INITIALISATION GKS 105 : C CHANNEL 1 WORKSTATION 1 METAFILE 106 : C CHANNEL 2 WORKSTATION 2 WISS 107 : C CHANNEL 3 WORKSTATION 3,4,.. ECRAN 108 : C ATTENTION IL FAUT FERMER LA WORKSTATION 109 : C POUR REVENIR EN MODE ALPHA 110 : IF(IACT.EQ.1) THEN 110 : CALL GQOPS(ISTA) 110 : IF(ISTA.EQ.4) CALL GCLSG 111 : C INQUIRE SET MEMBER OF OPEN WORKSTATION 112 : NWAC=0 112 : 5002 CALL GQOPWK(NWAC,IERR,NTWAC,NWID) 113 : IF(NWID.EQ.WKID)GOTO 5001 114 : IF(NWAC.EQ.NTWAC)GOTO 5003 115 : NWAC=NWAC+1 116 : GOTO 5002 116 : 5001 CALL GQOPS(ISTA) 116 : IF (ISTA.EQ.3) CALL GDAWK(WKID) 116 : IF (ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID) 117 : C 117 : 5003 CALL GDAWK(IDWISS) 117 : CALL GCLWK(IDWISS) 117 : CALL GOPWK(IDWISS,2,INWISS) 117 : CALL GACWK(IDWISS) 118 : GOTO 5000 119 : ENDIF 120 : C 121 : C OUVERTURE GKS 122 : C FILE 22 ERROR FILE FOR GKS 122 : IF (WKID.EQ.3) CALL GOPKS(22,1) 123 : C 124 : C OUVERTURE WORKSTATIONS -> ECRAN, METAFILE 125 : C ECRAN -> IDENTIFICATEUR:1 126 : C CONNECTION :1 127 : C TYPE :4(SUN) 5001 (GKS GRAL IBM 3279) 128 : C ON NE GARDE QUE TROIS WORKSTATIONS SIMULTANEES (UNE SUR IBM) 129 : C ( CAS DU SUN) 130 : 5000 CONTINUE 131 : WKCON=3 132 : C LECTURE DE DIVERS PARAMETRES EN FILE 97 CASTEM2 GRAFPARM 133 : * OPEN (UNIT=97,FILE='GKS.DATA',FORM='FORMATTED') 134 : REWIND 97 135 : C LECTURE DU NOMBRE MAX DE WKID AUTORISE POUR LA VERSION DE GKS 136 : READ(97,*)IWKIDLI 137 : C PV UNE SEULE WKID => 3 MAXIMUM 138 : IWKIDLI=3 139 : C LECTURE DU COMPTEUR DE METAFILE 140 : READ (97,*)KMETA 141 : C LECTURE DU WORKSTATION-TYPE POUR L'ECRAN 142 : READ (97,*) WKTY 143 : C LECTURE DU WORKSTATION-TYPE POUR LA WISS 144 : READ(97,*) INWISS 145 : C LECTURE DU WORKSTATION-TYPE POUR LES METAFILES 146 : READ(97,*) INMETA 147 : C OUVERTURE ET ACTIVATION DE LA WISS 148 : IF(IWISS.EQ.0) THEN 148 : CALL GOPWK(IDWISS,2,INWISS) 148 : CALL GACWK(IDWISS) 149 : IWISS=1 150 : ENDIF 151 : C 152 : C OUVERTURE DE L'ECRAN 152 : CALL GOPWK(WKID,WKCON,WKTY) 153 : C 154 : C CHARGEMENT DES PATTERN 155 : C 156 : C INITIALISATION DE LA TABLE DES COULEURS 157 : C IND RED GREEN BLUE 158 : C NOIR 0 0.0 0.0 0.0 159 : C BLEU 4 0.0 0.0 1.0 160 : C ROUGE 2 1.0 0.0 0.0 161 : C ROSE 6 1.0 0.0 1.0 162 : C VERT 3 0.0 1.0 0.0 163 : C TURQUOI 7 0.0 1.0 1.0 164 : C JAUNE 5 1.0 1.0 0.0 165 : C BLANC 8 1.0 1.0 1.0 166 : C NOIR 1 0.0 0.0 0.0 166 : CALL GSCR(WKID,0,0.0,0.0,0.0) 166 : CALL GSCR(WKID,4,0.0,0.0,1.0) 166 : CALL GSCR(WKID,2,1.0,0.0,0.0) 166 : CALL GSCR(WKID,6,1.0,0.0,1.0) 166 : CALL GSCR(WKID,3,0.0,1.0,0.0) 166 : CALL GSCR(WKID,7,0.0,1.0,1.0) 166 : CALL GSCR(WKID,5,1.0,1.0,0.0) 166 : CALL GSCR(WKID,1,1.0,1.0,1.0) 166 : CALL GSCR(WKID,8,0.0,0.0,0.0) 167 : C ACTIVATION DE L'ECRAN 167 : CALL GACWK(WKID) 168 : IACT=1 169 : C 170 : C OUVERTURE SEGMENT 6 171 : ISEG=6+(100*(WKID-1)) 171 : CALL GCRSG(ISEG) 171 : CALL GSVIS(ISEG,1) 171 : CALL GSDTEC(ISEG,0) 172 : C 173 : C DIMENSION DE L'ECRAN (RX,RY EN METRES, LX ET LY EN PIXELS) 173 : CALL GQDSP(WKTY,ERR,DC,RX,RY,LX,LY) 174 : C 175 : C METTRE LES ASF EN INDIVIDUAL 175 : CALL GSASF(IASF) 176 : C 177 : C MODE DE MISE A JOUR (MODE PAR DEFAUT)CD CEA.SUN 178 : C 178 : CALL GSDS(WKID,1,0) 179 : C 180 : C DEFINITION DE LA FENETRE DE LA WORKSTATION (ECRAN) 181 : WRATIO=RY/RX 182 : R=RY 183 : IF(WRATIO.GT.1)THEN 184 : R=RX 185 : WRATIO=1./WRATIO 186 : END IF 186 : CALL GSWKWN(WKID,0.,1.,0.,RY/RX) 186 : CALL GSWKVP(WKID,0.,RX,0.,RY) 187 : C EFFACEMENT DE LADITE 187 : CALL GSFAIS(1) 187 : CALL GSFACI(8) 187 : CALL GSWN(4,0.,1.,0.,1.) 187 : CALL GSVP(4,0.,1.,0.,(RY/RX)) 187 : CALL GSELNT(4) 188 : PXA(1)=0 189 : PyA(1)=0 190 : PXA(2)=0 191 : PyA(2)=1 192 : PXA(3)=1 193 : PyA(3)=1 194 : PXA(4)=1 195 : PyA(4)=0 195 : CALL GFA(4,PXA,PYA) 196 : C 197 : C DEFINITION DE LA FENETRE ET CLOTURE DE LA DEUXIEME WORKSTATION (PLOTTE 198 : C 199 : C DEFINITION DE LA TRANSFORMATION DE NORMALISATION 1 POUR LE TITRE 199 : CALL GSWN(1,0.,80.,0.,2.) 199 : CALL GSVP(1,0.,1.,0.,(RY/RX)*0.1) 199 : CALL GSELNT(1) 200 : C 201 : C INITIALISATION DES ATTRIBUTS CARACTERES 201 : CALL GSCHH(1.0) 201 : CALL GSTXCI(ICCC(7)) 201 : CALL GSTXFP(1,2) 201 : CALL GSCHXP(1.) 201 : CALL GSCHSP(0.1) 202 : C ECRITURE TITRE 202 : CALL GTX(68.,1.,'CASTEM 2000') 202 : CALL GTX(0.,1.,TITRE) 203 : C 204 : C FERMETURE SEGMENT 204 : CALL GCLSG 205 : C 206 : RETURN 207 : * 208 : ENTRY KDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET) 209 : C 210 : C DEFINITION DE LA FENETRE UTILISATEUR 211 : C XMIN,X,X,YMIN,YYAX : COORDONNEES DE LA FENETRE UTILISATEUR 212 : C XR1,XR2,YR1,YR2 : COORDONNEES RETOURNEES 213 : C (EFFECTIVEMENT UTILISEES) 214 : C FENET : CALCUL DU RATIO (OUI OU NON) NON UTILISE 215 : C 216 : EC1=AX-3. 217 : EC2=AY-3. 218 : C DEFINITION UNITE UTILISATEUR FENETRE UTILISEE MARGES A RESPECTER 219 : C RETOUR X1 X2 Y1 Y2 FENETRE EFFECTIVEMENT UTILISEE ???? 220 : C OUVERTURE SEGMENT 221 : C CALCUL DE LA FENETRE (XMIN,XXA,YMIN,YYA) -> DETERMINATION DE LA TRANSF 222 : C DE NORMALISATION 2 223 : C ON COMPLETE LA FENETRE UTILISATEUR POUR RENTRER DANS LA FENETRE REELL 224 : SXMIN=XMIN 225 : SXXAX=XXAX 226 : SYMIN=YMIN 227 : SYYAX=YYAX 228 : C MARGE POUR LES QUAL ET NUMERO DE NOEUDS OU ELEMENTS 229 : XDIFF=(XXAX-XMIN)/2.*1.10 230 : YDIFF=(YYAX-YMIN)/2.*1.10 231 : XMILL=(XXAX+XMIN)/2. 232 : YMILL=(YYAX+YMIN)/2. 233 : C NECESSAIRE POUR OPERATEUR DESSIN 234 : FENE=FENET 235 : IF (FENE) THEN 236 : RAP=(XDIFF/YDIFF)/(RX/RY) 237 : ELSE 238 : RAP=1. 239 : ENDIF 240 : IF (RAP.GE.1) THEN 241 : X1=XMILL-XDIFF 242 : X2=XMILL+XDIFF 243 : Y1=YMILL-(YDIFF*RAP) 244 : Y2=YMILL+(YDIFF*RAP) 245 : ELSE 246 : X1=XMILL-(XDIFF/RAP) 247 : X2=XMILL+(XDIFF/RAP) 248 : Y1=YMILL-YDIFF 249 : Y2=YMILL+YDIFF 250 : ENDIF 251 : IF(VALEUR) THEN 252 : C LA FENETRE EST XMIN,XXAX,YMIN,YYAX 252 : CALL GSWN(2,X1,X2,Y1,Y2) 252 : CALL GSVP(2,0.,0.8,(RY/RX)*0.1,(RY/RX)*0.9) 253 : ELSE 254 : C LA FENETRE EST RECALCULEE POUR GARDER LES BONS RAPPORTS 254 : CALL GSWN(2,X1,X2,Y1,Y2) 254 : CALL GSVP(2,0.,0.9,(RY/RX)*0.1,(RY/RX)) 255 : ENDIF 256 : C 256 : CALL GSELNT(2) 257 : C 258 : C INITIALISATION DE LA POSITION DU LOCATOR 259 : XINID=(X1+X2)/2. 260 : YINID=(Y1+Y2)/2. 261 : C 262 : C INITIALISATION DES VALEURS RENDUES 263 : XR1=XMIN 264 : XR2=XXAX 265 : YR1=YMIN 266 : YR2=YYAX 267 : C 268 : C OUVERTURE SEGMENT 1 269 : C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE) 269 : CALL GQOPS(ISTA) 270 : IF (ISTA.EQ.4) THEN 270 : CALL GQOPSG(IIERRI,INUM) 270 : CALL GCLSG 270 : CALL GDSG(INUM) 271 : ENDIF 272 : INUM=8+(100*(WKID-1)) 272 : CALL GQSGUS(0,IERGK,NBSEG,ISEGNA) 273 : DO 4461 ISEG=1,NBSEG 273 : CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA) 274 : IF (ISEGNA.EQ.INUM) THEN 274 : CALL GDSG(INUM) 275 : GOTO 4462 276 : ENDIF 277 : 4461 CONTINUE 278 : 4462 CONTINUE 279 : ISEG=1+(100*(WKID-1)) 279 : CALL GCRSG(ISEG) 280 : IXSEG=1 281 : C 282 : C ATTRIBUT VISIBILITE 282 : CALL GSVIS(ISEG,1) 283 : C DETECTABILITE 283 : CALL GSDTEC(ISEG,0) 284 : C 285 : C MODE VECTEUR (POUR LES CARACTERES) 285 : CALL GSTXFP(1,2) 286 : C 287 : C TAILLE DES CARACTERES PAR DEFAUT 288 : C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER 289 : CHH=(Y2-Y1)/50.0 289 : CALL GSCHH(CHH) 289 : CALL GQCHXP(INDERR,CHXPO) 290 : CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO 290 : CALL GSCHXP(CHXP) 290 : CALL GSCHSP(0.1) 291 : C 292 : C 293 : C COULEUR COURANTE (ICCOL) 293 : CALL GSFACI(ICCC(ICCOL)) 293 : CALL GSPLCI(ICCC(ICCOL)) 293 : CALL GSPMCI(ICCC(ICCOL)) 293 : CALL GSTXCI(ICCC(ICCOL)) 294 : C 295 : C OVERPAINT 296 : C 297 : ICOISI=-100 298 : C 299 : RETURN 300 : C 301 : ENTRY KTRLAB(X,Y,CARACT,NCAR,HAUTT) 302 : C 303 : C ECRITURE D'UN TEXTE EN (X,Y) 304 : C X,Y : COORDONNEES DE L'ORIGINE DU TEXTE 305 : C CARACT : TEXTE 306 : C NCAR : NOMBRE DE CARACTERES A ECRIRE 307 : C HAUT : 308 : C 309 : HAUT=HAUTT 310 : DO 201 ICAR=NCAR,1,-1 311 : IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202 312 : 201 CONTINUE 313 : C CHAINE VIDE 314 : RETURN 315 : 202 CONTINUE 316 : C ECRITURE TEXTE EN (X,Y) 316 : CALL GTX(X,Y,CARACT) 317 : RETURN 318 : C 319 : ENTRY KTRBOX (HAUTX,HAUTY) 320 : C CARACTERES EN MODE VECTEUR (STROKE) 320 : CALL GSTXFP(1,2) 321 : C INTERROGATION SUR LA TAILLE DE DEFAUT 321 : CALL GQCHH(ERR,CHH) 321 : CALL GQCHXP(INDERR,CHXP) 322 : C MISE A JOUR DE LA TAILLE 322 : * CALL GSCHH(CHH*HAUTX) 322 : * CALL GSCHXP(CHXP*HAUTY) 322 : * CALL GSCHSP(0.1) 323 : RETURN 324 : C 325 : ENTRY KCHCOU(JCOLO) 326 : C 327 : C CHANGEMENT COULEUR (8 DOIT CORRESPONDRE A L'EFFACEMENT) 328 : C JCOLO : INDICE DE LA NOUVELLE COULEUR 329 : C CHANGEMENT DE COULEUR (VOIR LA TABLE DES COULEUR) 330 : C 330 : CALL GSFACI(ICCC(JCOLO)) 330 : CALL GSPLCI(ICCC(JCOLO)) 330 : CALL GSPMCI(ICCC(JCOLO)) 330 : CALL GSTXCI(ICCC(JCOLO)) 331 : RETURN 332 : C 333 : ENTRY KFVALI(IFENI,IRESU,NH) 334 : C 335 : IF (IFENI.EQ.1) THEN 336 : WRATIO=1 337 : IRESU=0 337 : CALL GSWN(3,0.,1.,2.,33.) 337 : CALL GSVP(3,0.8,1.,(RY/RX)*0.1,(RY/RX)*0.9) 337 : CALL GSELNT(3) 337 : CALL GSCHH(1.0) 337 : CALL GSCHXP(0.06) 337 : CALL GSCHSP(0.1) 338 : ELSE 338 : CALL GCLSG 338 : CALL GSCHXP(1.) 338 : CALL GSELNT(2) 339 : ENDIF 340 : NH=31 341 : RETURN 342 : C 343 : ENTRY KMENU(LEGEND,NCASE,LLONG) 344 : C AFFICHAGE DU MENU 345 : C 346 : DO 805 II=1,24 347 : IPF(II)=0 348 : 805 CONTINUE 349 : C TEST SUR L'EXISTENCE DES SEGMENTS 10 A 22 350 : C SELECTION TRANSFORMATION 1 350 : CALL GSELNT(1) 350 : CALL GQOPS(ISTA) 350 : IF (ISTA.EQ.4) CALL GCLSG 351 : DO 446 KBOIT=1,13 351 : CALL GQSGUS(0,IERGK,NBSEG,ISEGNA) 352 : DO 4460 ISEG=1,NBSEG 352 : CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA) 353 : IF (ISEGNA.EQ.9+KBOIT+(100*(WKID-1))) THEN 353 : CALL GDSG(9+KBOIT+(100*(WKID-1))) 354 : GOTO 446 355 : ENDIF 356 : 4460 CONTINUE 357 : 446 CONTINUE 358 : C CREATION DU MENU 359 : XB=1. 359 : CALL GQWKS(WKID,IERGK,ISTA) 359 : IF (ISTA.NE.1) CALL GACWK(WKID) 360 : DO 445 KBOIT=1,13 361 : KKIMP=0 362 : IF (KBOIT.LE.NCASE) THEN 363 : MLONG=LONG(LEGEND(KBOIT)) 364 : ELSE 365 : MLONG=1 366 : ENDIF 367 : IF (KBOIT.EQ.12.AND.IPF(2).NE.0.AND.MLONG.EQ.1) KKIMP=1 368 : IF (KKIMP.EQ.1) MLONG=4 369 : IF (MLONG.EQ.1) GOTO 447 370 : ISEG=KBOIT+9+(100*(WKID-1)) 370 : CALL GCRSG(ISEG) 371 : IF (KBOIT.NE.1) IPF(KBOIT-1)=1 371 : CALL GSVIS(ISEG,1) 371 : CALL GSDTEC(ISEG,1) 372 : C PAVE DE COULEUR POUR LOCATOR INPUT 372 : CALL GSFAIS(1) 372 : CALL GSFACI(ICCC(2)) 373 : PXA(1)=XB 374 : PXA(2)=PXA(1)+2. 375 : PXA(3)=PXA(2) 376 : PXA(4)=PXA(1) 377 : PYA(1)=0.6 378 : PYA(2)=PYA(1) 379 : PYA(3)=PYA(1)+0.4 380 : PYA(4)=PYA(3) 380 : CALL GFA(4,PXA,PYA) 381 : C FIN DE CONSTRUCTION DU PAVE DE COULEUR 381 : CALL GSTXCI(ICCC(2)) 381 : CALL GSTXFP(1,2) 381 : CALL GSCHH(0.7) 381 : CALL GSCHSP(0.1) 381 : CALL GSCHXP(1.0) 382 : IF (KKIMP.EQ.1) THEN 382 : CALL GTX(PXA(1),0.,'Meta') 383 : ELSE 383 : CALL GTX(PXA(1),0.,LEGEND(KBOIT)(1:MLONG)) 384 : ENDIF 385 : XB=XB+80./(NCASE+1) 385 : CALL GCLSG 386 : 447 CONTINUE 387 : 445 CONTINUE 388 : IDSG=1 388 : CALL GSCHH(1.0) 388 : CALL GSCHXP(1.0) 388 : CALL GSCHSP(0.1) 388 : CALL GSELNT(2) 389 : RETURN 390 : C 391 : ENTRY KINSEG(NBSEGT,IRESS) 392 : C 393 : C INITIALISATION D'UN SEGMENT 394 : C NBSEGT : NUMERO DU SEGMENT 395 : C IRESS : SELON SA VALEUR, ON FERME LE SEGMENT PRECEDENT 396 : C 397 : IF (IRESS.NE.2) THEN 398 : IF (IRESS.LT.2.OR.IRESS.GT.5) THEN 399 : C FERMETURE SEGMENT 399 : CALL GCLSG 400 : ENDIF 401 : ELSE 402 : IRESS=7 403 : ENDIF 403 : CALL GQOPS(IOP) 403 : IF (IOP.EQ.4) CALL GCLSG 404 : 405 : C 406 : C CREATION SEGMENT NBSEGT 407 : ISEG=NBSEGT+(100*(WKID-1)) 407 : CALL GCRSG(ISEG) 408 : C 409 : C ATTRIBUT DE VISIBILITE 409 : CALL GSVIS(ISEG,1) 410 : C DETECTABILITE 410 : CALL GSDTEC(ISEG,0) 411 : C 412 : C MODE VECTEUR POUR LES CARACTERES (STROKE) 412 : C CALL GSTXFP(1,2) 413 : C 414 : C TAILLE DES CARACTERES 415 : IF (NBSEGT.NE.7) THEN 416 : * SAUF CAS DES LEGENDES ISOVALEURS 417 : CHH=(Y2-Y1)/50.0 417 : CALL GSCHH(CHH) 417 : CALL GQCHXP(INDERR,CHXPO) 418 : CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO 418 : CALL GSCHXP(CHXP) 418 : CALL GSCHSP(0.1) 419 : ELSE 420 : * CAS DES LEGENDES ISOVALEURS 420 : CALL GSCHH(0.9) 420 : CALL GSCHXP(1./21.) 420 : CALL GSCHSP(0.1) 421 : ENDIF 422 : RETURN 423 : C 424 : ENTRY KPOLRL(NTRSTU,XTR,YTR) 425 : C 426 : C TRACE D'UNE POLYLIGNE DANS LA VALEUR COURANTE 427 : C NTR : NOMBRE DE POINTS 428 : C XTR,YTR : COORDONNEES DES POINTS 429 : C 430 : NTR=NTRSTU 431 : IF (NTR.LE.1) RETURN 432 : C 433 : IF (NTR.LE.1) RETURN 434 : C 435 : C TRACE D'UNE POLYLIGNE 435 : CALL GSELNT(2) 435 : CALL GPL(NTR,XTR(1),YTR(1)) 436 : C 437 : RETURN 438 : C 439 : ENTRY KTRDIG(X,Y,INCLE) 440 : C 441 : C DIGITALISATION D'UN POINT 442 : C X,Y : COORDONNEES DU POINT DESIGNE 443 : C 444 : INCLE=0 445 : C DEMANDE D'ENTREE DU LOCATOR 445 : CALL GSLCM(WKID,1,0,1) 445 : CALL GUWK(WKID,1) 446 : ITNR=2 446 : CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0) 446 : CALL GRQLC(WKID,1,ISTAT,ITNR,X,Y) 447 : C 448 : C CALCUL DE CONVERSION NDC -> WC 449 : X=X2-((0.9-X)/0.9)*(X2-X1) 450 : Y=Y2-((WRATIO-Y)/0.9/WRATIO)*(Y2-Y1) 451 : IF((X.LT.X1).OR.(X.GT.X2))INCLE=3 452 : IF((Y.LT.Y1).OR.(Y.GT.Y2))INCLE=3 453 : C 454 : C MISE A JOUR DE LA NOUVELLE POSITION DU LOCATOR 455 : XINID=X 456 : YINID=Y 457 : C 458 : C REPASSER SUR LE SEGMENT ISGOLD 459 : ISGNEW=9+(100*(WKID-1)) 460 : ISGOLD=8+(100*(WKID-1)) 460 : CALL GQOPS(ISTA) 461 : IF (ISTA.EQ.4) THEN 461 : CALL GQOPSG(IIERRI,INUM) 461 : IF(INUM.NE.ISGOLD) CALL GCLSG 462 : ELSE 463 : IERGK=1 463 : CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA) 464 : DO 4463 ISEG=1,NBSEG 464 : CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA) 465 : IF (ISEGNA.EQ.ISGOLD) THEN 466 : IERGK=0 467 : GOTO 4464 468 : ENDIF 469 : 4463 CONTINUE 470 : 4464 CONTINUE 471 : IF (IERGK.EQ.0) THEN 471 : CALL GRENSG(ISGOLD,ISGNEW) 472 : C CREATION DU SEGMENT COURANT 472 : CALL GCRSG(ISGOLD) 473 : RMAT(1)=1. 474 : RMAT(2)=0. 475 : RMAT(3)=0. 476 : RMAT(4)=1. 477 : RMAT(5)=0. 478 : RMAT(6)=0. 478 : CALL GINSG(ISGNEW,RMAT) 478 : CALL GDSG(ISGNEW) 479 : ELSE 479 : CALL GCRSG(ISGOLD) 480 : ENDIF 481 : C ATTRIBUT VISIBILITE 481 : CALL GSVIS(ISGOLD,1) 482 : C DETECTABILITE 482 : CALL GSDTEC(ISGOLD,0) 483 : C MODE VECTEUR (POUR LES CARACTERES) 483 : CALL GSTXFP(1,2) 484 : C TAILLE DES CARACTERES PAR DEFAUT 485 : C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER 486 : CHH=(Y2-Y1)/50.0 486 : CALL GSCHH(CHH) 486 : CALL GQCHXP(INDERR,CHXPO) 487 : CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO 487 : CALL GSCHXP(CHXP) 487 : CALL GSCHSP(0.1) 488 : C COULEUR COURANTE (ICCOL) 488 : CALL GSFACI(ICCC(ICCOL)) 488 : CALL GSPLCI(ICCC(ICCOL)) 488 : CALL GSPMCI(ICCC(ICCOL)) 488 : CALL GSTXCI(ICCC(ICCOL)) 489 : C 490 : ENDIF 491 : C 492 : RETURN 493 : C 494 : ENTRY KTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF) 495 : C 496 : C TRACE D'UNE FACE AVEC DEGRADE 497 : C NP : NOMBRE DE POINTS 498 : C XTR,YTR : COORDONNEES DES POINTS 499 : C ICOLE : COULEUR 500 : C KP : ECLAIRAGE 501 : C 502 : IEFF=0 503 : KP=INT(ZN*4./1.58)+1 504 : C 505 : IEFF=0 505 : CALL GSELNT(2) 506 : C 507 : C EFFACEMENT DE LA ZONE (FAUT-IL LE FAIRE AVEC GKS?) 508 : IEFF=1 509 : C IF (KP.GE.3) IEFF=1 510 : IF (KP.NE.4) THEN 511 : C COULEUR EFFACEMENT -> 8 512 : C PATTERN PLEIN 513 : C TRACE DE LA ZONE PLEINE 514 : ENDIF 515 : C 516 : C COULEUR (ICOLE) 516 : CALL GSFACI(ICCC(ICOLE)) 517 : C 517 : CALL GSFAIS(1) 518 : C 519 : C TRACE DE LA ZONE PLEINE 519 : CALL GFA(NP,XTR,YTR) 520 : RETURN 521 : C 522 : ENTRY KTRAIS(NP,XTR,YTR,ICOLE) 523 : C 524 : C TRACE D'UNE FACE SANS CALCUL DE DEGRADE 525 : C NP : NOMBRE DE POINTS 526 : C XTR,YTR : COORDONNEES DES POINTS 527 : C ICOLE : COULEUR 528 : C 529 : C CHANGEMENT DE COULEUR SI CE N'EST PAS LA MEME 530 : IF (ICOLE.NE.ICOISI) THEN 531 : ICOISI=ICOLE 531 : C CALL GSELNT(2) 532 : C COULEUR (ICOISI) 532 : CALL GSFACI(ICCC(ICOISI)) 533 : ENDIF 534 : C 535 : C TRACE DU POLYGONE 535 : CALL GSFAIS(1) 535 : CALL GFA(NP,XTR,YTR) 536 : C 537 : RETURN 538 : C 539 : C EFFACEMENT ECRAN ON UTILISE GDDM OU CE QU'ON PEUT 540 : ENTRY KTREFF 541 : * A VOIR SELON LES TERMINAUX 542 : C IMPLANTATION CERN 543 : C ROUTINE VMCMS DANS KERNLIB 543 : * CALL VMCMS('CLRSCRN',IRC) 544 : RETURN 545 : C REINITIALISATION CHAMP TEXT 546 : C 547 : C AFFICHAGE RETOUR CLE TAPEE 548 : ENTRY KTRAFF(ICLE) 549 : C 550 : C AFFICHAGE RETOUR CLE TAPEE 551 : C ICLE : NUMERO DE CLE RENDUE 552 : C 553 : 1540 CONTINUE 554 : ICLE=0 555 : C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE) 556 : ISGNEW=9+(100*(WKID-1)) 557 : ISGOLD=8+(100*(WKID-1)) 557 : CALL GQOPS(ISTA) 558 : IF (ISTA.EQ.4) THEN 558 : CALL GQOPSG(IIERRI,INUM) 558 : IF(INUM.NE.ISGOLD) CALL GCLSG 559 : ELSE 560 : IERGK=1 560 : CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA) 561 : DO 4466 ISEG=1,NBSEG 561 : CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA) 562 : IF (ISEGNA.EQ.ISGOLD) THEN 563 : IERGK=0 564 : GOTO 4467 565 : ENDIF 566 : 4466 CONTINUE 567 : 4467 CONTINUE 568 : IF (IERGK.EQ.0) THEN 568 : CALL GRENSG(ISGOLD,ISGNEW) 569 : C CREATION DU SEGMENT COURANT 569 : CALL GCRSG(ISGOLD) 570 : RMAT(1)=1. 571 : RMAT(2)=0. 572 : RMAT(3)=0. 573 : RMAT(4)=1. 574 : RMAT(5)=0. 575 : RMAT(6)=0. 575 : CALL GINSG(ISGNEW,RMAT) 575 : CALL GDSG(ISGNEW) 576 : ELSE 576 : CALL GCRSG(ISGOLD) 577 : ENDIF 578 : C ATTRIBUT VISIBILITE 578 : CALL GSVIS(ISGOLD,1) 579 : C DETECTABILITE 579 : CALL GSDTEC(ISGOLD,0) 580 : C MODE VECTEUR (POUR LES CARACTERES) 580 : CALL GSTXFP(1,2) 581 : C TAILLE DES CARACTERES PAR DEFAUT 582 : C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER 583 : CHH=(Y2-Y1)/50.0 583 : CALL GSCHH(CHH) 583 : CALL GQCHXP(INDERR,CHXPO) 584 : CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO 584 : CALL GSCHXP(CHXP) 584 : CALL GSCHSP(0.1) 585 : C COULEUR COURANTE (ICCOL) 585 : CALL GSFACI(ICCC(ICCOL)) 585 : CALL GSPLCI(ICCC(ICCOL)) 585 : CALL GSPMCI(ICCC(ICCOL)) 585 : CALL GSTXCI(ICCC(ICCOL)) 586 : C 587 : ENDIF 588 : C 589 : ISEG=0 590 : C INITIALISATION PICK 590 : CALL GSPKM(WKID,1,0,1) 591 : C DEMANDE D'ENTREE 591 : * CALL GRSGWK(WKID) 591 : CALL GUWK(WKID,1) 591 : CALL GRQPK(WKID,1,ISTAT,ICHNR,PCID) 592 : C CONVERSION NUMERO DE SEGMENT SAISI 593 : ISEG=ICHNR-(100*(WKID-1)) 594 : IF (ISTAT.NE.1) GOTO 1540 595 : C 596 : IF(ISEG.GE.50) THEN 597 : C DEMANDE ENTREE STRING 597 : CALL GSSTM(WKID,1,0,1) 597 : CALL GRQST(WKID,1,ISTAT,IL,STRING) 598 : C DESTRUCTION DU SEGMENT DESIGNE 598 : CALL GDSG(ICHNR) 599 : C REECRITURE DU SEGMENT AVEC LA NOUVELLE CHAINE 599 : CALL GCRSG(ICHNR) 600 : XX=TEXTX(ISEG-50+1) 601 : YY=TEXTY(ISEG-50+1) 601 : CALL GTX(XX,YY,STRING) 601 : CALL GCLSG 601 : CALL GSDTEC(ICHNR,1) 602 : C MODIFICATION DANS LE TABLEAU 603 : TEXTE(ISEG-50+1)(1:15)=STRING(1:15) 604 : ENDIF 605 : ICLE=ISEG 606 : ICLE=ICLE-10 607 : * WRITE (6,*) ' ICLE ',ICLE 608 : IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1540 609 : C 610 : C CHANGEMENT MODE DE MISE A JOUR (BLOCAGE) 610 : CALL GSDS(WKID,1,0) 611 : C 612 : RETURN 613 : C 614 : * ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER 615 : ENTRY KTRMFI 616 : IACT=0 617 : IWISS=0 617 : CALL GQWKS(WKID,IERGK,ISTA) 618 : IF (IERGK.EQ.0) THEN 618 : IF(ISTA.EQ.1) CALL GDAWK(WKID) 618 : CALL GCLWK(WKID) 619 : ENDIF 620 : IDSG=0 621 : RETURN 622 : C 623 : * ENTRY KZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 624 : ENTRY KZOOM(IZOOM,XMI,XMA,YMI,YMA) 625 : C 626 : C XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM 627 : C 628 : IRESU=1 629 : C ENTREE DES DEUX POINTS POUR LE RECTANGLE DU ZOOM 630 : ITNR=2 630 : CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0) 630 : CALL GSELNT(0) 630 : CALL GSLCM(WKID,1,0,1) 631 : C ACCUMULATION DE MATRICES 631 : CALL GRQLC(WKID,1,STAT,ITNR1,XRO,YRO) 631 : CALL GINLC(WKID,1,ITNR1,XRO,YRO,1,0.,RX,0.,RY,0,0) 631 : CALL GRQLC(WKID,1,STAT,ITNR1,XCOL,YCOL) 632 : C GESTION DU CADRE DU ZOOM : CARRE 633 : XMI=MIN(XRO,XCOL) 634 : XMA=MAX(XRO,XCOL) 635 : YMI=MIN(YRO,YCOL) 636 : YMA=MAX(YRO,YCOL) 637 : XMA=MAX(XMA,YMA-YMI+XMI) 638 : YMI=MIN(YMI,-XMA+XMI+YMA) 639 : IF (VALEUR) THEN 640 : PAS=MIN(0.8/(XMA-XMI),(RY/RX)*0.8/(YMA-YMI)) 641 : ELSE 642 : PAS=MIN(0.9/(XMA-XMI),(RY/RX)*0.9/(YMA-YMI)) 643 : ENDIF 644 : C INTERROGATION SUR LA MATRICE PRECEDENTE 645 : ISEG=1+(100*(WKID-1)) 645 : CALL GQSGA(ISEG,ERR,SEGT,VIS,HIGH,GRPR,DET) 646 : C INITIALISATION DES MATRICES 647 : ISW=1 648 : SEGMT(1)=PAS 649 : SEGMT(2)=0. 650 : SEGMT(3)=0. 651 : SEGMT(4)=PAS 652 : IF (VALEUR) THEN 653 : XVALEU=0.8 654 : YVALEU=0.9*(RY/RX) 655 : ELSE 656 : XVALEU=0.9 657 : YVALEU=1.0*(RY/RX) 658 : ENDIF 659 : SEGMT(5)=XVALEU/2-(XMA+XMI)/2*PAS 660 : SEGMT(6)=(YVALEU+0.1*(RY/RX))/2-(YMA+YMI)/2*PAS 661 : ROUT(1)=SEGMT(1)*SEGT(1) + SEGMT(2)*SEGT(3) 662 : ROUT(2)=SEGMT(2)*SEGT(1) + SEGMT(4)*SEGT(2) 663 : ROUT(3)=SEGMT(1)*SEGT(3) + SEGMT(3)*SEGT(4) 664 : ROUT(4)=SEGMT(2)*SEGT(3) + SEGMT(4)*SEGT(4) 665 : ROUT(5)=SEGMT(1)*SEGT(5) + SEGMT(3)*SEGT(6) + SEGMT(5) 666 : ROUT(6)=SEGMT(2)*SEGT(5) + SEGMT(4)*SEGT(6) + SEGMT(6) 667 : C TRANSFORMATION PAR LA MATRICE 667 : CALL GSSGT(ISEG,ROUT) 668 : C 669 : * IF (IDEFOR.NE.0) THEN 670 : *1093 ISORT=0 671 : * RETURN 672 : * ENDIF 673 : C SUPPRESSION DE SEGMENTS 674 : IDEL1=0 675 : IDEL2=0 676 : IDEL3=0 677 : *1093 IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1)) 678 : *1093 IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1)) 679 : *1093 IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1)) 679 : IF (IDEL1.NE.0) CALL GDSG(IDEL1) 679 : IF (IDEL2.NE.0) CALL GDSG(IDEL2) 679 : IF (IDEL3.NE.0) CALL GDSG(IDEL3) 680 : *1093 IF (IQUALI.EQ.10) IQUALI=0 681 : *1093 IF (INUMNO.EQ.10) INUMNO=0 682 : *1093 IF (INUMEL.EQ.10) INUMEL=0 683 : *1093 ISORT=1 684 : IRESU=2 685 : C 686 : IF (VALEUR) THEN 687 : ROUT(5)=ROUT(5)*(X2-X1)/0.8+X1 688 : ROUT(6)=ROUT(6)*(Y2-Y1)/(0.8*RY/RX)+(9*Y1-Y2)/8. 689 : ELSE 690 : ROUT(5)=ROUT(5)*(X2-X1)/0.9+X1 691 : ROUT(6)=ROUT(6)*(Y2-Y1)/(0.9*RY/RX)+(10*Y1-Y2)/9. 692 : ENDIF 693 : C CALCUL DES COORDONNEES APRES LE ZOOM 694 : XMI=(SXMIN-ROUT(5))/ROUT(1)+X1 695 : XMA=(SXXAX-ROUT(5))/ROUT(1)+X1 696 : IF (VALEUR) THEN 697 : YMI=(SYMIN-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8. 698 : YMA=(SYYAX-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8. 699 : ELSE 700 : YMI=(SYMIN-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9. 701 : YMA=(SYYAX-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9. 702 : ENDIF 702 : CALL GSELNT(2) 703 : RETURN 704 : C 705 : ENTRY KCHANG(IRESU,ISORT,ICHANG,JSEG) 706 : C 707 : C VISUALISATION OU NON DU SEGMENT JSEG 708 : C POUR LES CLES QUAL, NOEUD OU ELEM 709 : C 710 : ISEG=JSEG+(100*(WKID-1)) 711 : IF (ICHANG.EQ.1) THEN 712 : ICHANG=10 712 : CALL GSVIS(ISEG,0) 713 : ISORT=0 714 : RETURN 715 : ELSEIF (ICHANG.EQ.10) THEN 716 : ICHANG=1 716 : CALL GSVIS(ISEG,1) 717 : ISORT=0 718 : RETURN 719 : ENDIF 720 : ISORT=1 721 : IRESU=JSEG 722 : ICHANG=1 723 : RETURN 724 : C 725 : ENTRY KINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 726 : C 727 : C RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS 728 : C CONCERNANT QUAL, NOEUD ET ELEM 728 : CALL GSELNT(2) 729 : PAS=1 730 : RMAT(1)=1. 731 : RMAT(2)=0. 732 : RMAT(3)=0. 733 : RMAT(4)=1. 734 : RMAT(5)=0. 735 : RMAT(6)=0. 736 : ISEG=1+(100*(WKID-1)) 737 : C APPLICATION DE LA MATRICE AU SEGMENT 1 737 : CALL GSSGT(ISEG,RMAT) 738 : * IF (IDEFOR.NE.0) THEN 739 : * ISORT=0 740 : * RETURN 741 : * ENDIF 742 : IDEL1=0 743 : IDEL2=0 744 : IDEL3=0 745 : IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1)) 746 : IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1)) 747 : IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1)) 747 : IF (IDEL1.NE.0) CALL GDSG(IDEL1) 747 : IF (IDEL2.NE.0) CALL GDSG(IDEL2) 747 : IF (IDEL3.NE.0) CALL GDSG(IDEL3) 748 : IF (IQUALI.EQ.10) IQUALI=0 749 : IF (INUMNO.EQ.10) INUMNO=0 750 : IF (INUMEL.EQ.10) INUMEL=0 751 : C RESTITUTION DES COORDONNEES 752 : XMI=SXMIN 753 : XMA=SXXAX 754 : YMI=SYMIN 755 : YMA=SYYAX 755 : CALL GSWN(2,X1,X2,Y1,Y2) 756 : ISORT=1 757 : IRESU=2 757 : C CALL GSELNT(2) 758 : RETURN 759 : C 760 : ENTRY KFLGI 761 : C 762 : C en fait c'est l'impression que l'on demande 763 : ENTRY KIMPR 764 : C 765 : C EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX 766 : C AVEC XX = NUMERO DE 01 A 99 767 : C INCREMENTATION DU COMPTEUR METAFILE 768 : KMETA=KMETA+1 769 : IF (KMETA.GT.99) THEN 769 : CALL GTX(25.,6.,'COMPTEUR DE MATAFILE SUPERIEUR A 99') 769 : CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE') 770 : RETURN 771 : ENDIF 772 : I10=KMETA/10 773 : IREST=KMETA-10*I10 774 : I10=I10+1 775 : IREST=IREST+1 776 : STR=STR1//CARELE(I10)//CARELE(IREST) 777 : * OPEN(UNIT=1,FILE=STR,STATUS='NEW',IOSTAT=JERROR) 778 : * IF (JERROR.NE.0) THEN 778 : * CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE') 778 : * CALL GTX(25.,6.,'CANNOT OPEN METAFILE') 779 : * RETURN 780 : * ENDIF 781 : KCON=1 782 : METAID=1 782 : CALL GQOPS(ISTA) 782 : IF (ISTA.EQ.4) CALL GCLSG 782 : CALL GOPWK(METAID,KCON,INMETA) 782 : CALL GACWK(METAID) 782 : CALL GSWKWN(METAID,0.,1.,0.,1.) 782 : CALL GSWKVP(METAID,0.,0.20,0.,0.20) 783 : ISEG=6+(100*(WKID-1)) 783 : CALL GASGWK(METAID,ISEG) 784 : ISEG=1+(100*(WKID-1)) 784 : CALL GASGWK(METAID,ISEG) 785 : IF (FENE) THEN 786 : IF (VALEUR) THEN 787 : ISEG=7+(100*(WKID-1)) 787 : CALL GASGWK(METAID,ISEG) 788 : ELSE 789 : ISEG=3+(100*(WKID-1)) 789 : IF (IQUALI.EQ.1) CALL GASGWK(METAID,ISEG) 790 : ISEG=4+(100*(WKID-1)) 790 : IF (INUMNO.EQ.1) CALL GASGWK(METAID,ISEG) 791 : ISEG=5+(100*(WKID-1)) 791 : IF (INUMEL.EQ.1) CALL GASGWK(METAID,ISEG) 792 : ENDIF 793 : ENDIF 793 : CALL GQWKS(METAID,IERGK,ISTA) 794 : IF (IERGK.EQ.0) THEN 794 : IF (ISTA.EQ.1) CALL GDAWK(METAID) 794 : CALL GCLWK(METAID) 795 : ENDIF 796 : CLOSE(UNIT=1,STATUS='KEEP') 797 : RETURN 798 : C 799 : ENTRY KVAL(IRESU,ISORT,NISO) 800 : C 801 : RETURN 802 : C 803 : ENTRY KMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) 804 : C 805 : IF (IMAJ.EQ.1) THEN 806 : IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0) 806 : & CALL GCLSG 807 : ELSE 808 : IF (IQUALI.EQ.10) IQUALI=0 809 : IF (INUMNO.EQ.10) INUMNO=0 810 : IF (INUMEL.EQ.10) INUMEL=0 811 : C 812 : IF (IRESU.LT.2.OR.IRESU.GT.5) THEN 813 : C EFFACEMENT DU DESSIN (A VOIR) 814 : ENDIF 815 : C FERMETURE DE LA WORKSTATION WKID POUR POUVOIR PASSER EN MODE 816 : C ALPHANUMERIQUE A LA FIN DU DESSIN 816 : CALL GQOPS(ISTA) 816 : IF (ISTA.EQ.4) CALL GCLSG 816 : IF (ISTA.EQ.4.OR.ISTA.EQ.3) CALL GDAWK(WKID) 816 : IF (ISTA.EQ.4.OR.ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID) 817 : ENDIF 818 : RETURN 819 : C 820 : ENTRY KTRANI(IANIM,NDEF) 821 : * INITIALISATION POUR ANIMATION 822 : * IANIM 1 ALLER SIMPLE 823 : * IANIM 2 ALLER RETOUR 824 : * NDEF NOMBRE D'IMAGE 825 : RETURN 826 : C 827 : ENTRY KTRIMA(IDEF) 828 : * NOUVELLE IMAGE 829 : * IDEF NUMERO DE L'IMAGE 830 : C 831 : RETURN 832 : C 833 : C MESSAGE EN BAS DE L'ECRAN 834 : ENTRY KTRMES(TITRE) 834 : CALL GMSG(WKID,TITRE(1:LEN(TITRE))) 835 : RETURN 836 : C 837 : C INPUT AVEC PROMPT 838 : ENTRY KTRGET(TITRE,CARACT) 839 : RETURN 840 : END 841 : 842 : 843 : 844 : 845 : 846 : 847 : 848 :
© Cast3M 2003 - All rights reserved.
Disclaimer