Suiv.: Création de quelques figures géométriques Sup.: 9 Exemples Préc.: 9 Exemples Index Table des matières

Création de quelques figures géométriques 2D

Le sous-programme suivant utilise uniquement les instructions graphiques 2D.

       PROGRAM IMAG2D
C  --- TRACE DE FIGURES 
       REAL PI
       PARAMETER (PI=3.14152)
       INTEGER ITERM,PAROUT(10), PARIN(10) 
       CHARACTER*80 STRING
       REAL PAS,R1,R2,A,B,ALPHA,X,Y,Z,XMIN,XMAX,YMIN,YMAX
       REAL CX,CY,PX,XX,YY,DIMFEN,CX1,CX2,TAILLE,PY1,PY2,O,R,CY1,CY2
       LOGICAL BID
       INTEGER IBID,NBCIN
       CHARACTER*1 REP
C  --- DEFINITION INTERACTIVE DU TERMINAL
       ITERM = 0
       CALL DEFDEV(ITERM, PAROUT, PARIN,STRING)
C  --- DIMENSIONS DE L'ECRAN
       CALL SZSCRN(XMIN, XMAX, YMIN, YMAX)  
C  --- CALCUL D'UNE FENETRE CARRE POUR LE DESSIN
       DIMFEN = MIN(XMAX-XMIN, YMAX-YMIN) / 2. 
       CX = (XMIN + XMAX) / 2.
       CY = (YMIN + YMAX) / 2. 
       CX1 = CX - DIMFEN
       CX2 = CX + DIMFEN
       CY1 = CY - DIMFEN
       CY2 = CY + DIMFEN
       CALL FENTR2(XMIN, XMAX, YMIN, YMAX)
       CALL MASQU2(XMIN, XMAX, YMIN, YMAX)
C  --- TAILLE DES TEXTES
       TAILLE = MIN((YMAX-YMIN)/10. , 0.5)
       CALL DRW3TX(TAILLE, 0., O)
C  --- POSITION DES TEXTES 
       PX = XMIN + (XMAX-XMIN) / 20.
       PY1 = YMAX - 2.*TAILLE
       PY2 = YMIN + 2.*TAILLE
C  --- ENTREE DU PAS 
       PAS=0.5
   2   CONTINUE
       CALL CLEAN
C  --- COULEUR COURANTE = BLANC
       CALL SETCOL(1., 1., 1.)
       CALL GETNUM('DONNEZ LE PAS DU LA SPIRALE ENTRE 0. ET 1. : ',
     + PX, PY1, PAS, IBID, BID, 1, 1, 0, 0, 0.001, 1.)
C  --- MASQUE DEPENDANT DU TRACE 
       CALL FENTR2(CX1, CX2, CY1, CY2)
       CALL MASQU2(-100., 100., -100., 100.) 
C  --- POSITION INITIALE DU CURSEUR
       CALL MOV2TO(0., 0.) 
C  --- DESSIN DE L'OBJET 
       R = 0. 
       DO 1 A = 0. , 8.*PI ,2.*PI/200
          R = R + PAS/10.
          X = R * COS(A)
          Y = R * SIN(A)
          CALL LIN2TO(X, Y)
    1  CONTINUE 
C  --- FIN DU DESSIN 
       CALL FENTR2(XMIN, XMAX, YMIN, YMAX)
       CALL MASQU2(XMIN, XMAX, YMIN, YMAX)
       CALL SETCOL(1., 1., 1.)
       XX = PX
       YY = PY2 
       CALL GETEXT('> CONTINUER (Y/N) ? ', XX, YY, 1, REP, NBCIN)
       IF (REP.EQ.'O'.OR.REP.EQ.'Y') THEN 
C         --- ON CONTINUE
          GOTO 2
       ELSE
C         --- ON NE CONTINUE PAS
          CALL ENDDEV(ITERM)
       ENDIF
       END