C LTRINI SOURCE CHAT 05/01/13 01:25:58 5004 C INTERFACE POUR GENERATION DE LGI C SUBROUTINE LTRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA) IMPLICIT INTEGER(I-N) -INC CCOPTIO DIMENSION XTR(*),YTR(*) CHARACTER*(*) TITR,CARAC,PROMPT,REPLY CHARACTER*(*) LEGEND CHARACTER*80 CHAINE,TITRE LOGICAL VALEU,FENE,VALEUR,FENET EQUIVALENCE (CHAINE,ICHAIN) SAVE XIOCAD,YIOCAD,VALEUR,FENET,TITRE,LTITRE SAVE XMIN,YMIN,XXAX,YYAX,CLX,XRAP,YRAP,XDEP,YDEP * * DECLARATION POUR LGI external long DIMENSION Q(20),ICOLT(9) DATA ICOLT/0,1,2,5,3,6,4,7,8/ * Pour le lgi verification des bornes bornex(xxx)=min(max(xiocad*0.01,xxx),xiocad*0.99) borney(yyy)=min(max(yiocad*0.01,yyy),yiocad*0.99) C INITIALISATION NCOUMA=7 LTITRE=LONG(TITR) TITRE=TITR VALEUR=VALEU * OUVERTURE LGI * CLX=DIOCAD/100. CORRECTION POUR AVOIR UNE BONNE TAILLE DE * CARACTERE SUR LES GRANDS BENSON CLX=0.3 xiocad=diocad yiocad=xiocad*21/29.7 Q(1)=xiocad Q(2)=yiocad Q(3)=1. Q(4)=1. CALL ZTACMZ(2,25,Q) RETURN ** ENTRY LDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE) * DEFINITION FENETRE XR1=XMI XR2=XXA YR1=YMI YR2=YYA FENET=FENE XMIN=XMI XXAX=XXA YMIN=YMI YYAX=YYA IF (FENET) THEN if (.not.valeur) xiocad=xiocad-5*clx if (valeur) xiocad=xiocad-10*clx endif yiocad=yiocad-2*clx XRAP=xIOCAD/(XXAX-XMIN)*0.95 YRAP=yIOCAD/(YYAX-YMIN)*0.95 rap=min(xrap,yrap) if (fenet) then xrap=rap yrap=rap endif IF (FENET) THEN if (.not.valeur) xiocad=xiocad+5*clx if (valeur) xiocad=xiocad+10*clx endif yiocad=yiocad+2*clx XDEP=-XMIN + (xxax-xmin)*0.02 YDEP=-YMIN + (YYAX-YMIN)*0.02 +CLX/YRAP CHAINE(1:LTITRE)=TITRE(1:LTITRE) NBC=LTITRE Q(1)=bornex(0.) Q(2)=borney(0.) XCO=NBC*CLX/XRAP YCO=0 Q(3)=bornex(XCO*XRAP) Q(4)=borney(YCO*YRAP) CALL ZTACMZ(4,NBC,Q) READ(CHAINE,FMT='(20A4)') (Q(I),I=1,1+(NBC-1)/4) CALL ZTACMZ(1,1,Q) RETURN ** ENTRY LTRLAB(XT,YT,CARAC,NCARR,HAUT) * ECRITURE TEXT NBC=LONG(CARAC(1:NCARR)) Q(1)=BORNEX((XDEP+XT)*XRAP) Q(2)=BORNEY((YDEP+YT)*YRAP) Q(3)=bornex(Q(1)+NBC*CLX) Q(4)=borney(Q(2)) CALL ZTACMZ(4,NBC+256*(0+3),Q) CHAINE=CARAC(1:NBC) READ(CHAINE,FMT='(20A4)') (Q(I),I=1,1+(NBC-1)/4) CALL ZTACMZ(1,1,Q) RETURN ** ENTRY LCHCOU(JCOLO) * CHANGEMENT DE COULEUR CALL ZTACMZ(6,ICOLT(JCOLO+1),Q) CALL ZTACMZ(6,ICOLT(JCOLO+1)+10000,Q) CALL ZTACMZ(10,ICOLT(JCOLO+1),Q) RETURN ** ENTRY LINSEG(JSEG,IRESS) * CHANGEMENT SEGMENT IGNORE RETURN ** ENTRY LPOLRL(NTRSTU,XTR,YTR) * POLYLINE DO 1060 I=1,NTRSTU-1 Q(1)=BORNEX((XTR(I)+XDEP)*XRAP) Q(2)=BORNEY((YTR(I)+YDEP)*YRAP) Q(3)=BORNEX((XTR(I+1)+XDEP)*XRAP) Q(4)=BORNEY((YTR(I+1)+YDEP)*YRAP) CALL ZTACMZ(3,1,Q) 1060 CONTINUE RETURN ** ENTRY LTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF) * FACETTE CALL ZTACMZ(6,ICOLT(ICOLE+1),Q) CALL ZTACMZ(10,ICOLT(ICOLE+1),Q) CALL ZTACMZ(9,0,Q) DO 1070 I=1,NTRSTU Q(1)=BORNEX((XTR(I)+XDEP)*XRAP) Q(2)=BORNEY((YTR(I)+YDEP)*YRAP) CALL ZTACMZ(9,-1,Q) 1070 CONTINUE CALL ZTACMZ(9,1,Q) IEFF=1 RETURN ** ENTRY LTRAIS(NP,XTR,YTR,ICOLE) * FACETTE CALL ZTACMZ(6,ICOLT(ICOLE+1),Q) CALL ZTACMZ(10,ICOLT(ICOLE+1),Q) if (np.gt.2) then CALL ZTACMZ(9,0,Q) DO 1080 I=1,NP Q(1)=BORNEX((XTR(I)+XDEP)*XRAP) Q(2)=BORNEY((YTR(I)+YDEP)*YRAP) CALL ZTACMZ(9,-1,Q) 1080 CONTINUE CALL ZTACMZ(9,1,Q) else Q(1)=BORNEX((XTR(1)+XDEP)*XRAP) Q(2)=BORNEY((YTR(1)+YDEP)*YRAP) Q(3)=BORNEX((XTR(2)+XDEP)*XRAP) Q(4)=BORNEY((YTR(2)+YDEP)*YRAP) CALL ZTACMZ(3,1,Q) endif RETURN ** ENTRY LTRDIG(XRO,XCOL,ICLE) * DIGITALISATION DE POINT IGNORE ICLE=0 RETURN ** ENTRY LTRAFF(ICLE) * FIN DE DESSIN CALL ZTACMZ(2,-1,Q) ICLE=0 RETURN ** ENTRY LMENU(LEGEND,NCASE,LLONG) * MENU IGNORE RETURN ** ENTRY LTRANI(ITYPI,NBIMAH) * ANIMATION IGNOREE RETURN ** ENTRY LTRIMA(IMAGI) * IMAGE IGNOREE RETURN ** ENTRY LFVALI(IFENI,IRESU,NH) * CHANGEMENT DE VIEW PORT IF (IFENI.EQ.1) THEN XRAP=CLX*10/0.95 YRAP=clx*2/0.95 XDEP=(xiocad-10*clx)/xrap YDEP=0. ENDIF NH=31 RETURN ** ENTRY LZOOM(IZOOM,XMI,XMA,YMI,YMA) * IGNOREE RETURN ** ENTRY LINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) * RETOUR AU DESSIN INITIAL IGNORE RETURN ** ENTRY LCHANG(IRESU,ISORT,ICHANG,JSEG) * AFFICHAGE DESAFFICHAGE NUM NOEUDS ELEMENTS QUAL IGNORE RETURN ** ENTRY LTRBOX(HAUTX,HAUTY) * INUTILISE RETURN ** ENTRY LTREFF * INUTILISE RETURN ** ENTRY LVAL(IRESU,ISORT,NISO) * INUTILISE RETURN ** ENTRY LMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) * INUTILISE RETURN ** ** ENTRY LIMPR * INUTILISE RETURN ** ENTRY LTRTIN * INUTILISE RETURN ** ENTRY LFLGI * INUTILISE RETURN ** ENTRY LTRMES(CARAC) * INUTILISE RETURN ** ENTRY LTRGET(PROMPT,REPLY) * INUTILISE RETURN ENTRY LTRMFI * INUTILISE RETURN END