C ANNO SOURCE JC220346 19/12/31 21:15:01 10442 C*********************************************************************** C NOM : ANNO C DESCRIPTION : Cree des objets de type ANNOTATI C*********************************************************************** SUBROUTINE ANNO IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMANNOT -INC SMCOORD CHARACTER*4 CHA4 CHARACTER*8 CHA8 CHARACTER*70 CH70,TXT LOGICAL BOOL PARAMETER (NCLE=2) CHARACTER*4 MCLE(NCLE) DATA MCLE/'CATE','ETIQ'/ PARAMETER (NPOS=9) CHARACTER*4 MPOS(NPOS) DATA MPOS/'SO','S','SE','O','C','E','NO','N','NE'/ C BRANCHEMENT VERS LE SOUS-TYPE DEMANDE CHA4 = ' ' IF (ICLE.EQ.0) THEN MOTERR(1:4) = CHA4 MOTERR(5:40) = 'CATE ETIQ' ENDIF GOTO (100,200),ICLE C ************************************************************** C CREATION D'UNE ENTREE DE LEGENDE DE TYPE "CATEGORIE" C ************************************************************** 100 CONTINUE KTXTD = 0 KCLRD = 0 * on veut obligatoirement lire un texte quelconque et une couleur, * dans n'importe quel ordre 101 CONTINUE IF (IERR.NE.0) RETURN IF (LCHA.LE.4) THEN IF (ICOUL1.NE.0) THEN * CHOIX ARBITRAIRE * si on trouve deux mots correspondant a des couleurs, * c'est le premier qui est pris comme texte de la categorie IF (KCLRD.EQ.1) THEN TXT = NCOUL(ICOUL) KTXTD = 1 ELSE ICOUL = ICOUL1 KCLRD = 1 ENDIF ENDIF ELSE IF (KTXTD.EQ.1) THEN MOTERR(1:4) = CH70(1:4) RETURN ELSE TXT = CH70(1:LCHA) KTXTD = 1 ENDIF ENDIF IF (KTXTD.EQ.0.OR.KCLRD.EQ.0) GOTO 101 SEGINI,MCATE1 MCATE1.ICLRC = ICOUL - 1 MCATE1.TXCAT = TXT ICLAS1 = 1 ISEGT1 = MCATE1 GOTO 9000 C ************************************************************** C CREATION D'UNE ETIQUETTE C ************************************************************** 200 CONTINUE IPOS=9 ICOUL=IDCOUL DIS=0.D0 BOOL=.TRUE. INUM=0 ILOOP=0 KPOSD=0 KCLRD=0 KTXTD=0 * les seuls arguments obligatoires sont un POINT et un MOT * on peut lire en option un MOT pour la couleur et un autre MOT * pour la position * on peut aussi lire en option un FLOTTANT et un LOGIQUE * tous ces objets peuvent etre specifies DANS N'IMPORTE QUEL ORDRE 201 CONTINUE ILOOP=ILOOP+1 IF (IRET.EQ.0) GOTO 299 IF (CHA8.EQ.'MOT') THEN IF (IERR.NE.0) RETURN IF (LCHA.LE.4) THEN IF (IPOS1.NE.0) THEN IPOS2 = IPOS1 KPOSD = ILOOP GOTO 201 ENDIF IF (ICOUL1.NE.0) THEN ICOUL2 = ICOUL1 KCLRD = ILOOP GOTO 201 ENDIF ENDIF TXT = CH70(1:LCHA) KTXTD = ILOOP ELSEIF (CHA8.EQ.'FLOTTANT') THEN IF (IERR.NE.0) RETURN ELSEIF (CHA8.EQ.'POINT') THEN IF (IERR.NE.0) RETURN ELSEIF (CHA8.EQ.'LOGIQUE') THEN IF (IERR.NE.0) RETURN ENDIF GOTO 201 299 CONTINUE IF (INUM.EQ.0) THEN MOTERR(1:8) = 'POINT' RETURN ENDIF IF (KTXTD.GT.0) THEN IF (KPOSD.GT.0) IPOS=IPOS2 IF (KCLRD.GT.0) ICOUL=ICOUL2 - 1 * si le texte n'est pas defini mais que la position ou la couleur * l'est, c'est parce que l'utilisateur voulait peut-etre afficher * un mot tel que 'ROUG', 'VERT', 'SE', 'C'... ELSE IF (KPOSD.GT.0.OR.KCLRD.GT.0) THEN * CHOIX ARBITRAIRE * on utilise le mot (definissant la couleur ou la position) * apparaissant en premier dans l'instruction pour definir * le texte (la couleur/position reprend alors sa valeur * par defaut) IF (KPOSD.LT.KCLRD) THEN TXT = MPOS(IPOS2) ICOUL = ICOUL2 - 1 ELSE TXT = NCOUL(ICOUL2) IPOS = IPOS2 ENDIF ELSE MOTERR(1:8) = 'MOT' RETURN ENDIF ENDIF SEGINI,METIQ1 METIQ1.INUPT = INUM METIQ1.ICLRE = ICOUL METIQ1.KPOSI = IPOS METIQ1.DEPOR = DIS METIQ1.BLIEN = BOOL METIQ1.TXETI = TXT ICLAS1 = 2 ISEGT1 = METIQ1 GOTO 9000 C ************************************************************** C CREATION DE L'OBJET ANNOTATION C ************************************************************** 9000 CONTINUE NBANNO = 1 SEGINI,MANNO1 MANNO1.ICLAS(1) = ICLAS1 MANNO1.ISEGT(1) = ISEGT1 END
© Cast3M 2003 - Tous droits réservés.
Mentions légales