Dessine-moi une étoile ... ou un super-cercle

rem ============================================================================
rem                              Etoiles
rem ============================================================================

Init()
Que_Le_Spectacle_Commence()
 
end
rem ============================================================================
SUB Init()
    dim CX,CY           : ' centre de l'étoile
    dim Rayon           : ' rayon de l'étoile  
    dim Nbranche        : ' nombre de branches de l'étoile
    dim resX,resY       : ' Résolution de l'écran
    dim nbr : nbr = 500 : ' Nombre d'étoiles
    dim etoile(nbr,2)   : ' Tableau des coordonnées des centres des étoiles
    dim r,g,b           : ' Composantes de la couleur du tracé
    full_space 0 : picture 10 : full_space 10
    2d_target_is 10 : color 10, 255, 255, 196 : ' Jaune pale
    resX = width_client(10) : resY = height_client(10)
    alpha 20 : font_color 20,0,0,255 : font_size 20,50 : font_name 20,"arial"
    top 20,200 : left 20,400 : caption 20,"That's all folks !" : hide 20
END_SUB
rem ============================================================================
SUB CalculerEoile(CX, CY, Rayon, Nbranche , r, g, b)
    dim_local i, prof, CentreX, CentreY, Angle
    Prof = int(Rayon + rnd(Rayon + 120)) : ' prodondeur des branches de l'étoile aléa entre Rayon et Rayon + 120
    for i = 0 to (2 * Nbranche - 1)
        Angle = i * PI / Nbranche        : ' angle au sommet
        if Odd(i) > 0                    : ' parité des sommets
           CentreX = CX + int(Rayon * (Rayon - Prof) * cos(Angle) / Rayon) : ' introduction du paramètre Prof
           CentreY = CY + int(Rayon * (Rayon - Prof) * sin(Angle) / Rayon) : ' pour la prodondeur des branches
        else
           CentreX = CX + int(cos(Angle) * Rayon)
           CentreY = CY + int(sin(Angle) * Rayon)
        end_if
        etoile(i,1) = CentreX : etoile(i,2) = CentreY : ' stockage de la série de points
    next i
    DessinerEtoile(Nbranche)
END_SUB
rem ============================================================================
SUB DessinerEtoile(Nbranche)
    dim_local i
    2d_pen_color r,g,b : 2d_poly_from etoile(1,1) , etoile(1,2)
    for i = 0 to 2*Nbranche-1 : 2d_poly_to etoile(i,1) , etoile(i,2) : next i
    2d_poly_to etoile(0,1) , etoile(0,2)
    ' 2d_flood cx,cy, r,g,b
END_SUB
rem ============================================================================
SUB Que_Le_Spectacle_Commence()
    dim_local n
    n = 0
    2d_pen_width 2
    repeat
        n = n + 1
        Cx = int(rnd(ResX)) : CY = int(rnd(ResY)) : Rayon = int(5+rnd(100))
        Nbranche = int(5+rnd(21)) : ' Nombre des branches de l'étoile de 5 à 25
        r = int(rnd(256)) : g = int(rnd(256)) : b = int(rnd(256)) : ' Couleur aléatoire
        CalculerEoile(CX, CY, Rayon, Nbranche , r, g, b)
        display : pause 200  
        if mod(n,51) = 0 : ' effacement pour aérer la toile
           pause 1000
           color 10, 255, 255, 196 : ' couleur du fond jaune pale
        end_if
        caption 0, str$(n) + "/ " + str$(nbr) + "... <ESC> pour arrêter ..."        
     until (n = nbr) or scancode = 27
     show 20
END_SUB
rem ============================================================================

rem ============================================================================
rem                       Le super-cercle
rem ============================================================================
rem             Equation paramétrique de la super-ellipse
rem         _______________________________________________
rem        |                                               |
rem        |  x = power(abs(cos(t)),2/n) * a * sgn(cos(t)) |
rem        |  y = power(abs(sin(t)),2/n) * b * sgn(sin(t)) |
rem        |  -------------------------------------------- |
rem        |  n, a, b : nombres positifs                   |
rem        |  t : angle en radians variant de 0 à 2*pi     |
rem        |  Si b = a, on a affaire à un super-cercle     |
rem        |_______________________________________________|
rem
rem
rem ============================================================================

font_bold 0 : font_color 0,0,0,255
print_locate 5,10
print "Ce ne sont pas des carrés. Ce sont des super-cercles, même si ça ressemble beaucoup à des carrés"

Super_cercle(020,005)
Super_cercle(050,010)
Super_cercle(100,020)
Super_cercle(150,050)
Super_Cercle(200,500)

end
rem ============================================================================
' Paramètres :
' a : demi-diamètre
' n : détermine la nature du super-cercle(hypo ou hyper-cercle) et sa forme
' Plus la valeur de n augmente, plus la courbe obtenue tend vers un cercle.

SUB Super_cercle(a,n)
    dim_local p,t,x,y,xc,yc,w,h
    p = pi/180
    w = width(0) : h = height(0) : xc = w/2 : yc = h/2
    xc = width_client(0)/2 : yc = height_client(0)/2+10
     2d_poly_from xc + a,yc
'    2d_pen_width 2    
    for t = 0 to 2*pi + p step p
        x = power(abs(cos(t)),2/n) * a * sgn(cos(t))
        y = power(abs(sin(t)),2/n) * a * sgn(sin(t))
        2d_poly_to xc+x,yc+y
    next t
    2d_flood xc-a+10,yc,255,255,0
END_SUB
rem ============================================================================

rem ============================================================================
rem    Super_Ellipse ou rectangle à coins arrondies
rem ============================================================================
dim scr_x,scr_y, mx,my
scr_x = width_client(0) : scr_y = height_client(0) : mx = scr_x/2 : my = scr_y/2
picture 10 : full_space 10 : 2d_target_is 10
Super_Ellipse(200,150,10)
end
rem ============================================================================
SUB Super_Ellipse(a,b,n)
    dim_local y(a),x
    y(0) = b : y(a) = 0
    2d_pen_color 255,0,0 : 2d_poly_from mx,my-y(0)
    for x = 1 to a-1
        y(x) = Int(Exp(Log(1 - power((x / a) , n)) / n ) * b )
        2d_poly_to mx + x, my - y(x) : display
    Next x
    For x = a To 0 Step -1 : 2d_poly_to mx + x, my + y(x) : Next x
    For x = 0 To a : 2d_poly_to mx - x, my + y(x) : Next x
    For x = a To 0 Step -1 : 2d_poly_to mx - x, my - y(x) : Next x
    2d_flood mx,my,255,0,0
END_SUB
rem ============================================================================

rem ' Feu d'artifice - Version 2
dim c1 , c2 , c3 , f , g , h , i , j , k , x , y
k=1 : f=1
height 0,500
caption 0,"FEU D'ARTIFICE - Cliquez sur le ciel pour arrêter"
color 0,0,0,0 : display
sound 1
for g=1 to 200
 c1=rnd(155)+100 : c2=rnd(155)+100 : c3=rnd(155)+100
 h=int(rnd(4))+1 : y=int(rnd(300))+50 : k=0-k
 for i=500 to y step -1
  2d_pen_color c1,c2,c3
  2d_point 300+10*log(i)*h*k,i
  for j=1 to 500 : next j : ' on peut changer le 500, ça dépend de la vitesse des ordinateurs
  2d_point 300+10*log(i)*h*k,i
 next i
 for j=1 to 3000
  2d_pen_color 0,0,0
  i=int(rnd(500-y))+y
  2d_point 300+10*log(i)*h*k,i
 next j
 x=300+10*log(y)*h*k
 2d_pen_color c1,c2,c3
 for i=1 to 100
  for j=1 to int(rnd(4))+1
  k=0-k
  next j
  for j=1 to int(rnd(4))+1
  f=0-f
  next j
  if g/h=int(g/h)
  2d_pen_color rnd(155)+100,rnd(155)+100,rnd(155)+100
  end_if
  2d_line x,y,x+int(rnd(150))*k,y+int(rnd(150))*f
 next i
 i=int(rnd(3))+1
 if file_exists("Explo-"+str$(i)+".wav")=1
  file_load 1,"Explo-"+str$(i)+".wav"
  play 1
 end_if
 wait 500
 cls
 if clicked(0)=1 then exit_for
next g
terminate

rem ' Feu d'artifice
dim c1 , c2 , c3 , f , g , h , i , j , k , x , y
k=1 : f=1
height 0,500
caption 0,"FEU D'ARTIFICE - Cliquez sur le ciel pour arrêter"
color 0,0,0,0 : display
sound 1
for g=1 to 200
 c1=rnd(155)+100 : c2=rnd(155)+100 : c3=rnd(155)+100
 h=int(rnd(4))+1 : y=int(rnd(300))+50 : k=0-k
 for i=500 to y step -1
  2d_pen_color c1,c2,c3
  2d_point 300+10*log(i)*h*k,i
  for j=1 to 500 : next j : ' on peut changer le 500, ça dépend de la vitesse des ordinateurs
  2d_point 300+10*log(i)*h*k,i
 next i
 for j=1 to 3000
  2d_pen_color 0,0,0
  i=int(rnd(500-y))+y
  2d_point 300+10*log(i)*h*k,i
 next j
 x=300+10*log(y)*h*k
 2d_pen_color c1,c2,c3
 for i=1 to 100
  for j=1 to int(rnd(4))+1
  k=0-k
  next j
  for j=1 to int(rnd(4))+1
  f=0-f
  next j
  if g/h=int(g/h)
  2d_pen_color rnd(155)+100,rnd(155)+100,rnd(155)+100
  end_if
  2d_line x,y,x+int(rnd(150))*k,y+int(rnd(150))*f
 next i
 i=int(rnd(3))+1
 if file_exists("Explo-"+str$(i)+".wav")=1
  file_load 1,"Explo-"+str$(i)+".wav"
  play 1
 end_if
 wait 500
 cls
 if clicked(0)=1 then exit_for
next g
for g=1 to 12
 x=int(rnd(500))+1 : y=int(rnd(400))+1
 for i=1 to 100
  for j=1 to int(rnd(4))+1
  k=0-k
  next j
  for j=1 to int(rnd(4))+1
  f=0-f
  next j
  2d_pen_color rnd(155)+100,rnd(155)+100,rnd(155)+100
  2d_line x,y,x+int(rnd(150))*k,y+int(rnd(150))*f
 next i
next g
if file_exists("Explo-3.wav")=1
 file_load 1,"Explo-3.wav"
 play 1
 wait 2500
end_if
terminate