C OTRINI SOURCE GOUNAND 16/08/01 21:15:23 9043 CSSP TRINIT VERSION 04/08/89 MODIFIEE POUR DRIVER OPENGL+GLUT C------------------------------------------------------------ SUBROUTINE OTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA,IPOLI, & ICOSC) save niso dimension ztrl(10),ctrl(10) dimension xtr(64),ytr(64),ztr(64) dimension xl(3),yl(3),zl(3) character*(*) titre,reply,prompt INTEGER valeu,len,ncouma,ipoli,icosc logical fenet external long CHARACTER*80 CHAINE,CHMESS EQUIVALENCE (CHAINE,ICHAIN) EQUIVALENCE (CHmess,ICHmes) NCOUMA=64 HAUT=HAUTT NHAUT=31 VALEUR=VALEU KSEGN=0 AX=AXAX AY=AYAY len=long(titre) call oglini(titre,valeu,len,ncouma,ipoli,icosc) RETURN C*********************************************************************** C C subroutine DFENET C ENTRY ODFENE(XMIN,XXAX,YMIN,YYAX,ZMIN,ZZAX,XR1,XR2,YR1,YR2,FENET) xr1=xmin xr2=xxax yr1=ymin yr2=yyax call ogldfene(XMIN,XXAX,YMIN,YYAX,ZMIN,ZZAX,FENET) RETURN C*********************************************************************** C C subroutine TRLABL C ENTRY OTRLAB(X,Y,Z,CARACT,NCAR,HAUTT) call ogltrlabl(x,y,z,caract,ncar) RETURN C*********************************************************************** C C subroutine TRBOX C * ENTRY PTRBOX (HAUTX,HAUTY) RETURN C*********************************************************************** C C subroutine CHCOUL C ENTRY OCHCOU(JCOLO) call oglchcou(jcolo) RETURN C*********************************************************************** C C subroutine FVALIS C ENTRY OFVALI(IFENI,IRESU,NH,ni) * write (6,*) ' ofvali-1 ni ',ni call oglfvali(ifeni,iresu,nh) * write (6,*) ' ofvali-2 ni ',ni niso=ni RETURN C*********************************************************************** C C subroutine MENU C *PV ENTRY PMENU(LEGEND,NCASE,LLONG) RETURN C*********************************************************************** C C subroutine INSEGT C ENTRY OINSEG(NBSEGT,IRESS) call oglinsegt(nbsegt,iress) RETURN C*********************************************************************** C C subroutine POLRL C ENTRY OPOLRL(NTRSTU,XTR,YTR,ZTR) call oglpolrl(ntrstu,xtr,ytr,ztr) RETURN C*********************************************************************** C C subroutine TRDIG C *pv ENTRY PTRDIG(X,Y,INCLE) RETURN C*********************************************************************** C C subroutine TRFACE C ENTRY OTRFAC(NP,XTR,YTR,ZTR,ZN,ICOLE,IEFF) * comme opengl ne veut que des polygones convexes, on découpe en triangles npl=np if ((xtr(1).eq.xtr(np)).and.(ytr(1).eq.ytr(np)).and. > (ztr(1).eq.ztr(np))) npl=np-1 if (npl.eq.3) then nt=1 xc=xtr(3) yc=ytr(3) zc=ztr(3) * write(6,*) 'tri3 nt npl xc,yc,zc=',nt,npl,xc,yc,zc elseif (npl.eq.4) then nt=4 xc=(xtr(1)+xtr(2)+xtr(3)+xtr(4))/4 yc=(ytr(1)+ytr(2)+ytr(3)+ytr(4))/4 zc=(ztr(1)+ztr(2)+ztr(3)+ztr(4))/4 elseif (npl.eq.6) then nt=6 xc=(xtr(2)+xtr(4)+xtr(6))/3 yc=(ytr(2)+ytr(4)+ytr(6))/3 zc=(ztr(2)+ztr(4)+ztr(6))/3 * write(6,*) 'tri6 nt npl xc,yc,zc=',nt,npl,xc,yc,zc elseif (npl.eq.8) then nt=8 xc=-0.25*xtr(1)+0.5*xtr(2)-0.25*xtr(3)+0.5*xtr(4)- > 0.25*xtr(5)+0.5*xtr(6)-0.25*xtr(7)+0.5*xtr(8) yc=-0.25*ytr(1)+0.5*ytr(2)-0.25*ytr(3)+0.5*ytr(4)- > 0.25*ytr(5)+0.5*ytr(6)-0.25*ytr(7)+0.5*ytr(8) zc=-0.25*ztr(1)+0.5*ztr(2)-0.25*ztr(3)+0.5*ztr(4)- > 0.25*ztr(5)+0.5*ztr(6)-0.25*ztr(7)+0.5*ztr(8) elseif (npl.eq.7.or.npl.eq.9) then xc=xtr(npl) yc=ytr(npl) zc=ztr(npl) nt=npl-1 npl=npl-1 * write(6,*) 'tri7 nt npl xc,yc,zc=',nt,npl,xc,yc,zc else nt=npl xc=0 yc=0 zc=0 do ipl=1,npl xc=xc+xtr(ipl) yc=yc+ytr(ipl) zc=zc+ztr(ipl) enddo xc=xc/npl yc=yc/npl zc=zc/npl endif xl(1)=xc yl(1)=yc zl(1)=zc call oglchcou(icole) do it=1,nt iu=it+1 if (iu.gt.npl) iu=1 * write(6,*) 'it,iu=',it,iu xl(2)=xtr(it) yl(2)=ytr(it) zl(2)=ztr(it) xl(3)=xtr(iu) yl(3)=ytr(iu) zl(3)=ztr(iu) call ogltrfac(3,xl,yl,zl) enddo ieff=1 RETURN C*********************************************************************** C C subroutine TRAISO C ENTRY OTRAIS(NP,XTR,YTR,ICOLE) do ii=1,10 ztrl(ii)=0 ctrl(ii)=(icole-1.)/niso enddo call ogltriso(xtr,ytr,ztrl,ctrl,np) * call ogltrfac(np,xtr,ytr,ztrl) RETURN C*********************************************************************** C C subroutine TREFF C *PV ENTRY PTREFF 1160 CONTINUE RETURN C*********************************************************************** C C subroutine TRAFF C ENTRY OTRAFF(ICLE) ICLE=0 call oglaff(icle) RETURN C*********************************************************************** C C subroutine TRMFIN C *PV ENTRY PTRMFI RETURN C*********************************************************************** C C subroutine ZOOM C * ENTRY PZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) *pv ENTRY PZOOM(IZOOM,XMI,XMA,YMI,YMA) RETURN C*********************************************************************** C C subroutine CHANG C ENTRY OCHANG(IRESU,ISORT,ICHANG,JSEG) call oglchang(IRESU,ISORT,ICHANG,JSEG) RETURN C*********************************************************************** C C subroutine INI C *pv ENTRY PINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) RETURN C*********************************************************************** C C subroutine FLGI C *pv ENTRY PFLGJ RETURN C*********************************************************************** C C subroutine IMPR C *pv ENTRY PFLGI ENTRY OIMPR C RETURN C*********************************************************************** C C subroutine VAL C *pv ENTRY PVAL(IRESU,ISORT,NISO) C C*********************************************************************** C C subroutine MAJSEG C ENTRY OMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) call oglmajse(imaj,iresu,iquali,inumno,inumel) C RETURN C*********************************************************************** C entry OTRMES(titre ) call ogltrmess(titre ,LONG(titre )) C RETURN C*********************************************************************** C C subroutine TRGET C C ----------------------------------------- C Sous-programme uniquement appele par MODI C ----------------------------------------- ENTRY OTRGET(PROMPT,REPLY) LPROMP=LONG(PROMPT) LREPLY=LONG(REPLY) CHAINE=PROMPT CALL oglGET(ICHAIN,LPROMP,ICHAIN,LREPLY) REPLY=' ' IF (LREPLY.NE.0) REPLY=CHAINE(1:LREPLY) RETURN RETURN C ------------ C fin de TRGET C ------------ *************************************************************************************** * transmission de l'option NCLK ENTRY ORCLIK(KCLICK) CALL OCLIK(KCLICK) END