Je teste la 3D

 scene3d 1
3d_line 1,0,0,0 : 3d_line 1,1,1,0

' *****************************************************************************
'                    TEST_3D.BAS
'                    PAR PAPYDALL
' ******************************************************************************
Init() : ' Demarrage du programme
Triangle_3D(1, -1,0,0, 1,1,0, 0,0,0, 10) : ' Dessiner un triangle en 3D
Rectangle_3D(2, 1.2,0,0, 1.9,1,0, 100)  : ' Dessiner un rectangle en 3D
Quadrilatere_3D(3, 0,-2,0, 0,-1.5,0, 1,-1,2, 1,-3,-1, 150): ' dessiner un quadrilatère gauche
Ellipse_3D(4,-1.5,1,1.5,.5,60) : ' dessiner une ellipse
end
' ******************************************************************************
SUB Init()
    label clic
    dim couleur_hex$(215) : ' Table des 216 couleurs en HEXADECIMAL
    dim R,G,B : ' Composantes couleur
    dim flag  : ' Pour arrêter le mouvement
' Mettre en place la scène
    scene3d 1 : top 1,20 : left 1,30 : width 1,500 : height 1,400
' Mettre en place les boutons des événements
    button 10 : top 10,422 : left 10,100 : caption 10,"Move" : on_click 10,clic
    button 11 : top 11,422 : left 11,200 : caption 11,"Stop Move" : inactive 11 :on_click 11,clic
    button 12 : top 12,422 : left 12,300 : caption 12,"Exit" : on_click 12,clic
' Initialiser les couleurs
    Init_Couleur()
END_SUB
' ******************************************************************************
' Initialisation des 216 couleurs ( de 0 à 215)
SUB Init_Couleur()
  dim_local hexa$(5),coulhexa$,i,j,k,n
  hexa$(0) = "00" : hexa$(1) = "33" : hexa$(2) = "66" : hexa$(3) = "99"
  hexa$(4) = "CC" : hexa$(5) = "FF" : n = 0
  for i = 0 to 5
      for j = 0 to 5
          for k = 0 to 5
              coulhexa$ = hexa$(i) + hexa$(j) + hexa$(k)
            couleur_Hex$(n) = coulhexa$ : n = n + 1
          next k
      next j
  next i
END_SUB
' ******************************************************************************
' Traitement des événements
clic:
  if clicked(10) > 0 then Move()
  if clicked(11) > 0 then stop_Move()
  if clicked(12) > 0 then terminate
return
' ******************************************************************************
' Animation des objets
SUB Move()
    dim_local a
    flag = 0 : active 11 : inactive 10
    while flag = 0
      for a = 0 to 360
        3d_x_rotate 1,a : 3d_y_rotate 1,a :  3d_z_rotate 1,a
        3d_y_rotate 2,a : 3d_z_rotate 2,a
        3d_z_rotate 3,a : 3d_y_rotate 3,a
        3d_z_rotate 4,a : 3d_x_rotate 4,a : 3d_y_rotate 4,a
        wait 10
        if flag > 0 then exit_sub
      next a
    end_while
END_SUB
' ******************************************************************************
' Arrêter l'animation
SUB Stop_Move()
    flag = 1 : active 10 : inactive 11
END_SUB
' ******************************************************************************
' Détermination des composantes RGB de l'objet N° n
SUB RGB(n,c)
    dim_local c$
    c$ = couleur_hex$(c)
    r = hex(mid$(c$,1,2)) : g = hex(mid$(c$,3,2)) : b = hex(mid$(c$,5,2))
END_SUB
   
' ******************************************************************************
' Définition d'un triangle en 3D ayant pour N° N et pour couleur C
' Nombre de sommets : 3
SUB Triangle_3D(N,x1,y1,z1,x2,y2,z2,x3,y3,z3,C)
    RGB(N,C)
    3d_line n,x1,y1,z1 : 3d_line n,x2,y2,z2 : 3d_line n,x3,y3,z3
    3d_line n,x1,y1,z1 : 3d_color n,r,g,b
END_SUB
' ******************************************************************************
' Définition d'un rectangle en 3D ayant pour N° N et pour couleur C
' x1,y1,z1 : sommet supérieur gauche
' x2,y2,z2 : sommet inférieur droit
' Les 2 autres sommets se déduisent facilement
SUB Rectangle_3D(N,x1,y1,z1,x2,y2,z2,C)
    RGB(N,C)
    3d_line n,x1,y1,z1 : 3d_line n,x2,y1,z1 : 3d_line n,x2,y2,z2
    3d_line n,x1,y2,z1 : 3d_line n,x1,y1,z1 : 3d_color n,r,g,b
END_SUB
' ******************************************************************************
' Définition d'un quadrilatère quelconque en 3D ayant pour N° N et pour couleur C
' Les paramètres des 4 sommets doivent être fournis explicitement
SUB Quadrilatere_3D(N,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,C)
    RGB(N,C)
    3d_line n,x1,y1,z1 : 3d_line n,x2,y2,z2 : 3d_line n,x3,y3,z3
    3d_line n,x4,y4,z4 : 3d_line n,x1,y1,z1 : 3d_color n,r,g,b
END_SUB
' ******************************************************************************
' Définition d'une ellipse en 3D ayant pour N° n et pour couleur C
' x,y,0 : centre de l'ellipse
' r1 et r2 sont respectivement le rayon horizontal et le rayon vertical de l'ellipse
' Si r1 = r2 alors on a affaire à un cercle
SUB Ellipse_3D(n,x,y,r1,r2,c)
    dim_local a ,xp,yp,pi,rad
    pi = 4*atn(1) : rad = pi/180
    RGB(N,C)
    for a = 0 to 360
        xp = x + r1 * cos(a*rad) : yp = y + r2 * sin( a*rad)
        3d_line n,xp,yp,0
    next a
    3d_color n,r,g,b
END_SUB
' ******************************************************************************

' ******************************************************************************
'                GEODESIQUES.BAS
'                PAR PAPYDALL
'
' Adaptation d'un programme paru dans SVM n°48 - Mars 1988
' ------------------------------------------------------------------------------
' Un mobile lancé sur une surface plane sur laquelle il glisse sans frottement,
' se déplace en ligne droite à vitesse constante.
' Si la surface n'est pas plane, la trajectoire décrite est une courbe
' particulière appelée "géodésique" dessinée sur cette surface.
' Le programme suivant permet de tracer comme surface un tore, calculer ses
' propriétés de courbure et en déduire les géodésiques correspondantes.
' Une surface peut être définie comme une fonction vectorielle de 2 paramètres,
' F(u,v), décomposables en 3 fonctions coordonnées : x(u,v), y(u,v), z(u,v).
' Lorsque u et v varient, le point de coordonnées (x,y,z) décrit la surface
' considérée.
' Pour définir les géodésiques, on considère la trajectoire d'un mobile assujetti
' à glisser sur la surface sans frottement. L'unique force à laquelle il est
' soumis est celle qui le maintient sur la surface : il n'est ni accéléré, ni
' freiné tangentiellement : la force (et donc l'accélération) qui s'exerce sur
' lui est en permanence perpendiculaire à la surface. Cette propriété est
' suffisante pour calculer les géodésiques.
' Les calculs sont assez laborieux : calcul d'intégration, de dérivés premières
' et secondes par la méthode d'Euler, la résolution d'un système d'équations par
' la methode de Cramer etc...
' ------------------------------------------------------------------------------
' REMARQUE :
' Les géodésiques sont dessinées en vert et leurs parties cachées en blanc.
' Au bout d'un grand nombre d'itérations, les erreurs de calcul s'accumulent
' et, (conséquence) on observe le resserement des spires.
' Les valeurs suggérées des paramètres de saisie ne sont là que comme exemple;
' mais rien ne vous empêche d'essayer d'autres valeurs.

' ******************************************************************************

 Declaration() : demarrer() : info()
 caption 0,"Terminé"
end
' ******************************************************************************
SUB Declaration()
' Dimension de l'écran
    dim Lx,Ly  : Lx = 600 : Ly = 400
' Rapport de projection = sqr(3)/2
    dim pi : pi = 4*atn(1)
    dim PP : PP = cos(pi/6)
' Valeurs extrêmes des paramètres U et V
    dim UI,UM,VI,VM : UI = 0 : UM = 2*pi : VI = 0 : VM = 2*pi
   
    dim DU,DV : DU = (UM - UI)/1000 : DV = (VM - VI)/1000
' Variables globales de travail
    dim u,v,xx,yy,xp,yp,tu,tv,ux,uy,uz,mv,gu,gv,dt,n ,vx,vy,vz
    dim x,y,z,us,vs,x0,y0,z0,x1,y1,z1,ex,ey,ez,fx,fy,fz,gx,gy,gz,u0,v0
    dim u1,u2,u3,v1,v2,v3,uu,uv,vv, ue,uf,ug,ve,vf, vg,cu,cv
    dim ua,va,tua,tva
    caption 0,"GEODESIQUES PAR PAPYDALL  <ESC> pour arrêter"
    color 0,0,0,0  : hide 0

END_SUB
' ******************************************************************************
SUB Info()
    alpha 1 : top 1,10 : left 1,10 : font_color 1,255,255,0 : font_bold 1
    alpha 2 : top 2,30 : left 2,10 : font_color 2,0,255,0  : font_bold 2
    alpha 3 : top 3,50 : left 3,10 : font_color 3,255,255,255  : font_bold 3
    caption 1,"SURFACE F(U,V) : TORE" : caption 2,"PARTIE VISIBLE DE LA GEODESIQUE"
    caption 3,"PARTIE INVISIBLE DE LA GEODESIQUE"
   
    alpha 4 : top 4,70  : left 4,10 : font_color 4,0,255,255 : font_bold 4
    alpha 5 : top 5,90  : left 5,10 : font_color 5,0,255,255 : font_bold 5
    alpha 6 : top 6,110 : left 6,10 : font_color 6,0,255,255 : font_bold 6
    alpha 7 : top 7,130 : left 7,10 : font_color 7,0,255,255 : font_bold 7
   
    caption 4,"U initial = "  + str$(ua)  : caption 5,"V initial = "  + str$(va)
    caption 6,"Vitesse initiale TU = " + str$(tua)
    caption 7,"Vitesse initiale TV = " + str$(tva)
   
END_SUB
' ******************************************************************************
' On se met en route
SUB Demarrer()
    dim_local rep$,i
    repeat
      repeat
        rep$ = message_input$("Entrez le Paramètre U initial","U entre "+str$(ui)+" et "+str$(um),"1.5")
      until numeric(rep$) > 0
      u = val(rep$) : ua = u
    until (u >= ui) and (u <= um)
   
    repeat
      repeat
        rep$ = message_input$("entrez le Paramètre V initial","V entre "+str$(vi)+" et "+str$(vm),"3")
      until numeric(rep$) > 0
      v = val(rep$) : va = v
    until (v >= vi) and (v <= vm)
   
    Fonction_Surface() : Fonction_Projection()
    xx = xp : yy = yp
   
    repeat
      repeat
        rep$ = message_input$("Entrez la Vitesse initiale TU > 0","TU =","1")
      until numeric(rep$) > 0
      tu = val(rep$) : tua = tu
    until tu > 0

    repeat
      repeat
        rep$ = message_input$("Entrez la Vitesse initiale TV > 0","TV =","2")
      until numeric(rep$) > 0
      tv = val(rep$) : tva = tv
    until tv > 0
    show 0
    Calculer_Vecteurs_Tangeants()
    mv = sqr(ux*ux + uy*uy + uz*uz) * tu + sqr(vx*vx + vy*vy +vz*vz) * tv
    dt = .5/mv : ' Pour augmenter la précision, on peut diminuer l'intervalle de temps DT
    Tracer_Surface()
   
    for i = 1 to 5000
        Calculer_Vecteurs_Derivees_Secondes() : Calculer_Coefficients_Systeme()
        u = u + dt * tu : v = v + dt *tv
        tu = tu + dt * gu : tv = tv + dt * gv
        Fonction_Surface() : Fonction_Projection() : Calculer_Vecteurs_Tangeants()
        n = (uy * vz - uz * vy) + (uz * vx - ux * vz) + (ux * vy - uy * vx)

        if n < 0
          2d_pen_color 0,255,0 : 2d_point xp,yp
        else
          2d_pen_color 255,255,255 : 2d_line xx,yy,xp,yp
        end_if
        xx = xp : yy = yp
        if scancode = 27 then terminate
    next i
END_SUB
' ******************************************************************************
' Fonction définissant la surface(x,y,z) = f(u,v)
' Il s'agit ici d'un tore
SUB Fonction_Surface()
    dim_local r1,r2
    r1 = 80 : r2 = 40 : ' Rayons du tore
    x = cos(u) * (r1 + r2 * cos(v))
    y = sin(u) * (r1 + r2 * cos(v))
    z = r2 * sin(v)
END_SUB
' ******************************************************************************
' Fonction calculant la projection xp,yp sur l'écran d'un point de coordonnées(x,y,z)
SUB Fonction_Projection()
    xp = Lx/2 + (y-x)*pp : yp = (Ly + x + y)/2 - z
END_SUB
' ******************************************************************************
' Procédure calculant les vecteurs tangeants
' Dérivées premières dM/dU et dM/dV de coordonnées (ux,uy,uz) et ( vx,vy,vz)
SUB Calculer_Vecteurs_Tangeants()
    us = u : vs = v : Fonction_Surface() : x0 = x : y0 = y : z0 = z
    u = u + du : Fonction_Surface() : x1 = x : y1 = y : z1 = z
    u = us : v = v + dv : Fonction_Surface()
    ux = (x1 - x0)/du : vx = (x - x0)/dv
    uy = (y1 - y0)/du : vy = (y - y0)/dv
    uz = (z1 - z0)/du : vz = (z - z0)/du
    v = vs
END_SUB
' ******************************************************************************
' Procédure calculant les vecteurs derivées secondes
' E = d²M/U², F = d²M/dUdV, G = d²M/dV²
SUB Calculer_Vecteurs_Derivees_Secondes()
    u0 = u : v0 = v :  Calculer_Vecteurs_Tangeants()
    u1 = ux : u2 = uy : u3 = uz
    v1 = vx : v2 = vy : v3 = vz
    u = u + du : Calculer_Vecteurs_Tangeants()
    EX = (ux - u1)/du : FX = (vx - v1)/du
    EY = (uy - u2)/du : FY = (vy - v2)/du
    EZ = (uz - u3)/du : FZ = (vz - v3)/du
    u = u0 : v = v0 +dv : Calculer_Vecteurs_Tangeants()
    GX = (vx - v1)/dv : GY = (vy - v2)/dv : GZ = (vz - v3)/dv
    v = v0 : Calculer_Vecteurs_Tangeants()
END_SUB
' ******************************************************************************
' Procédure calculant les coefficients du système
SUB Calculer_Coefficients_Systeme()
    uu = ux * ux + uy * uy + uz * uz
    uv = ux * vx + uy * vy + uz * vz
    vv = vx * vx + vy * vy + vz * vz
    ue = ux * ex + uv * ey + uz * ez
    uf = ux * fx + uy * fy + uz * fz
    ug = ux * gx + uy * gy + uz * gz
    ve = vx * ex + vy * ey + vz * ez
    vf = vx * fx + vy * fy + vz * fz
    vg = vx * gx + vy * gy + vz * gz
    cu = 0-(tu * tu * ue + 2 * tu * tv * uf + tv * tv * ug)
    cv = 0-(tu * tu * ve + 2 * tu * tv * vf + tv * tv * vg)
    gu = (cu * vv - cv * uv)/(uu * vv - uv * uv)
    gv = (uu * cv - uv * cu)/(uu * vv - uv * uv)
END_SUB
' ******************************************************************************
' Procédure de tracé de la surface
SUB Tracer_Surface()
    dim_local ku,kv
    uu = u : vv = v
    ku = 160 : kv = 80 : ' Pour modifier la densité des points, modifier ces valeurs
    for u = ui to um step (um - ui)/ku
        for v = vi to vm step (vm -vi)/kv
            Calculer_Vecteurs_Tangeants()
            n = (uy * vz - uz * vy)+(uz * vx - ux * vz)+(ux * vy - uy * vx)
            if n >= 0
              Fonction_Surface() : Fonction_Projection()
                2d_pen_color 255,255,0 : 2d_point xp,yp
            end_if
            if scancode = 27 then terminate
        next v
    next u
    u = uu : v = vv
END_SUB
' ******************************************************************************