Perlin et subdivisions, création de terrains

[Huitbit]

Hello !
Je viens de voir que la béta était sortie .
J'ai rien vu car je faisais mumuse avec les subdivisions.


L'avantage c'est de travailler avec des droites(cf. post suivant pour visualiser le lissage de chaque octave). Pas d'interpolation (bilinéaire, bicubique....). Le seul point délicat, c'est le bricolage avec les subdivisions .

Au niveau rapidité, sans la moindre optimisation, je peux créer un bruit de Perlin(monochrome) sur tout l'écran assez rapidement !(D'ailleurs, si vous avez des idées d'amélioration, donnez, dododonnez.... )
Avec les couleurs, j'ai un peu fait du n'importe quoi, ça ralentit un peu la bête.
A la suite du programme, je mets un exemple en 2D plus simple (j'ai utilisé une technique voisine)

Pour le principe des subdivisions, j'avais déjà fait quelque chose de détaillé.
Pour obtenir une surface, il a fallu faire deux subdivisions.
Une première pour créer des "lignes de contrôle" horizontales puis une deuxième verticale pour les utiliser.
Pour les couleurs, j'ai fait a pif

Code : Tout sélectionner

;-@@@@@@@@@@@@@@@
;-Bruit de Perlin & Subdivisions
;Auteur Huitbit
;Avril 2011
;PureBasic 4.51 (Windows  -  x86)
;-@@@@@@@@@@@@@@@
;-Déclarations
#PasInitial =128
#NbreInitialDePicsHorizontaux =6
#NbreInitialDePicsVerticaux =4
#OctaveMax = 5; de l'octave n°1 à #OctaveMax
#Persistance = 0.5
Octave.b
Persistance.f
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Composante.w
Pas.l 
NbreDePicsHorizontaux.l
NbreDePicsVerticaux.l
NbreMaxDePicsHorizontaux.l = #NbreInitialDePicsHorizontaux * Pow(2 , #OctaveMax - 1)
NbreMaxDePicsVerticaux.l = #NbreInitialDePicsVerticaux * Pow(2 , #OctaveMax - 1)
PasMinimal.l = #PasInitial / Pow(2 , #OctaveMax - 1)
LargeurEcran.l = NbreMaxDePicsHorizontaux  * PasMinimal
HauteurEcran.l = NbreMaxDePicsVerticaux  * PasMinimal
#NbreDeSubdivisions = 3
RapportSubdv.f = 0.25
IndiceMaxDesPtsDeCtrlHorizontaux.l = (NbreMaxDePicsHorizontaux - 2) * Pow(2,#NbreDeSubdivisions) +1
IndiceMaxDesPtsDeCtrlVerticaux.l = (NbreMaxDePicsVerticaux - 2) * Pow(2,#NbreDeSubdivisions) + 1 
IndiceDesPtsDeCtrlHorizontaux.l
IndiceDesPtsDeCtrlVerticaux.l

Structure PtDeCtrl
  x.l
  y.l ; y  =  a  *  x  + b
  z.l
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Structure Carte
  z.w
EndStructure

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB 
EndIf
EndMacro

;tableau des points de contrôle
Dim P.PtDeCtrl(LargeurEcran , IndiceMaxDesPtsDeCtrlVerticaux , #OctaveMax)

Dim carte.Carte(LargeurEcran,HauteurEcran,#OctaveMax)

;-Remplissage du tableau  de points de contrôle avec des pics de Perlin
For Octave = 1 To #OctaveMax
  Pas = #PasInitial / Pow(2 , Octave - 1)
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  Persistance =  Pow(#Persistance , Octave - 1)
  For i = 0 To NbreDePicsHorizontaux -1 
    For j = 0 To NbreDePicsVerticaux -1
      P(i  , j , Octave)\x = i * Pas
      P(i  , j , Octave)\y = j * Pas
      P(i  , j , Octave)\z = Persistance * Random(255)
      
    Next j
  Next i
Next Octave

  ;-Subdivisions
For Octave = 1 To #OctaveMax
  NbreDePicsHorizontaux = #NbreInitialDePicsHorizontaux * Pow(2 , Octave - 1)
  NbreDePicsVerticaux = #NbreInitialDePicsVerticaux * Pow(2 , Octave - 1)
  IndiceDesPtsDeCtrlHorizontaux = NbreDePicsHorizontaux - 1
  IndiceDesPtsDeCtrlVerticaux = NbreDePicsVerticaux - 1
  Pas = #PasInitial / Pow(2 , Octave - 1)
  ;- Création des lignes de contrôle horizontales pour chaque octave 
  ;Utilisation du tableau P(i,j,Octave) pour i allant de i=0 à i=NbreDePicsHorizontauxProvisoire
  ;l'utilisation de i=x=0 à  i=x=LargeurEcran se fera dans la deuxième partie
  ;{
  
  For j = 0 To IndiceDesPtsDeCtrlVerticaux
    
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsHorizontaux - 2) * Pow(2,SubdivisionEnCours) +1
      
      For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If i = IndiceMaxProvisoire - 1
          P(2 * i + 1,j,Octave)\x = LargeurEcran
          P(2 * i + 1,j,Octave)\z = P(IndiceMaxProvisoire,j,Octave)\z
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          
        Else
          P(2 * i + 1,j,Octave)\x = P(i,j,Octave)\x + (1 - RapportSubdv) * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i + 1,j,Octave)\z = P(i,j,Octave)\z + (1 - RapportSubdv) * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
          P(2 * i,j,Octave)\x = P(i,j,Octave)\x + RapportSubdv * (P(i + 1,j,Octave)\x - P(i,j,Octave)\x)
          P(2 * i,j,Octave)\z = P(i,j,Octave)\z + RapportSubdv * (P(i + 1,j,Octave)\z - P(i,j,Octave)\z)
        EndIf
        
      Next i
      
      P(1,j,Octave)\x = P(0,j,Octave)\x + (1 - RapportSubdv) * (P(1,j,Octave)\x - P(0,j,Octave)\x)
      P(1,j,Octave)\z = P(0,j,Octave)\z + (1 - RapportSubdv) * (P(1,j,Octave)\z - P(0,j,Octave)\z)
      
    Next SubdivisionEnCours
    
    ;-calculs des équations affines de chaque segment
    x=0
    For i = 0  To IndiceMaxDesPtsDeCtrlHorizontaux -1
      affine(P(i,j,Octave)\a,P(i,j,Octave)\b,P(i,j,Octave)\x,P(i,j,Octave)\z,P(i + 1,j,Octave)\x,P(i + 1,j,Octave)\z)
      
      ;-remplissage du tableau carte(x,y,Octave)
      
      While x<=P(i+1,j,Octave)\x
        carte(x,j*Pas,Octave)\z=P(i,j,Octave)\a * x  + P(i,j,Octave)\b
        x=x+1
      Wend
    Next i
    
  Next j
  
  
  ;}
  ;-subdivisions selon y, les points de contrôles sont issus des lignes de contrôle horizontales
  ;{
  For x=0 To LargeurEcran 
    ;Chargement des points de contrôle d'abscisse x
    For j = 0 To IndiceDesPtsDeCtrlVerticaux
      P(x,j,Octave)\z= carte(x,j*Pas ,Octave)\z
      P(x,j,Octave)\y=j*Pas
    Next j 
    For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
      IndiceMaxProvisoire = (NbreDePicsVerticaux - 2) * Pow(2,SubdivisionEnCours) +1
      For j = IndiceMaxProvisoire - 1 To 1 Step  - 1
        If j = IndiceMaxProvisoire - 1
          P(x,2 * j + 1,Octave)\y = HauteurEcran
          P(x,2 * j + 1,Octave)\z = P(x,IndiceMaxProvisoire,Octave)\z
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
          
        Else
          P(x,2 * j + 1,Octave)\y = P(x,j,Octave)\y + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j + 1,Octave)\z = P(x,j,Octave)\z + (1 - RapportSubdv) * (P(x,j+ 1,Octave)\z - P(x,j,Octave)\z)
          P(x,2 * j,Octave)\y = P(x,j,Octave)\y + RapportSubdv * (P(x,j + 1,Octave)\y - P(x,j,Octave)\y)
          P(x,2 * j,Octave)\z = P(x,j,Octave)\z + RapportSubdv * (P(x,j+1,Octave)\z - P(x,j,Octave)\z)
          
        EndIf
        
      Next j
      
      P(x,1,Octave)\y = P(x,0,Octave)\y + (1 - RapportSubdv) * (P(x,1,Octave)\y - P(x,0,Octave)\y)
      P(x,1,Octave)\z = P(x,0,Octave)\z + (1 - RapportSubdv) * (P(x,1,Octave)\z - P(x,0,Octave)\z)
      
      
      
    Next SubdivisionEnCours
    ;-calculs des équations affines de chaque segment
    
    y=0
    For j = 0  To IndiceMaxDesPtsDeCtrlVerticaux -1
      affine(P(x,j,Octave)\a,P(x,j,Octave)\b,P(x,j,Octave)\y,P(x,j,Octave)\z,P(x ,j+1,Octave)\y,P(x,j+1,Octave)\z)
      ;-remplissage du tableau carte(x,y,Octave)
      
      While y<=P(x,j+1,Octave)\y
        carte(x,y,Octave)\z=P(x,j,Octave)\a * y  + P(x,j,Octave)\b
        y=y+1
      Wend
    Next j
    
  Next x
  ;}
Next Octave
;-*************************************************
;-PROGRAMME PRINCIPAL
;-
;-************************************************
InitSprite()
InitKeyboard()
info$=">>INFOS: Pics "+ Str(#NbreInitialDePicsHorizontaux)+" * "+Str(#NbreInitialDePicsVerticaux)+"   Oct="+Str(#OctaveMax)+"  Subdv="+Str(#NbreDeSubdivisions)
OpenWindow(0,0,0,LargeurEcran,HauteurEcran,"Test Perlin 2D"+info$,#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
OpenWindowedScreen(WindowID(0),0,0,LargeurEcran,HauteurEcran,0,0,0)

;-dessin de la carte
CreateSprite(0,LargeurEcran,HauteurEcran)
StartDrawing(SpriteOutput(0))

If #OctaveMax>1 
  For Octave = 2 To #OctaveMax
    
    For x=0 To LargeurEcran
      For y=0 To HauteurEcran 
        carte(x,y,1)\z=carte(x,y,1)\z+carte(x,y,Octave)\z
      Next y
    Next x
    
  Next Octave
EndIf

For x=0 To LargeurEcran
  For y=0 To HauteurEcran 
    Composante=carte(x,y,1)\z/FacteurNormalisation
    ;-choix des couleurs en fonction de z
    Select Composante
      Case 0 To 85 ; eaux profondes
        Box(x,y,1,1,RGB(0,0,2*Composante))
      Case 85 To 100 ; eaux peu profondes
        Box(x,y,1,1,RGB(0, Composante*0.4, 2*Composante))
      Case 100 To 104 ; plages
        Box(x,y,1,1,RGB(2*Composante+25,2*Composante+15,Composante))
      Case 104 To 115 ;herbe
        Box(x,y,1,1,RGB(0, 2*Composante-Random(40),0))
      Case 115 To 130;forêt
        Box(x,y,1,1,RGB(0,Composante-Random(20),0))
      Case 120 To 150;basse montagne
        Box(x,y,1,1,RGB(Composante, Composante*0.7, Random(80)))
      Case 150 To 170;haute montagne
        Box(x,y,1,1,RGB(Composante, Composante, 20+Random(80)))
      Case 170 To 255;neige
        Box(x,y,1,1,RGB(Composante, Composante,Composante))
    EndSelect
    
  Next y
Next x
StopDrawing()
;-BOUCLE PRINCIPALE
Repeat
  FlipBuffers() 
  DisplaySprite(0,0,0)
  Delay(10)
Until WindowEvent() = #PB_Event_CloseWindow  

Hasta la vista !

PS: A suivre, la même chose en 2D

[Huitbit]

Code : Tout sélectionner

;Perlin&Subdivisions
;Auteur Huitbit
;Février 2011
;PureBasic 4.51 (Windows  -  x86)
; *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 
#LargeurEcran = 800
#HauteurEcran = 600
#NbreDeSubdivisions = 3
#OctaveMax = 5
#Persistance = 0.4
Octave.b 
Persistance.f
#NombreInitialDePtsDeCtrl = 8
IndiceMaxTableau.l 
TailleTableau.l = ((#NombreInitialDePtsDeCtrl*Pow(2,#OctaveMax - 1) - 2) * Pow(2,#NbreDeSubdivisions) + 1) 
RapportSubdv.f = 0.25
FacteurNormalisation.f =(1 - Pow(#Persistance,#OctaveMax)) / (1 - #Persistance)
Bruit1DNormeA.f
Bruit1DNormeB.f

Structure InfosPoint
  x.l
  y.l ; y  =  a  *  x  + b
  a.f ; pente
  b.f ; ordonnée à l'origine
EndStructure

Macro affine(a,b,xA,yA,xB,yB)
a = (yB - yA) / (xB - xA)
b = (yA * xB - yB * xA) / (xB - xA)
EndMacro


; - ######################################
; - PROGRAMME PRINCIPAL
; - ######################################

InitSprite()
InitKeyboard()
OpenWindow(0,0,0,#LargeurEcran,#HauteurEcran,"Test Perlin 1D    Tapez F1 pour créer une nouvelle courbe",#PB_Window_ScreenCentered|#PB_Window_SystemMenu  )
OpenWindowedScreen(WindowID(0),0,0,#LargeurEcran,#HauteurEcran,0,0,0)

;- label pour le Goto, tracé d'une nouvelle courbe
NouvelleCourbe :
;- tableau des points de la courbe

Dim P.InfosPoint (TailleTableau,#OctaveMax)
Dim Bruit1D.l(1024)

For Octave = 1 To #OctaveMax
  NombreDePtsDeCtrl = #NombreInitialDePtsDeCtrl *Pow(2,Octave - 1)
  IndiceMaxTableau = ((NombreDePtsDeCtrl - 2) * Pow(2,#NbreDeSubdivisions) + 1) ;pour avoir le nombre de points, ajouter 1 à l'indice !
  
  Persistance = Pow(#Persistance,Octave - 1) 
  ;initialisation des points de contrôle
  ;Départ et arrivée
  P(0,Octave)\x = 0
  P(0,Octave)\y = 0
  P(NombreDePtsDeCtrl - 1,Octave)\x = #LargeurEcran
  P(NombreDePtsDeCtrl - 1,Octave)\y = P(0,Octave)\y
  
  ;Autres points
  For i = 1 To NombreDePtsDeCtrl - 2
    P(i,Octave)\x = i * #LargeurEcran / (NombreDePtsDeCtrl - 1)
    P(i,Octave)\y = Random(255)*Persistance
  Next i
  
  
  ;- subdivisions de la courbe
  For SubdivisionEnCours = 0 To #NbreDeSubdivisions - 1
    IndiceMaxProvisoire = (NombreDePtsDeCtrl - 2) * Pow(2,SubdivisionEnCours) + 1
    For i = IndiceMaxProvisoire - 1 To 1 Step  - 1
      
      If i = IndiceMaxProvisoire - 1
        P(2 * i + 1,Octave)\x = #LargeurEcran
        P(2 * i + 1,Octave)\y = P(0,Octave)\y 
        P(2 * i,Octave)\x = P(i,Octave)\x + RapportSubdv * (P(i + 1,Octave)\x - P(i,Octave)\x)
        P(2 * i,Octave)\y = P(i,Octave)\y + RapportSubdv * (P(i + 1,Octave)\y - P(i,Octave)\y)
        
      Else
        P(2 * i + 1,Octave)\x = P(i,Octave)\x + (1 - RapportSubdv) * (P(i + 1,Octave)\x - P(i,Octave)\x)
        P(2 * i + 1,Octave)\y = P(i,Octave)\y + (1 - RapportSubdv) * (P(i + 1,Octave)\y - P(i,Octave)\y)
        P(2 * i,Octave)\x = P(i,Octave)\x + RapportSubdv * (P(i + 1,Octave)\x - P(i,Octave)\x)
        P(2 * i,Octave)\y = P(i,Octave)\y + RapportSubdv * (P(i + 1,Octave)\y - P(i,Octave)\y)
      EndIf
      
    Next i
    
    P(1,Octave)\x = P(0,Octave)\x + (1 - RapportSubdv) * (P(1,Octave)\x - P(0,Octave)\x)
    P(1,Octave)\y = P(0,Octave)\y + (1 - RapportSubdv) * (P(1,Octave)\y - P(0,Octave)\y)
    
  Next SubdivisionEnCours
  
  ;-calculs des équations affines de chaque segment
  For i = 0  To IndiceMaxTableau - 1
    affine(P(i,Octave)\a,P(i,Octave)\b,P(i,Octave)\x,P(i,Octave)\y,P(i + 1,Octave)\x,P(i + 1,Octave)\y)
  Next i
  
  
  CreateSprite(Octave,#LargeurEcran,#HauteurEcran)
  StartDrawing(SpriteOutput(Octave))
  For i = 0 To IndiceMaxTableau - 1
    LineXY(P(i,Octave)\x,#HauteurEcran - P(i,Octave)\y,P(i + 1,Octave)\x,#HauteurEcran  - P(i + 1,Octave)\y ,RGB(0,50 + Octave*30,255 ))
  Next i
  StopDrawing()
Next Octave

;-Bruit1D, somme de toutes les octaves

For Octave = 1 To #OctaveMax
  NombreDePtsDeCtrl = #NombreInitialDePtsDeCtrl *Pow(2,Octave - 1)
  IndiceMaxTableau = ((NombreDePtsDeCtrl - 2) * Pow(2,#NbreDeSubdivisions) + 1) ;pour avoir le nombre de points, ajouter 1 à l'indice !
  x = 0
  For i = 0 To IndiceMaxTableau - 1
    
    While x < P(i+1,Octave)\x 
      Bruit1D(x) = Bruit1D(x) + P(i,Octave)\a * x + P(i,Octave)\b
      x = x + 1
    Wend
    
  Next i
Next Octave
Bruit1D(#LargeurEcran) = Bruit1D(0)
CreateSprite(#OctaveMax+1,#LargeurEcran,#HauteurEcran)
StartDrawing(SpriteOutput(#OctaveMax+1))
For x= 0 To #LargeurEcran - 1  
  Bruit1DNormeA = #HauteurEcran - Bruit1D(x) / FacteurNormalisation 
  Bruit1DNormeB = #HauteurEcran - Bruit1D(x + 1) / FacteurNormalisation 
  LineXY(x, Bruit1DNormeA, x + 1, Bruit1DNormeB,RGB(255,0,0))
Next x
  
StopDrawing()

;- ######################################
;- BOUCLE PRINCIPALE
;- ######################################
Repeat
  ;- affichage
  FlipBuffers() 
  For Octave = 1 To #OctaveMax
    DisplayTransparentSprite(Octave,0,0)
  Next Octave
  DisplayTransparentSprite(#OctaveMax + 1,0,0)
  
  
  Delay(1)
  
  ExamineKeyboard()
  If KeyboardReleased(#PB_Key_F1)
    For Octave = 1 To #OctaveMax
      ClearScreen(RGB(0,0,0))
    Next Octave
    Goto NouvelleCourbe
  EndIf
  
Until WindowEvent()  =  #PB_Event_CloseWindow 

[djes]

Vivement la suite ...

[kelebrindae]

Très intéressant !
Pour ce qui est des couleurs, j'avais fait un truc qui définissait un type de terrain (donc une couleur) en fonction de l'altitude, de la latitude et de la pente.
Voici les liens:
http://www.purebasic.fr/french/viewtopic.php?f=2&t=8339
http://www.purebasic.fr/french/viewtopic.php?f=2&t=8394

[djes]

Quand je vois tout ça, je me dis qu'on pourrait peut-être faire ensemble un truc sur le contouring. Il y a déjà eu des codes sur le forum, mais perso ce que je cherche, ce serait plutôt un truc genre triangulation de Delaunay, en se basant sur des points qui ne suivent pas un schéma régulier...
Un code trouvé il y a longtemps dont je n'ai malheureusement pas noté l'auteur. L'algo conrec se trouve assez facilement sur le net.

Code : Tout sélectionner

#Longueur = 200
#Largeur = 200
#Window = 0

Global xmax.f, xmin.f, ymax.f, ymin.f, zmax.f, zmin.f

Procedure.f min(x.f, y.f)
  If x < y
    ProcedureReturn x
  Else
    ProcedureReturn y
  EndIf
EndProcedure

Procedure.f max(x.f, y.f)
  If x > y
    ProcedureReturn x
  Else
    ProcedureReturn y
  EndIf
EndProcedure

Procedure.f float(x.l)
  ProcedureReturn x
EndProcedure

xmin.f = -1.5
xmax.f = 1.5
nx = 100

ymin.f = -1.5
ymax.f = 1.5
ny = 100

nc = 20



Global Dim d.f(nx, ny)
Global Dim x.f(nx)
Global Dim y.f(ny)
Global Dim z.f(nc)
Global Dim colorz.f(nc)

For i = 0 To nx
 x(i) = xmin + (xmax - xmin) * i / float(nx)
Next
For j = 0 To ny
 y(j) = ymax - (ymax - ymin) * j / float(ny)
Next

zmax.f = -float(999999999)
zmin.f = float(999999999)
For i = 0 To nx
  For j = 0 To ny
    d(i,j)= 1./( Pow(x(i)*x(i)+(y(j)-0.842)*(y(j)+0.842),2) + Pow( x(i)*(y(j)-0.842) + x(i)*(y(j)-0.842),2))
    zmin = min(zmin, d(i,j))
    zmax = max(zmax, d(i,j))
  Next
Next

zmax = 2.25
zmin = 0

For k = 0 To nc
 z(k) = (zmax - zmin) * k / float(nc+1)
 colorz(k) = Int(255 * k / float(nc+1))
Next



Global Dim h.f(4)
Global Dim sh(4)
Global Dim xh.f(4)
Global Dim yh.f(4)

Global Dim im(3)
Global Dim jm(3)
Global Dim castab(2,2,2)

; Initialisation des tableaux
Restore Donnees
For i = 0 To 3
  Read im(i)
Next
For i = 0 To 3
  Read jm(i)
Next

For i = 0 To 2
  For j = 0 To 2
    For k = 0 To 2
       Read castab(i, j, k)
    Next
  Next
Next

Procedure.f xsect(p1, p2)
  ProcedureReturn (h(p2)*xh(p1)-h(p1)*xh(p2))/(h(p2)-h(p1))
EndProcedure
Procedure.f ysect(p1, p2)
  ProcedureReturn (h(p2)*yh(p1)-h(p1)*yh(p2))/(h(p2)-h(p1))
EndProcedure

Procedure vecout(x1.f, y1.f, x2.f, y2.f, k)
  x1 = #Longueur * (x1-xmin)/(xmax-xmin)
  y1 = #Largeur * (y1-ymin)/(ymax-ymin)
  x2 = #Longueur * (x2-xmin)/(xmax-xmin)
  y2 = #Largeur * (y2-ymin)/(ymax-ymin)
 
  LineXY(x1, y1, x2, y2, colorz(k))
  ;Debug Str(x1)+"/"+Str(y1)+"/"+Str(x2)+"/"+Str(y2)+"/"+Str(z)
EndProcedure

;=============================================================================
;
;     CONREC is a contouring subroutine for rectangularily spaced data.
;
;     It emits calls to a line drawing subroutine supplied by the user
;     which draws a contour map corresponding to real*4data on a randomly
;     spaced rectangular grid. The coordinates emitted are in the same
;     units given in the x() and y() arrays.
;
;     Any number of contour levels may be specified but they must be
;     in order of increasing value.
;
;     This version is an adaptation of the original Paul Bourke subroutine:
;     http://astronomy.swin.edu.au/~pbourke/projection/conrec/
;
;=============================================================================
Procedure conrec(ilb, iub, jlb, jub, nc)
  For j= jub-1 To jlb Step -1
    For i=ilb To iub-1
      temp1.f = min(d(i, j), d(i, j+1))
      temp2.f = min(d(i+1, j), d(i+1, j+1))
      dmin.f = min(temp1,temp2)
      temp1 = max(d(i,j),d(i,j+1))
      temp2 = max(d(i+1,j),d(i+1,j+1))
      dmax.f = max(temp1,temp2)

      If dmax>=z(0) And dmin<=z(nc)
        For k=0 To nc
       
           If z(k)>=dmin And z(k)<=dmax
            For m=4 To 0 Step -1
              If m
               h(m) = d(i+im(m-1), j+jm(m-1))-z(k)
               xh(m) = x(i+im(m-1))
              yh(m) = y(j+jm(m-1))
              Else
                 h(0) = 0.25*(h(1)+h(2)+h(3)+h(4))
               xh(0)=0.5*(x(i)+x(i+1))
              yh(0)=0.5*(y(j)+y(j+1))
             EndIf
             
              If h(m)>0
               sh(m) = 1
             ElseIf h(m) < 0
               sh(m) = -1
             Else
               sh(m) = 0
             EndIf
           Next
       ;=================================================================
       ;
       ; Note: at this stage the relative heights of the corners and the
       ; centre are in the h array, and the corresponding coordinates are
       ; in the xh and yh arrays. The centre of the box is indexed by 0
       ; and the 4 corners by 1 to 4 as shown below.
       ; Each triangle is then indexed by the parameter m, and the 3
       ; vertices of each triangle are indexed by parameters m1,m2,and
       ; m3.
       ; It is assumed that the centre of the box is always vertex 2
       ; though this isimportant only when all 3 vertices lie exactly on
       ; the same contour level, in which case only the side of the box
       ; is drawn.
       ;
       ;
       ;      vertex 4 +-------------------+ vertex 3
       ;               | \               / |
       ;               |   \    m-3    /   |
       ;               |     \       /     |
       ;               |       \   /       |
       ;               |  m=2    X   m=2   |       the centre is vertex 0
       ;               |       /   \       |
       ;               |     /       \     |
       ;               |   /    m=1    \   |
       ;               | /               \ |
       ;      vertex 1 +-------------------+ vertex 2
       ;
       ;
       ;
       ;               Scan each triangle in the box
       ;
       ;=================================================================             
       For m=1 To 4
         m1 = m
         m2 = 0
         If m<>4
          m3 = m+1
         Else
          m3 = 1
        EndIf
        
        case_value = castab(sh(m1)+1, sh(m2)+1, sh(m3)+1);
          If case_value<>0
    Select case_value
        ;===========================================================
        ;     Case 1 - Line between vertices 1 and 2
        ;===========================================================
      Case 1
        x1.f=xh(m1);
        y1.f=yh(m1);
        x2.f=xh(m2);
        y2.f=yh(m2);
        ;===========================================================
        ;     Case 2 - Line between vertices 2 and 3
        ;===========================================================
      Case 2
        x1.f=xh(m2);
        y1.f=yh(m2);
        x2.f=xh(m3);
        y2.f=yh(m3);
        ;===========================================================
        ;     Case 3 - Line between vertices 3 and 1
        ;===========================================================
      Case 3
        x1.f=xh(m3);
        y1.f=yh(m3);
        x2.f=xh(m1);
        y2.f=yh(m1);
        ;===========================================================
        ;     Case 4 - Line between vertex 1 and side 2-3
        ;===========================================================
      Case 4
        x1.f=xh(m1);
        y1.f=yh(m1);
        x2.f=xsect(m2,m3);
        y2.f=ysect(m2,m3);
        ;===========================================================
        ;     Case 5 - Line between vertex 2 and side 3-1
        ;===========================================================
      Case 5
        x1.f=xh(m2);
        y1.f=yh(m2);
        x2.f=xsect(m3,m1);
        y2.f=ysect(m3,m1);
        ;===========================================================
        ;     Case 6 - Line between vertex 3 and side 1-2
        ;===========================================================
      Case 6
        x1.f=xh(m3);
        y1.f=yh(m3);
        x2.f=xsect(m1,m2);
        y2.f=ysect(m1,m2);
        ;===========================================================
        ;     Case 7 - Line between sides 1-2 and 2-3
        ;===========================================================
      Case 7
        x1.f=xsect(m1,m2);
        y1.f=ysect(m1,m2);
        x2.f=xsect(m2,m3);
        y2.f=ysect(m2,m3);
        ;===========================================================
        ;     Case 8 - Line between sides 2-3 and 3-1
        ;===========================================================
      Case 8
        x1.f=xsect(m2,m3);
        y1.f=ysect(m2,m3);
        x2.f=xsect(m3,m1);
        y2.f=ysect(m3,m1);
        ;===========================================================
        ;     Case 9 - Line between sides 3-1 and 1-2
        ;===========================================================
      Case 9
        x1.f=xsect(m3,m1);
        y1.f=ysect(m3,m1);
        x2.f=xsect(m1,m2);
        y2.f=ysect(m1,m2);
      EndSelect       
      ;=============================================================
      ; Put your graphic processing code here
      ;=============================================================
    vecout(x1,y1,x2,y2, k)
          EndIf
       
            Next             
          EndIf
        Next
      EndIf
     
    Next
  Next
   
EndProcedure

DataSection
Donnees:
Data.l 0, 1, 1, 0; im()
Data.l 0, 0, 1, 1; jm()
Data.l 0,0,8, 0,2,5, 7,6,9; case_value
Data.l 0,3,4, 1,3,1, 4,3,0
Data.l 9,6,7, 5,2,0, 8,0,0
EndDataSection

;- Debut du programme

hWnd = OpenWindow ( #Window , 0, 0, #Longueur , #Largeur, " Isocontour" , #PB_Window_SystemMenu | #PB_Window_Invisible | #PB_Window_ScreenCentered )
CreateGadgetList (WindowID(0))
CreateImage (0, #Longueur , #Largeur )
 
StartDrawing (ImageOutput(0))
conrec(0, nx, 0, ny, nc)
StopDrawing ()

ImageGadget (0, 0, 0, 0, 0, ImageID(0))
HideWindow ( #Window ,0)
Repeat
      Select WaitWindowEvent ()
           Case #PB_Event_CloseWindow
               Quit = #True
      EndSelect
Until Quit

[Huitbit]

Hello,

Très intéressants les liens.
Dans un premier temps je vais relier altitude et teinte correctement, je rajouterai la pente après.


Première optimisation

Code : Tout sélectionner

Macro affine(a,b,uA,zA,uB,zB)
a = (zB - zA) / (uB - uA)
b = (zA * uB - zB * uA) / (uB - uA)
EndMacro

Remplacé par (le coefficient directeur a était calculé deux fois, c'est pas bien malin ):

Code : Tout sélectionner

Macro affine(a,b,uA,zA,uB,zB)
If (uB-uA)<>0
  a = (zB - zA) / (uB - uA)
  b = zB - a * uB 
EndIf
EndMacro

PS: je n'ai pas répondu avant car j'avais un problème électrique : court-circuit caché quelque part entre deux pièces.
La cause, deux trois fois par mois des essaims de fourmis volantes kamikazes (ou de termites) viennent mourir dans les prises, les interrupteurs ou dans les culots des ampoules, trop belle la nature !

De toute façon, personne n'a rien vu maintenant qu'il y a la 4.61

Lorsque l'enfant paraît

Lorsque l'enfant paraît, le cercle de famille
Applaudit à grands cris.
Son doux regard qui brille
Fait briller tous les yeux,
Et les plus tristes fronts, les plus souillés peut-être,
Se dérident soudain à voir l'enfant paraître,
Innocent et joyeux.
.......
Victor HUGO (1802-1885)

Hasta la vista !

[gildev]

Alors là Huitbit je t'aime! Ca c'est le genre de sujet que j'adore!!!

[Huitbit]

Allons, Allons, nous ne sommes pas seuls

Je fais des tests pour l'instant.
J'ai un penchant pour le "style BD"(voir plus haut) pour la carte sachant que l'objectif final (depuis 2005 ) c'est de faire un jeu !!!
Je vais essayer quand même différents styles pour voir.

Remarque : les courbes obtenues par subdivisions sont souvent moins élevées que celles obtenues par les autres méthodes(c'est dans leur nature ), pour obtenir des résultats similaires, il faut augmenter la persistance !

1er essai :
http://www.purebasic.fr/french/viewtopi ... =1&t=11718

Hasta la vista !

[G-Rom]

Sympa ton code huitbit , j'ai un projet similaire , mais qui ne génère pas le terrain ma qui calcul la lumière et qui applique une texture en dégradé suivant une hauteur min/max , ce qui donne ce genre de résultat en 3D :

http://unity3d.com/support/documentatio ... maps-0.jpg

Si tu n'y vois pas d'inconvénient , je vais te chouré ton code

[Huitbit]

Merci,
Pas de problème, au contraire .
En plus, c'est toi qui m'as fait découvrir les courbes de Bézier !


Il y a encore des trucs qui clochent dans cette version avec le nombre de subdivisions et le nombre d'octaves mais c'est parce que je voulais adapter le nombre de pics à la taille de l'écran.
Mais bon, je ne m'inquiète pas pour toi

En tout cas, encore bravo à toi et à toute l'équipe pour le souffle d'air frais donné à PureBasic .

Hasta la vista !

PS : petite correction dans les parties "remplissage du tableau"

Code : Tout sélectionner

While y<=P(x,j+1,Octave)\y
.........
 While x<=P(i+1,j,Octave)\x

au lieu de

Code : Tout sélectionner

While y<P(x,j+1,Octave)\y
..............
While x<P(i+1,j,Octave)\x

Essai n°2 Utilisation des pentes
Sprite obtenu en multipliant la pente par un facteur arbitraire(sprite de droite) et en jouant avec le SpriteBlending (pas drôle comme jeu ! Modes donnant des résultats acceptables :Sprite3DBlendingMode(2,7) et Sprite3DBlendingMode(4,2))


Essai n°3 Utilisation des pentes + exclusion du blending de 95% de l'eau + Sprite3DBlendingMode(4,2)
Ca prend forme !



Prochain test, ajout de la pente directement lors de la création du sprite (pas de SpriteBlending)

[Huitbit]

Essai n°4 Un seul sprite, prise en compte des pentes dans l'utilisation du gradient des teintes



A propos du code, je n'ai pas rajouté grand chose au code initial mais pour l'instant, il n'est pas présentable
Dès que c'est prêt, je poste !

Hasta la vista !

[aleo]

J'avais oublié :
Pourquoi ne faite vous pas une seconde fenêtre, qui génère la même image en noir et blanc ?
Comme sa, vous pourriez utiliser le bout de code donné dans les exemples, du nom de : screen3Drequester

Et avec celui en couleur, sa fait la texture.
Comme ça, on peut ce balader sur les terrain créer grâce au code.


Aleo

[Huitbit]

Hello,

Parce que la 3D et moi ça fait deux
Mais si ça peux intéresser quelqu'un, ça ne change rien au code !
Par contre, y a-t-il des limitations pour la taille des sprites ?

Et hop, bonne ballade !



Hasta la vista !

PS: le tutoiement est assez courant sur le forum !

[Huitbit]

Hello,

Suite au message d'aleo, j'ai voulu essayer la 3D.
J'ai utilisé l'exemple de pb.
Pour AddMaterialLayer(0, LoadTexture(1, "Terrain_Detail.jpg"), #PB_Material_Add), j'ai gardé "Terrain_Detail.jpg", car je ne sais pas comment il a été généré.

La grosse galère c'est CreateTerrain("terrain.png", MaterialID(0), 1, 1, 1, 4) ,sans Gimp, impossible d'avoir une image réellement en niveaux de gris !
Par contre, pour l'eau, je crois qu'il faut "prévenir" la carte graphique avec l'algorithme car c'est un peu mouvementé

De toute façon, pour la 3D, je pense qu'il faut faire un traitement différent du bruit de départ. Autant le relief est intéressant en 2D, autant en 3D il devient vite très accidenté ! C'est flagrant pour l'eau !

Exemple
http://hpics.li/3f9df30

Autre exemple (mêmes fichiers):


Les nuages


La texture


L'image en niveaux de gris


J'essayerai en 1024*1024 plus tard !

Avec tout ça, je ne me suis pas occupé du code

Hasta la vista !

[case]

pour l'eau en fait tu calcule pas, tu définis juste un niveau et tout ce qui est en dessous c'est sous l'eau.