Sources Esope | Cast3M

otrini
C OTRINI    SOURCE    PV090527  26/09/08    21:15:08     12640          
CSSP TRINIT VERSION 04/08/89 MODIFIEE POUR DRIVER OPENGL+GLUT
C------------------------------------------------------------
      SUBROUTINE OTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA,IPOLI,
     & ICOS)
-INC CCTRACE
      save niso
      dimension ztrl(10),ctrl(10)
      dimension xtr(64),ytr(64),ztr(64)
      dimension xl(3),yl(3),zl(3)
      DIMENSION ROUG(64),VERT(64),BLEU(64)
      character*(*) titre,reply,prompt
      INTEGER valeu,len,ncouma,ipoli,icos
      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,icos)
      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
C     Calcul des couleurs depuis la palette
      DO I=1,NP
        XALFA=CTRL(I)
        CALL PALET3(XALFA,IPALET,R1,V1,B1)
        ROUG(I)=R1
        VERT(I)=V1
        BLEU(I)=B1
      ENDDO
C     Trace
      CALL OGLTRISO(XTR,YTR,ZTRL,CTRL,NP,ROUG,VERT,BLEU)
*     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