Difference between revisions of "BGRABitmap tutorial 9"

From Free Pascal wiki
Jump to navigationJump to search
m (Text replace - "delphi>" to "syntaxhighlight>")
m (→‎Phong shading and light: Fixed syntax highlighting)
 
(4 intermediate revisions by 3 users not shown)
Line 7: Line 7:
 
=== Create a new project ===
 
=== Create a new project ===
  
Create a new project and add a reference to [[BGRABitmap]], the same way as in [[BGRABitmap tutorial|the first tutorial]].
+
Create a new project and add a reference to [[BGRABitmap]], the same way as in [[BGRABitmap tutorial 1|the first tutorial]].
  
 
=== Phong shading and light ===
 
=== Phong shading and light ===
Line 13: Line 13:
 
To use phong shading, you need to instanciate a TPhongShading class. It's located in BGRAGradients unit.
 
To use phong shading, you need to instanciate a TPhongShading class. It's located in BGRAGradients unit.
  
Let's add a variable in the form definition :
+
Let's add a variable in the form definition:
<syntaxhighlight>TForm1 = class(TForm)  
+
 
 +
<syntaxhighlight lang="pascal">
 +
TForm1 = class(TForm)  
 
   ...
 
   ...
 
   phong: TPhongShading;    </syntaxhighlight>
 
   phong: TPhongShading;    </syntaxhighlight>
  
When the form is created, we can create the class :
+
When the form is created, we can create the class:
<syntaxhighlight>procedure TForm1.FormCreate(Sender: TObject);
+
 
 +
<syntaxhighlight lang="pascal">
 +
procedure TForm1.FormCreate(Sender: TObject);
 
begin
 
begin
 
   phong := TPhongShading.Create;
 
   phong := TPhongShading.Create;
Line 27: Line 31:
 
   phong.LightSourceIntensity := 250;
 
   phong.LightSourceIntensity := 250;
 
   phong.LightSourceDistanceTerm := 200;   
 
   phong.LightSourceDistanceTerm := 200;   
end;  </syntaxhighlight>
+
end;   
 +
</syntaxhighlight>
  
 
The specular index indicates how concentrated the reflected light is.
 
The specular index indicates how concentrated the reflected light is.
  
When the form is destroyed :
+
When the form is destroyed:
<syntaxhighlight>procedure TForm1.FormDestroy(Sender: TObject);
+
 
 +
<syntaxhighlight lang="pascal">
 +
procedure TForm1.FormDestroy(Sender: TObject);
 
begin
 
begin
 
   phong.Free;
 
   phong.Free;
end; </syntaxhighlight>
+
end;  
 +
</syntaxhighlight>
 +
 
 +
When the form is painted, add some phong shaded object:
  
When the form is painted, add some phong shaded object :
+
<syntaxhighlight lang="pascal">
<syntaxhighlight>var
+
procedure TForm1.FormPaint(Sender: TObject);
 +
var
 
   image: TBGRABitmap;
 
   image: TBGRABitmap;
  
Line 48: Line 59:
 
     image.Draw(Canvas,0,0,True);
 
     image.Draw(Canvas,0,0,True);
 
     image.free;
 
     image.free;
end;  </syntaxhighlight>
+
end;   
 +
</syntaxhighlight>
  
 
The parameter of DrawSphere are the destination image, the bounds of the object, the maximum altitude and the color. The diameter of the sphere is 100 so the maximum altitude of a hemisphere is 50.
 
The parameter of DrawSphere are the destination image, the bounds of the object, the maximum altitude and the color. The diameter of the sphere is 100 so the maximum altitude of a hemisphere is 50.
  
Finally when the mouse is moved, it would be nice that the light source followed :
+
Finally when the mouse is moved, it would be nice that the light source followed:
<syntaxhighlight>procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
+
 
 +
<syntaxhighlight lang="pascal">
 +
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 
   Y: Integer);
 
   Y: Integer);
 
begin
 
begin
 
   phong.LightPosition := point(X,Y);
 
   phong.LightPosition := point(X,Y);
 
   FormPaint(Sender);
 
   FormPaint(Sender);
end;   </syntaxhighlight>
+
end;
 +
</syntaxhighlight>
  
 
=== Run the program ===
 
=== Run the program ===
  
You should be able to play with the light on the sphere :
+
You should be able to play with the light on the sphere:
  
 
[[Image:BGRATutorial9a.png]]
 
[[Image:BGRATutorial9a.png]]
Line 68: Line 83:
 
=== Use phong shading to create textures ===
 
=== Use phong shading to create textures ===
  
The following procedure creates a piece of chocolate :
+
The following procedure creates a piece of chocolate:
<syntaxhighlight>function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
+
 
 +
<syntaxhighlight lang="pascal">
 +
function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
 
var
 
var
 
   square,map: TBGRABitmap;
 
   square,map: TBGRABitmap;
Line 102: Line 119:
 
   map.Free;
 
   map.Free;
 
   phong.Free;
 
   phong.Free;
end; </syntaxhighlight>
+
end;  
 +
</syntaxhighlight>
  
 
The phong shader uses a map of altitudes to render the light effects. Here, the map contains a square.
 
The phong shader uses a map of altitudes to render the light effects. Here, the map contains a square.
Line 108: Line 126:
 
Among properties of the phong shader, there is LightSourceDistanceFactor and LightDestFactor. Setting these values to zero make the result tilable. Indeed, when the distance factor is zero, the distance between the light and the object is not taken into account, and when the light destination factor is zero, the position of the object is not taken into account when computing the angle of the light.
 
Among properties of the phong shader, there is LightSourceDistanceFactor and LightDestFactor. Setting these values to zero make the result tilable. Indeed, when the distance factor is zero, the distance between the light and the object is not taken into account, and when the light destination factor is zero, the position of the object is not taken into account when computing the angle of the light.
  
Now, when the form is created, create the chocolate texture :
+
Now, when the form is created, create the chocolate texture:
<syntaxhighlight> chocolate := CreateChocolateTexture(80,80);  </syntaxhighlight>
+
 
 +
<syntaxhighlight lang="pascal">
 +
  chocolate := CreateChocolateTexture(80,80);   
 +
</syntaxhighlight>
 +
 
 +
And when the form is destroyed:
 +
 
 +
<syntaxhighlight lang="pascal">
 +
  chocolate.Free;
 +
</syntaxhighlight>
  
And when the form is destroyed :
+
Before phong.DrawSphere in the OnPaint event, add this line:
<syntaxhighlight>  chocolate.Free; </syntaxhighlight>
 
  
Before phong.DrawSphere in the OnPaint event, add this line :
+
<syntaxhighlight lang="pascal">
<syntaxhighlight>   image.FillRect(0,0,80*7,80*4,chocolate,dmSet);  </syntaxhighlight>
+
    image.FillRect(0,0,80*7,80*4,chocolate,dmSet);   
 +
</syntaxhighlight>
  
 
=== Resulting code ===
 
=== Resulting code ===
  
<syntaxhighlight>unit UMain;
+
<syntaxhighlight lang="pascal">
 +
unit UMain;
  
 
{$mode objfpc}{$H+}
 
{$mode objfpc}{$H+}
Line 221: Line 249:
 
   {$I UMain.lrs}
 
   {$I UMain.lrs}
  
end.    </syntaxhighlight>
+
end.     
 +
</syntaxhighlight>
  
 
=== Run the program ===
 
=== Run the program ===
  
You should see a nice bar of chocolate with a big cherry :
+
You should see a nice bar of chocolate with a big cherry:
  
 
[[Image:BGRATutorial9b.png]]
 
[[Image:BGRATutorial9b.png]]
Line 231: Line 260:
 
=== Using Perlin noise and phong shading together ===
 
=== Using Perlin noise and phong shading together ===
  
The idea is to create a map with a Perlin noise, and then use phong shading to render it. Here is how to create a stone texture :
+
The idea is to create a map with a Perlin noise, and then use phong shading to render it. Here is how to create a stone texture:
  
<syntaxhighlight> function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
+
<syntaxhighlight lang="pascal">
 +
  function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
 
   var
 
   var
 
     temp: TBGRABitmap;
 
     temp: TBGRABitmap;
Line 252: Line 282:
 
     phong.Free;
 
     phong.Free;
 
     temp.Free;
 
     temp.Free;
   end;  </syntaxhighlight>
+
   end;   
 +
</syntaxhighlight>
  
 
First, we create a cyclic map. It's important that it be cyclic in order to make a tilable texture. But then, when we will apply phong shading, we need to make the shader aware of the cycle. So, with GetPart, we extract the generated map with 2 more pixels on each border, so the shader can be applied to the map with the cycle.
 
First, we create a cyclic map. It's important that it be cyclic in order to make a tilable texture. But then, when we will apply phong shading, we need to make the shader aware of the cycle. So, with GetPart, we extract the generated map with 2 more pixels on each border, so the shader can be applied to the map with the cycle.
Line 258: Line 289:
 
The call to phong.Draw with offset (-2,-2) renders the map at the correct location, taking into account that we've added two pixels.
 
The call to phong.Draw with offset (-2,-2) renders the map at the correct location, taking into account that we've added two pixels.
  
Now in the OnPaint event :
+
Now in the OnPaint event:
<syntaxhighlight>procedure TForm1.FormPaint(Sender: TObject);
+
 
 +
<syntaxhighlight lang="pascal">
 +
procedure TForm1.FormPaint(Sender: TObject);
 
var
 
var
 
   image: TBGRABitmap;
 
   image: TBGRABitmap;
Line 272: Line 305:
 
     image.Draw(Canvas,0,0,True);
 
     image.Draw(Canvas,0,0,True);
 
     image.free;
 
     image.free;
end;</syntaxhighlight>
+
end;
 +
</syntaxhighlight>
  
 
=== Run the program ===
 
=== Run the program ===
Line 282: Line 316:
 
=== Rendering water ===
 
=== Rendering water ===
  
It is almost the same procedure to generate water texture :
+
It is almost the same procedure to generate water texture:
  
<syntaxhighlight>function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
+
<syntaxhighlight lang="pascal">
 +
function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
 
const blurSize = 5;
 
const blurSize = 5;
 
var
 
var
Line 307: Line 342:
 
   phong.Free;
 
   phong.Free;
 
   temp.Free;
 
   temp.Free;
end; </syntaxhighlight>
+
end;  
 +
</syntaxhighlight>
  
 
The main difference is that we apply a blur filter to make it the water smooth and set the light color.
 
The main difference is that we apply a blur filter to make it the water smooth and set the light color.
Line 316: Line 352:
  
 
It is possible to keep only a small subrange of altitudes, to have a texture that shows foot prints in the snow.
 
It is possible to keep only a small subrange of altitudes, to have a texture that shows foot prints in the snow.
<syntaxhighlight>function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
+
 
 +
<syntaxhighlight lang="pascal">
 +
function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
 
var
 
var
 
   v: integer;
 
   v: integer;
Line 355: Line 393:
 
   phong.Free;
 
   phong.Free;
 
   temp.Free;
 
   temp.Free;
end;  </syntaxhighlight>
+
end;   
 +
</syntaxhighlight>
  
We obtain this :
+
We obtain this:
  
 
[[Image:BGRATutorial9e.png]]
 
[[Image:BGRATutorial9e.png]]
Line 364: Line 403:
  
 
[[Category:Graphics]]
 
[[Category:Graphics]]
 +
[[Category: BGRABitmap]]

Latest revision as of 13:02, 2 January 2020

Deutsch (de) English (en) français (fr) русский (ru)


Home | Tutorial 1 | Tutorial 2 | Tutorial 3 | Tutorial 4 | Tutorial 5 | Tutorial 6 | Tutorial 7 | Tutorial 8 | Tutorial 9 | Tutorial 10 | Tutorial 11 | Tutorial 12 | Tutorial 13 | Tutorial 14 | Tutorial 15 | Tutorial 16 | Edit

This tutorial shows how to use phong shading to make textures.

Create a new project

Create a new project and add a reference to BGRABitmap, the same way as in the first tutorial.

Phong shading and light

To use phong shading, you need to instanciate a TPhongShading class. It's located in BGRAGradients unit.

Let's add a variable in the form definition:

TForm1 = class(TForm) 
  ...
  phong: TPhongShading;

When the form is created, we can create the class:

procedure TForm1.FormCreate(Sender: TObject);
begin
  phong := TPhongShading.Create;
  phong.LightPositionZ := 150;
  phong.SpecularIndex := 20;
  phong.AmbientFactor := 0.4;
  phong.LightSourceIntensity := 250;
  phong.LightSourceDistanceTerm := 200;  
end;

The specular index indicates how concentrated the reflected light is.

When the form is destroyed:

procedure TForm1.FormDestroy(Sender: TObject);
begin
  phong.Free;
end;

When the form is painted, add some phong shaded object:

procedure TForm1.FormPaint(Sender: TObject);
var
  image: TBGRABitmap;

begin
    image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));

    phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));

    image.Draw(Canvas,0,0,True);
    image.free;
end;

The parameter of DrawSphere are the destination image, the bounds of the object, the maximum altitude and the color. The diameter of the sphere is 100 so the maximum altitude of a hemisphere is 50.

Finally when the mouse is moved, it would be nice that the light source followed:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  phong.LightPosition := point(X,Y);
  FormPaint(Sender);
end;

Run the program

You should be able to play with the light on the sphere:

BGRATutorial9a.png

Use phong shading to create textures

The following procedure creates a piece of chocolate:

function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
  square,map: TBGRABitmap;
  phong: TPhongShading;
  margin: integer;
begin
  margin := tx div 20; //empty space around the square
  square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);

  //create a map with the square at the middle
  map := TBGRABitmap.Create(tx,ty,BGRABlack);
  map.PutImage(margin,margin,square,dmDrawWithTransparency);

  //apply blur to make it smoother
  BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
  square.free;

  //create resulting bitmap
  result := TBGRABitmap.Create(tx,ty);

  //use phong shading
  phong := TPhongShading.Create;
  phong.LightSourceDistanceFactor := 0;
  phong.LightDestFactor := 0;
  phong.LightSourceIntensity := 200;
  phong.AmbientFactor := 0.5;
  phong.LightPosition := Point(-50,-100);
  phong.LightPositionZ := 80;

  //draw the piece of chocolate with max altitude 20
  phong.Draw(result,map,20,0,0,BGRA(86,41,38));
  map.Free;
  phong.Free;
end;

The phong shader uses a map of altitudes to render the light effects. Here, the map contains a square.

Among properties of the phong shader, there is LightSourceDistanceFactor and LightDestFactor. Setting these values to zero make the result tilable. Indeed, when the distance factor is zero, the distance between the light and the object is not taken into account, and when the light destination factor is zero, the position of the object is not taken into account when computing the angle of the light.

Now, when the form is created, create the chocolate texture:

  chocolate := CreateChocolateTexture(80,80);

And when the form is destroyed:

  chocolate.Free;

Before phong.DrawSphere in the OnPaint event, add this line:

    image.FillRect(0,0,80*7,80*4,chocolate,dmSet);

Resulting code

unit UMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Buttons, BGRABitmap, BGRABitmapTypes, BGRAGradients;

type
  { TForm1 }

  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    phong: TPhongShading;
    chocolate: TBGRABitmap;
  end; 

var
  Form1: TForm1; 

implementation

function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
  square,map: TBGRABitmap;
  phong: TPhongShading;
  margin: integer;
begin
  margin := tx div 20;
  square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
  map := TBGRABitmap.Create(tx,ty,BGRABlack);
  map.PutImage(margin,margin,square,dmDrawWithTransparency);
  BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
  square.free;

  result := TBGRABitmap.Create(tx,ty);
  phong := TPhongShading.Create;
  phong.LightSourceDistanceFactor := 0;
  phong.LightDestFactor := 0;
  phong.LightSourceIntensity := 200;
  phong.AmbientFactor := 0.5;
  phong.LightPosition := Point(-50,-100);
  phong.LightPositionZ := 80;
  phong.Draw(result,map,20,0,0,BGRA(86,41,38));
  map.Free;
  phong.Free;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  phong := TPhongShading.Create;
  phong.LightPositionZ := 150;
  phong.SpecularIndex := 20;
  phong.AmbientFactor := 0.4;
  phong.LightSourceIntensity := 250;
  phong.LightSourceDistanceTerm := 200;

  chocolate := CreateChocolateTexture(80,80);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  phong.Free;
  chocolate.Free;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  phong.LightPosition := point(X,Y);
  FormPaint(Sender);
end;


procedure TForm1.FormPaint(Sender: TObject);
var
  image: TBGRABitmap;
begin
    image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));

    image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
    phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));

    image.Draw(Canvas,0,0,True);
    image.free;
end;

initialization
  {$I UMain.lrs}

end.

Run the program

You should see a nice bar of chocolate with a big cherry:

BGRATutorial9b.png

Using Perlin noise and phong shading together

The idea is to create a map with a Perlin noise, and then use phong shading to render it. Here is how to create a stone texture:

  function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
  var
    temp: TBGRABitmap;
    phong: TPhongShading;
  begin
    result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,0.6);
    temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;

    phong := TPhongShading.Create;
    phong.LightSourceDistanceFactor := 0;
    phong.LightDestFactor := 0;
    phong.LightSourceIntensity := 100;
    phong.LightPositionZ := 100;
    phong.NegativeDiffusionFactor := 0.3;
    phong.AmbientFactor := 0.5;
    phong.Draw(result,temp,30,-2,-2,BGRA(170,170,170));

    phong.Free;
    temp.Free;
  end;

First, we create a cyclic map. It's important that it be cyclic in order to make a tilable texture. But then, when we will apply phong shading, we need to make the shader aware of the cycle. So, with GetPart, we extract the generated map with 2 more pixels on each border, so the shader can be applied to the map with the cycle.

The call to phong.Draw with offset (-2,-2) renders the map at the correct location, taking into account that we've added two pixels.

Now in the OnPaint event:

procedure TForm1.FormPaint(Sender: TObject);
var
  image: TBGRABitmap;
  stone: TBGRABitmap;
begin
    image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));

    stone := CreateStoneTexture(100,100);
    image.FillEllipseAntialias(200,100,150,50,stone);
    stone.free;

    image.Draw(Canvas,0,0,True);
    image.free;
end;

Run the program

You should see a form with a stoned background.

BGRATutorial9c.png

Rendering water

It is almost the same procedure to generate water texture:

function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
const blurSize = 5;
var
  temp: TBGRABitmap;
  phong: TPhongShading;
begin
  result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
  temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize)) as TBGRABitmap;
  BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));

  phong := TPhongShading.Create;
  phong.LightSourceDistanceFactor := 0;
  phong.LightDestFactor := 0;
  phong.LightSourceIntensity := 150;
  phong.LightPositionZ := 80;
  phong.LightColor := BGRA(105,233,240);
  phong.NegativeDiffusionFactor := 0.3;
  phong.SpecularIndex := 20;
  phong.AmbientFactor := 0.4;

  phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));
  phong.Free;
  temp.Free;
end;

The main difference is that we apply a blur filter to make it the water smooth and set the light color.

BGRATutorial9d.png

Using thresholds to render snow prints

It is possible to keep only a small subrange of altitudes, to have a texture that shows foot prints in the snow.

function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
var
  v: integer;
  p: PBGRAPixel;
  i: Integer;

  temp: TBGRABitmap;
  phong: TPhongShading;
begin
  //here a random map is generated
  result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);

  //now we apply thresholds
  p := result.Data;
  for i := 0 to result.NbPixels-1 do
  begin
    v := p^.red;
    //if the value is above 80 or under 50, then we divide it by 10 to make it almost horizontal
    if v > 80 then v := (v-80) div 10+80;
    if v < 50 then v := 50-(50-v) div 10;
    p^.red := v;
    p^.green := v;
    p^.blue := v;
    inc(p);
  end;

  //to make phong shader aware of the cycle
  temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
  //apply a radial blur
  BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
  phong := TPhongShading.Create;
  phong.LightSourceDistanceFactor := 0;
  phong.LightDestFactor := 0;
  phong.LightSourceIntensity := 100;
  phong.LightPositionZ := 100;
  phong.NegativeDiffusionFactor := 0.3; //want shadows
  phong.Draw(result,temp,30,-2,-2,BGRAWhite);
  phong.Free;
  temp.Free;
end;

We obtain this:

BGRATutorial9e.png

Previous tutorial (textures) Next tutorial (texture mapping)