; Référence : http://khayyam.developpez.com/articles/algo/perlin/
; Author : comtois
; Date : 17/03/2007
; Subject : Algorithme de Perlin


#Taille = 256
CreateImage(0, #taille, #Taille)
OpenWindow(0, 0, 0, #Taille, #Taille, "Perlin")
If CreateGadgetList(WindowID(0))
  ImageGadget(0, 0, 0, #taille, #taille, ImageID(0))
EndIf

Structure s_Colonne
  y.l[#Taille]
EndStructure

Structure s_Calque
  x.s_Colonne[#Taille]
  persistance.f
EndStructure

Declare generer_calque(frequence, octaves, persistance.f, liss, *c.s_Calque)
Declare interpolate(y1, y2, n, delta)
Declare valeur_interpolee(i, j, frequence, *r.s_Calque)
Declare enregistrer_bmp(*c.s_Calque, filename.s)

Procedure init_calque(p.f)
    *s.s_Calque = AllocateMemory(SizeOf(s_calque))
    If *s = 0
        MessageRequester("Oups!", "erreur d'alloc", #PB_MessageRequester_Ok)
        ProcedureReturn #Null
    EndIf
    *s\persistance = p
    ProcedureReturn *s
EndProcedure

Procedure generer_calque(frequence, octaves, persistance.f, liss, *c.s_Calque)
    ; itératif
    Define i, j, n, f_courante
    Define x, y, k, l
    Define a
    Define.f pas, sum_persistances, persistance_courante
   
    pas = #taille/frequence
    persistance_courante = persistance
   
    ; calque aléatoire
    Define.s_Calque *random
    *random = init_calque(1)
    For i = 0 To #taille - 1
        For j = 0 To #taille - 1
            *random\x[i]\y[j]= Random(255)
        Next j
    Next i
    enregistrer_bmp(*random, "alea.bmp")
    ; calques de travail
    Dim *mes_calques.s_Calque(octaves - 1)
    For  i = 0 To octaves - 1
        *mes_calques(i)= init_calque(persistance_courante)
        persistance_courante * persistance
    Next i

    f_courante = frequence

    ; remplissage de calque
    For n = 0 To octaves - 1
        For i = 0 To #taille - 1
            For j = 0 To #taille - 1
                a = valeur_interpolee(i, j, f_courante, *random)
                *mes_calques(n)\x[i]\y[j]= a
            Next j
        Next i
        f_courante * frequence
    Next n

    sum_persistances = 0
    For i = 0 To octaves - 1
        sum_persistances + *mes_calques(i)\persistance
    Next i
    ; ajout des calques successifs
    For i = 0 To #taille - 1
        For j = 0 To #taille - 1
            For n = 0 To octaves - 1
                *c\x[i]\y[j] + *mes_calques(n)\x[i]\y[j] * *mes_calques(n)\persistance
            Next n
            ; normalisation
            *c\x[i]\y[j] = *c\x[i]\y[j] / sum_persistances
        Next j
    Next i

    ; lissage
    Define *lissage.s_Calque
    *lissage = init_calque(0)
    For x = 0 To #taille - 1
        For y = 0 To #taille - 1
            a = 0
            n = 0
            For k = x - liss To x + liss
                For l = y - liss To y + liss
                    If((k>= 0) And(k<#taille) And(l>= 0) And(l<#taille))
                        n + 1
                        a + *c\x[k]\y[l]
                    EndIf
                Next l
            Next k
            *lissage\x[x]\y[y] = a/n
        Next y
    Next x
    enregistrer_bmp(*lissage, "lisse.bmp")
EndProcedure

Procedure interpolate(y1, y2, n, delta)

    ; interpolation non linéaire
    If n = 0
        ProcedureReturn y1
    EndIf
    If n = 1
        ProcedureReturn y2
    EndIf
    a.f = delta/n

    fac1.f = 3*Pow(1 - a, 2) - 2*Pow(1 - a, 3)
    fac2.f = 3*Pow(a, 2) - 2*Pow(a, 3)

    ProcedureReturn y1*fac1 + y2*fac2
EndProcedure


Procedure valeur_interpolee(i, j, frequence, *r.s_Calque)
    ; valeurs des bornes
    Define borne1x, borne1y, borne2x, borne2y, q
    Define.l pas
   
    pas = #taille/frequence
    If pas = 0 : pas = 1 : EndIf

    q = i/pas
    borne1x = q*pas
    borne2x =(q + 1)*pas

    If borne2x >= #taille
      borne2x = #taille - 1
    EndIf

    q = j/pas
    borne1y = q*pas
    borne2y =(q + 1)*pas

    If borne2y >= #taille
      borne2y = #taille - 1
    EndIf

    Define b00, b01, b10, b11
    b00 = *r\x[borne1x]\y[borne1y]
    b01 = *r\x[borne1x]\y[borne2y]
    b10 = *r\x[borne2x]\y[borne1y]
    b11 = *r\x[borne2x]\y[borne2y]

    v1 = interpolate(b00, b01, borne2y - borne1y, j - borne1y)
    v2 = interpolate(b10, b11, borne2y - borne1y, j - borne1y)
    fin = interpolate(v1, v2, borne2x - borne1x , i - borne1x)
   
    ProcedureReturn fin
EndProcedure

Procedure aleatoire(a.f)
  ProcedureReturn Random(256)
EndProcedure

Procedure enregistrer_bmp(*c.s_Calque, filename.s)
  CreateImage(0, #taille, #taille, 32)
  If StartDrawing(ImageOutput(0))
      For i = 0 To #taille - 1
        For j = 0 To #taille - 1
          Plot(i, j, RGB(*c\x[i]\y[j], *c\x[i]\y[j], *c\x[i]\y[j]))
        Next j
      Next i
    StopDrawing()
    SaveImage(0, filename)
  EndIf
EndProcedure

Procedure main()

  ; valeurs d'entrée
   octaves = 3
   frequence = 5
   persistance.f = 0.3
  lissage = 9

  ; création de calque
  Define.s_Calque *s
  *s = init_calque(persistance)
  generer_calque(frequence, octaves, persistance, lissage, *s)
  ; enregistrer_bmp(*s, "resultat.bmp")
EndProcedure

main()

SetGadgetState(0, ImageID(0))
SetClipboardImage(0)
Repeat
  EventID = WaitWindowEvent()

  If EventID = #PB_Event_CloseWindow
    Quit = 1
  EndIf

Until Quit = 1