GENERATION PAYSAGE + NAVIGATION 3D (FAUSSE 3D MALHEUREUSEMENT)

Commentaire de Forman le 27/05/2003 21:45:51

Très joli!!!
Est-ce que tu pourrais donner seulement quelques indications sur la manière dont l'algorithme de calcul des altitudes fonctionne? J'ai déjà essayé d'en faire un, mais je me retrouve soit avec des paysages trop lisses, soit trop accidentés...

Commentaire de ManChesTer le 28/05/2003 21:59:37 administrateur CS

Le source un peux optimiser,

le voila donc plus facilement uilisable pour des jeux...

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,d:integer;
begin
mapcree := true;
//redimensionnement du double tableau
setlength(map,700);
randomize;
for a := 0 to length(map) - 1 do
begin
  setlength(map[a],length(map));
  for b := 0 to length(map) - 1 do
   map[a][b] := 15;
end;
//emplacement des arbres
setlength(tree,500);
for a := 0 to length(tree) -1 do
begin
  tree[a].X := random(685)+15;
  tree[a].Y := random(685)+15;
end;

for a := 0 to 150 do
begin
  c := random(3)-1;
  while c=0 do
   c:=random(3)-1;
  terrain(random(698) +1,random(698) +1,random(100) + 25,random(125) + 1,c);
end;


//Affichage de la map
paintbox1.Canvas.Brush.Color := clblack;
paintbox1.Canvas.Rectangle(0,0,paintbox1.Width,paintbox1.Height);
for a := 0 to length(map) - 1 do
begin
  c:=a+30;
  for b := 0 to length(map) - 1 do
  begin
    d:=trunc(map[a][b]);
    paintbox1.Canvas.MoveTo(trunc(b+a / 4),trunc(c / 2));
    if map[a][b] > 10 then
    begin
     if map[a][b] > 40 then
       paintbox1.Canvas.Pen.Color := rgb($9F+d,$9F+d,$9F+d)
     else
       paintbox1.Canvas.Pen.Color := rgb(0,$2f+(5*d),0);
     paintbox1.Canvas.LineTo(trunc(b+a / 4) ,((a+30)-d) div 2);
    end
    else if (map[a][b] <= 10) and (map[a][b]>-90) then
    begin
      paintbox1.Canvas.Pen.Color :=rgb(0,0,$0F+(2*(d+90)));
      paintbox1.Canvas.LineTo(trunc(b + a / 4),trunc((c-15) / 2));
    end;
    if (a = 699) or (b = 0) then
    begin
      paintbox1.Canvas.Pen.Color :=clmaroon;
      paintbox1.Canvas.MoveTo(trunc(b + a / 4),trunc(c / 2));
      paintbox1.Canvas.LineTo(trunc(b + a / 4),trunc((c-10) / 2));
    end;
  end;
end;
end;

procedure Tform1.terrain(X,Y,taille,hauteur,facteur:integer);
var a,b,c:integer;
    r : integer;
begin
r:=taille div 2;
for a := taille div 3 downto 1 do
begin
  for b := X to X + taille do
  begin
   if b < 700 then begin
   for c := Y to Y + taille do
   begin
    if c < 700 then
    begin
     if sqrt(sqr(r-(b-X))+sqr(r-(c-Y))) <= a*1.5 then
      map[b][c] := map[b][c] + (((hauteur / taille))*facteur);
    end;
   end;
  end
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
a,b:integer;
begin
//redimensionnement du double tableau
setlength(map,500);
for a := 0 to length(map) - 1 do
begin
  setlength(map[a],length(map));
  for b := 0 to length(map) - 1 do
  begin
   map[a][b] := 15;
   paintbox1.Canvas.Pixels[a,b] := rgb(0,100+ 3*(trunc(map[a][b])),0);
  end;
end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
deplacermap(X,Y)
end;

procedure TForm1.deplacermap(X,Y:integer);
var a,b,c,d,e,f,j : integer;
    h,w,h1,w1    : real;
arbre:boolean;
begin
mapzoom.Canvas.pen.Color := clblack;
h:=mapzoom.height/39;
w:=mapzoom.Width/39;
w1:=mapzoom.Width/(39*50);
h1:=mapzoom.Height/(39*50);
for a := 0 to 39 do
begin
  f:=39-a;
  d:=10*f;
  e:=39-(a+1);
  for b := 0 to 39 do
  begin
   j:= trunc(map[X+b][Y+a]);
   case j of
    -90..10: mapzoom.Canvas.Brush.Color := rgb(0,0,$0F+(2*(j+90)));
    11..39: mapzoom.Canvas.Brush.Color := rgb(0,$2f+(5*j),0);
   else
    mapzoom.Canvas.Brush.Color := rgb($9F+j,$9F+j,$9F+j);
   end;
   mapzoom.Canvas.pen.Color := mapzoom.Canvas.Brush.Color;
   carre[0].X := trunc((d*w1)+(b*(w-w1*f)));
   carre[0].Y := trunc(mapzoom.Height-(((h1+(h-f*h1))*(f+1))/2)-(5*map[X+b][Y+a]));
   carre[1].X := trunc((d*w1)+((b+1)*(w-w1*f)));
   carre[1].Y := trunc(mapzoom.Height-(((h1+(h-f*h1))*(f+1))/2)-(5*map[X+b+1][Y+a]));
   carre[2].X := trunc((10*e*w1)+((b+1)*(w-w1*e)));
   carre[2].Y := trunc(mapzoom.Height-(((h1+(h-e*h1))*(e+1))/2)-(5*map[X+b+1][Y+a+1]));
   carre[3].X := trunc((10*e*w1)+(b*(w-w1*e)));
   carre[3].Y := trunc(mapzoom.Height-(((h1+(h-e*h1))*(e+1))/2)-(5*map[X+b][Y+a+1]));
   arbre := false;
   for c := 0 to length(tree) - 1 do
   begin
    if (tree[c].X = X+b) and (tree[c].Y = Y+a) then
    begin
     arbre := true;
     if carre[0].X <= carre[3].X then
     begin
       mapzoom.Canvas.Polygon(carre);
       mapzoom.Canvas.StretchDraw(rect(carre[0].X,trunc(carre[0].Y - ((carre[1].X - carre[0].X)/(paintbox1.Width /20)) * bmptree.Height),carre[1].X,carre[0].Y),bmptree)
     end
     else
     begin
      mapzoom.Canvas.StretchDraw(rect(carre[0].X,trunc(carre[0].Y - (((carre[1].X - carre[0].X)/(paintbox1.Width /20)) * bmptree.Height)),carre[1].X,carre[0].Y),bmptree);
      mapzoom.Canvas.Polygon(carre);
     end;
    end
   end;
   if arbre = false then
    mapzoom.Canvas.Polygon(carre);
   end;
  end;
  paintbox1.Canvas.Draw(0,0,mapzoom);
end;

Bon Coding ...

ManChesTer.