Compilateur les essais de Yannick

rem ============================================================================
rem         Biomorphes de Pickover
rem            Par Papydall
rem Ref : http://www.madteddy.com/biomorph.htm
rem ============================================================================
' Les biomorphes de C. Pickover vivent dans le plan complexe.
' Le programme qui engendre les biomorphes répète une même séquence de calculs.
' Le résultat obtenu après chaque séquence servant de donnée initiale à la
' séquence suivante.
' Cette itération s'effectue très simplement : on choisit d'abord un nombre
' complexe z0; on calcule f(z0) et l'on ajoute une constante complexe c;
' on obtient ainsi un nombre complexe z1. On calcule f(z1) auquel on ajoute
' à nouveau la constante c afin d'obtenir un nombre z2.
' En répétant ces calculs et l'addition de la constante c, on obtient
' successivement les nombres z3, z4, ...

REM ============================================================================
REM            Algorithme de création des biomorphes
rem ============================================================================
rem Pour chaque point du plan complexe (z = x + iy)
rem On lance une boucle de 10 itérations.
rem    on calcule z = f(z)
rem    si( |x| > 10 ou |y| > 10 ou |z| > 10 ) alors on quitte la boucle.
rem En fin de boucle :
rem Si ( |x| > 10 ou |y| > 10 )
rem Alors on marque un pixel dont la couleur dépend des valeurs de |x|,|y|,|z|.

rem ============================================================================

Init()
For i = 1 to 15
    Biomorph(i) : if scancode = 27 then end
next i
END
rem ============================================================================
SUB Init()

    dim Const_Reel, Const_Imag, i,h,w
    dim xmin, xmax, ymin, ymax, Max_Ligne, Max_Colonne, x, y, xx, yy
    full_space 0 : caption 0,"<ESC> pour arrêter"
    h = height(0) : w = width(0)-5 : color 0,50,100,0
    for i = 1 to 5
        form i : top i,35 : width i, w/5-5 : height i,h/3-20
        left i,width(i-1)*(i-1)+2*i
    next i

    for i = 6 to 10
        form i : top i,35+height(i-1) : width i, w/5-5 : height i,h/3-20
        left i,width(i-6)*(i-6)+2*(i-5)
    next i

    for i = 11 to 15
        form i : top i,35+2*height(i-1) : width i, w/5-5 : height i,h/3-20
        left i,width(i-11)*(i-11)+2*(i-10)
    next i

    for i = 1 to 15  : color i,200,200,200 : border_small i : next i
    
    Max_Ligne = height(1) - 5 : Max_Colonne = width(1) - 5

END_SUB
rem ============================================================================
SUB Biomorph(fonction)
    dim_local Const_Reel, Const_Imag
    dim_local ligne,colonne, n ,x0, y0
    2d_target_is fonction
    FOR ligne = 1 TO Max_Ligne
        FOR colonne = 1 TO Max_Colonne
            x0 = xmin + (xmax - xmin) * colonne / Max_Colonne
            y0 = 0-ymin - (ymax - ymin) * ligne / Max_Ligne
            x = x0 : y = y0
            FOR n = 1 TO 100
                Fonction(fonction)
                IF (ABS(x) > 10)  OR (ABS(y) > 10) OR ((x * x + y * y) > 100) then n = 100
            NEXT n
            IF ABS(x) > 10 AND ABS(y) > 10
               2d_pen_color 0,0,0
            else
               IF ABS(x) > 10 AND ABS(y) <= 10
                  2d_pen_color 255,0,0
               else
                  IF ABS(x) <= 10 AND ABS(y) > 10
                     2d_pen_color 0,255,0
                  else
                     2d_pen_color 255,255,0
                  end_if
              end_if
          end_if
          2d_point colonne,ligne
        NEXT colonne
    NEXT ligne
END_SUB
rem ============================================================================
SUB Fonction(f)

    select f
       case 1
' Fonction Z² = x² - y² + 2xyi
            Const_Reel = .4 : Const_Imag = .7
            xmax = 2.5 : xmin = 0-xmax : ymax = 2.5 : ymin = 0-ymax
            caption f,"Fonction Z² : Const  = .4 :  .7 "
            xx = x*x - y*y + Const_Reel : yy = 2*x*y + Const_Imag
            x = xx : y = yy
' ------------------------------------------------------------------------------
       case 2
' Fonction Z^3 = (x^3 - 3xy^2) + (3x²y - y^3)i
            Const_Reel = .5 : Const_Imag = 0
            xmax = 2.5125 : xmin = 0-xmax
            ymax = 1.88 : ymin = 0-ymax
            caption f,"Fonction Z^3 : Const = .5 :  0"
            xx = x * (x * x - 3 * y * y) + Const_Reel
            yy = y * (3 * x * x - y * y) + Const_Imag
            x = xx : y = yy
' ------------------------------------------------------------------------------
       case 3
' Fonction Z^4 = (x^4 -6x²y² + y^4) + 4xy(x²-y²)i
            Const_Reel = .5 : Const_Imag = 0
            xmax = 2.6729 : xmin = 0-xmax
            ymax = 2 : ymin = 0-ymax
            caption f,"Fonction Z^4 : Const = .5 :  0"
            xx = x*x*x*x - 6*x*x*y*y + y*y*y*y + Const_Reel
            yy = 4*x*y*(x*x-y*y) + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
       case 4
' Fonction Z^5 = x^5 - 10x^3y² + 5xy^4 + (5x^4y - 10x²y^3 + y^5)i
            Const_Reel = 0.75669 : Const_Imag = 0.75669
            xmax = 2.6729 : xmin = 0-xmax
            ymax = 2 : ymin = 0-ymax
            caption f,"Fonction Z^5 : Const = 0.75669 :  0.75669"
            xx = x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + Const_Reel
            yy = 5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
       case 5
' Fonction [conj(Z)]^5 = (x-yi)^5 = x^5 -10x^3y^2 + 5xy^4 - (5x^4y -10x^2y^3 + y^5)i
            Const_Reel = 0.75669 : Const_Imag = 0.75669
            xmax = 2.6729 : xmin = 0-xmax
            ymax = 2 : ymin = 0-ymax
            caption f,"Fonction [conj(Z)]^5 : Const = 0.75669 : 0.75669"
            xx = x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + Const_Reel
            yy = 0-(5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y) + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
       case 6
' Fonction [conj(Z)]^5 = (x-yi)^5 = x^5 -10x^3y^2 + 5xy^4 - (5x^4y -10x^2y^3 + y^5)i
            Const_Reel = -1.5888 : Const_Imag = -0.0123456
            xmax = 3.007 : xmin = 0-xmax
            ymax = 2.25 : ymin = 0-ymax
            caption f,"Fonction [conj(Z)]^5 : Const = -1.5888 : -0.0123456"
            xx = x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + Const_Reel
            yy = 0-(5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y) + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
       case 7
' Fonction cos(Z) = cos(x)hcos(y) - sin(x)hsin(y)i
            Const_Reel = 0 : Const_Imag = 0
            xmax = 29.402 : xmin = 0-xmax
            ymax = 22 : ymin = 0-ymax
            caption f,"Fonction cos(Z) : Const = 0 :  0"
            xx = cos(x) * hcos(y) : yy = 0 - sin(x) * hsin(y)
            x = xx : y = yy
' ------------------------------------------------------------------------------
       case 8
' Fonction cos(Z) = cos(x)hcos(y) - sin(x)hsin(y)i
            Const_Reel = 3.0123456 : Const_Imag = -3.0123456
            xmax = 4.6776 : xmin = 0-xmax
            ymax = 3.5 : ymin = 0-ymax
            caption f,"Fonction cos(Z) : Const = 3.0123456 :  -3.0123456"
            xx = cos(x) * hcos(y) + Const_Reel : yy = 0 - sin(x) * hsin(y) + Const_Imag
            x = xx : y = yy
' ------------------------------------------------------------------------------
       case 9
' Fonction sin(Z) = sin(x)hcos(y) + cos(x)hsin(y)i
            Const_Reel = 0 : Const_Imag = 0
            xmax = 29.402 : xmin = 0-xmax
            ymax = 22 : ymin = 0-ymax
            caption f,"Fonction sin(Z) : Const = 0 :  0"
            xx = sin(x) * hcos(y) : yy = cos(x) * hsin(y)
            x = xx : y = yy
' ------------------------------------------------------------------------------
       case 10
' Fonction sin(Z) = sin(x)hcos(y) + cos(x)hsin(y)i
            Const_Reel = -0.001 : Const_Imag = 0.001
            xmax = 4.6776 : xmin = 0-xmax
            ymax = 3.5 : ymin = 0-ymax
            caption f,"Fonction sin(Z) : Const = -0.001  :  0.001"
            xx = sin(x) * hcos(y) : yy = cos(x) * hsin(y)
            x = xx : y = yy
' ------------------------------------------------------------------------------
      case 11
' Fonction hcos(Z) = hcos(x+yi) = hcos(x)cos(y) + hsin(x)sin(y)i
            Const_Reel = .4 : Const_Imag = .7
            xmax = 2.5 : xmin = 0-xmax : ymax = 2.5 : ymin = 0-ymax
            caption f,"Fonction hcos(Z) : Const = .4 :  .7"
            xx = hcos(x)*cos(y) + Const_Reel
            yy = hsin(x)*sin(y) + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
      case 12
' Fonction hsin(Z) = hsin(x+yi) = hsin(x)cos(y) + hcos(x)sin(y)i
            Const_Reel = .5 : Const_Imag = 0
            xmax = 2.5125 : xmin = 0-xmax
            ymax = 1.88 : ymin = 0-ymax
            caption f,"Fonction hsin(Z) : Const = .5 :  0"
            xx = hsin(x)*cos(y) + Const_Reel
            yy = hcos(x)*sin(y) + Const_Imag
            x = xx : y = yy
' ------------------------------------------------------------------------------
      case 13
' Fonction hsin(Z) = hsin(x+yi) = hsin(x)cos(y) + hcos(x)sin(y)i
            Const_Reel = -.5 : Const_Imag = 0.123456
            xmax = 2.5125 : xmin = 0-xmax
            ymax = 1.88 : ymin = 0-ymax
            caption f,"Fonction hsin(Z) : Const = -.5 : 0.123456"
            xx = hsin(x)*cos(y) + Const_Reel
            yy = hcos(x)*sin(y) + Const_Imag
            x = xx : y = yy
' ------------------------------------------------------------------------------
      case 14
' Fonction hcos(Z) = hcos(x+yi) = hcos(x)cos(y) + hsin(x)sin(y)i
            Const_Reel = -.4 : Const_Imag = -.7
            xmax = 2.5 : xmin = 0-xmax : ymax = 2.5 : ymin = 0-ymax
            caption f,"Fonction hcos(Z) : Const = -.4 : -.7"
            xx = hcos(x)*cos(y) + Const_Reel
            yy = hsin(x)*sin(y) + Const_Imag
            x = xx : y = yy

' ------------------------------------------------------------------------------
      case 15
' Fonction cos(Z) = cos(x)hcos(y) - sin(x)hsin(y)i
            Const_Reel = -0.957 : Const_Imag = -1.524
            xmax = 4.6776 : xmin = 0-xmax
            ymax = 3.5 : ymin = 0-ymax
            caption f,"Fonction cos(Z) : Const = -0.957 :  -1.524"
            xx = cos(x) * hcos(y) : yy = sin(x) * hsin(y)
            x = xx : y = yy
' ------------------------------------------------------------------------------
            
    end_select
END_SUB
rem ============================================================================

hide 0
application_title "Essai_Compilateur"
caption 0,"Essai_Compilateur"
Variables()
Constantes()
Labels()
Init()
Gui()
show 0
end

sub Variables()
  ' Incrémentation des objets
  dim no%
  dim numclic%
end_sub

sub Constantes()
  dim_local i%
  ' Dossier racine
  dim Path$    : Path$=dir_current$
  if right$(Path$,1)="\" : Path$=left$(Path$,len(Path$)-1) : end_if
  Path$=Path$+"\"
  ' Fichiers
  dim ImgBtn$(3): for i%=1 to 3  : ImgBtn$(i%)=Path$+"btn"+str$(i%)+".bmp" : next i%
  ' Objets panoramic
  dim Mm%      : no%=no%+1 : Mm%=no%
  dim Sm%(10)  : for i%=1 to 10 : no%=no%+1 : Sm%(i%)=no% : next i%
  dim FileList% : no%=no%+1 : FileList%=no%
end_sub

sub Labels()
  label Clic
  label Change
  label DClic
end_sub

sub Init()
end_sub

sub Gui()
  dim_local i%,h%,w%,l%,capt$
 
  height 0,450
  width 0,600
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  color 0,0,128,0
     
  main_menu Mm%
  CreateSubMenu(1,4,Mm%)
  CreateSubMenu(5,8,Sm%(1))
  CreateSubMenu(9,10,Sm%(2))
 
  h%=height_client(0)
  w%=width_client(0)
 
  list FileList%
  height FileList%,h%-39
  width FileList%,w%-10
  top FileList%,5
  left FileList%,5
end_sub

Clic:
  numclic%=number_click
  if numclic = Sm%(8)
      terminate
  end_if
return

Change:
return

DClic:
return

sub Procedure()
end_sub

sub CreateSubMenu(d%,f%,p%)
  dim_local i%,capt$

  for i%=d% to f%
      sub_menu Sm%(i%)
      parent Sm%(i%),p%
      read capt$
      caption Sm%(i%),capt$
      if capt$<>"-"
        if i%<>1 and i%<>2
            on_click Sm%(i%),Clic
        end_if
      end_if
  next i%
end_sub

Data "Fichier","Rechercher","A Propos...","Aide","Importer","Enregistrer","-","Quitter","Par code couleur","Par nom de couleur"

hide 0
application_title "Essai_Compilateur"
caption 0,"Essai_Compilateur"
Variables()
Constantes()
Labels()
Init()
Gui()
show 0
end

sub Variables()
  ' Incrémentation des objets
  dim no%
  dim numclic%
end_sub

sub Constantes()
  dim_local i%
  ' Dossier racine
  dim Path$    : Path$=dir_current$
  if right$(Path$,1)="\" : Path$=left$(Path$,len(Path$)-1) : end_if
  Path$=Path$+"\"
  ' Fichiers
  dim ImgBtn$(3): for i%=1 to 3  : ImgBtn$(i%)=Path$+"btn"+str$(i%)+".bmp" : next i%
  ' Objets panoramic
  dim Mm%      : no%=no%+1 : Mm%=no%
  dim Sm%(10)  : for i%=1 to 10 : no%=no%+1 : Sm%(i%)=no% : next i%
  dim FileList% : no%=no%+1 : FileList%=no%
end_sub

sub Labels()
  label Clic
  label Change
  label DClic
end_sub

sub Init()
end_sub

sub Gui()
  dim_local i%,h%,w%,l%,capt$
  
  height 0,450
  width 0,600
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  color 0,0,128,0
      
  main_menu Mm%
  CreateSubMenu(1,4,Mm%)
  CreateSubMenu(5,8,Sm%(1))
  CreateSubMenu(9,10,Sm%(2))
  
  h%=height_client(0)
  w%=width_client(0)
  
  list FileList%
  height FileList%,h%-39
  width FileList%,w%-10
  top FileList%,5
  left FileList%,5
end_sub

Clic:
  numclic%=number_click
  if numclic = Sm%(8)
     Quitter()  : ' < ----------- Papydall
  end_if
return

Change:
return

DClic:
return

sub Procedure()
end_sub

sub CreateSubMenu(d%,f%,p%)
  dim_local i%,capt$

  for i%=d% to f%
      sub_menu Sm%(i%)
      parent Sm%(i%),p%
      read capt$
      caption Sm%(i%),capt$
      if capt$<>"-"
        if i%<>1 and i%<>2
            on_click Sm%(i%),Clic
        end_if
      end_if
  next i%
end_sub
rem ============================================================================
'------------------------------------------------------------------- Papydall
'  Une autre façon de terminer une application
'  Affiche un message et termine l’application quand on ferme la boite
SUB Quitter()
    dim_local ret%  
    dll_on "kernel32"
    ret% = dll_call2("FatalAppExitA",0,0)
    dll_off
END_SUB
rem ============================================================================

Data "Fichier","Rechercher","A Propos...","Aide","Importer","Enregistrer","-","Quitter","Par code couleur","Par nom de couleur"