Next: References Up: 9 Examples Prev: 9.1 Creating 2D geometric figures Contents

9.2 Creating 3D geometric figures

      PROGRAM IMAG3D
C --- PLOT FIGURES
      REAL PI
      PARAMETER (PI=3.14152)
      INTEGER ITERM,PAROUT(10), PARIN(10) 
      CHARACTER*80 STRING
      REAL PAS1,PAS2,R1,R2,A,B,ALPHA,X,Y,Z,XMIN,XMAX,YMIN,YMAX
      REAL PX,XX,YY,TAILLE,PY1,PY2,PY3,O
      LOGICAL BID
      INTEGER IBID,NBCIN
      CHARACTER*1 REP
C --- INTERACTIVE DEFINITION OF TERMINAL
      ITERM = 0
      CALL DEFDEV(ITERM, PAROUT, PARIN, STRING)
C --- SCREEN DIMENSION
      CALL SZSCRN(XMIN, XMAX, YMIN, YMAX) 
      CALL FENTR2(XMIN, XMAX, YMIN, YMAX)
      CALL MASQU2(XMIN, XMAX, YMIN, YMAX)
C --- TEXT SIZE
      TAILLE = MIN((YMAX-YMIN)/10. , 0.5)
      CALL DRW3TX(TAILLE, 0., O)
C --- TEXT POSITION
      PX = XMIN + (XMAX-XMIN) / 20.
      PY1 = YMAX - 2.*TAILLE
      PY2 = YMAX - 4.*TAILLE
      PY3 = YMIN + 2.*TAILLE
C --- INPUT STEP
      PAS1=0.1
      PAS2=0.1
    2 CONTINUE
      CALL CLEAN
C --- CURRENT COLOR = WHITE
      CALL SETCOL(1., 1., 1.)
      CALL GETNUM('PAS DE ROTATION EN FRACTION DE PI/2  : ',
     + PX, PY1, PAS1, IBID, BID, 1, 1, 0, 0, 0., 2.)
      CALL GETNUM('PAS D''ENROULEMENT EN FRACTION DE PI/2: ',
     + PX, PY2, PAS2, IBID, BID, 1, 1, 0, 0, 0., 2.)
C --- DEFINITION OF PERSPECTIVE
      ALPHA = PI/10. 
      CALL PRSPCT (ALPHA , ALPHA)
C --- START OF IMAGE
      CALL PUSH
C --- POSITION THE OBSERVER
      CALL NRMLST(400., 400., 300., 0., 0., 0., 3)
C --- END OF TRANSFORMATIONS TO APPLY TO OBSERVER
C --- START OF OBJECT DESCRIPTION SEQUENCE 
      CALL PREPAR 
C --- INITIALIZE CURSOR POSITION
      CALL MOV3TO(125., 0., 0.) 
C --- PLOT OF OBJECT 
      R1 = 100.
      R2 = 25.
      A = 0. 
      DO 1 B = 0. , 8.*PI , PAS1*2.*PI/200.
         A = MOD (A +  PAS2*2.*PI , 2*PI)
         X = (R1 + R2*COS(A)) * COS(B)
         Y = (R1 + R2*COS(A)) * SIN(B)
         Z = R2 * SIN(A)
         CALL LIN3TO(X, Y, Z)
    1 CONTINUE 
      CALL LIMITS(0)
C --- END OF PLOT
      CALL PULL
      CALL FENTR2(XMIN, XMAX, YMIN, YMAX)
      CALL MASQU2(XMIN, XMAX, YMIN, YMAX)
      CALL SETCOL(1., 1., 1.)
      XX = PX
      YY = PY3 
      CALL GETEXT('> CONTINUER (O/N) ? ', XX, YY, 1, REP, NBCIN)
      IF (REP .EQ. 'O' .OR. REP.EQ.'Y') THEN 
C --- CONTINUE
        GOTO 2
      ELSE
C --- DO NOT CONTINUE
        CALL ENDDEV(ITERM)
      ENDIF
      END