BGRABitmap tutorial 9: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: BGRABitmap tutorial 9

New		Line
1	+	This tutorial shows how to use phong shading to make textures.
2	+
3	+	### Create a new project
4	+
5	+	Create a new project and add a reference to [[BGRABitmap]], the same way as in [[BGRABitmap tutorial 1\|the first tutorial]].
6	+
7	+	### Phong shading and light
8	+
9	+	To use phong shading, you need to instanciate a TPhongShading class. It's located in BGRAGradients unit.
10	+
11	+	Let's add a variable in the form definition:
12	+
13	+	``` pascal
14	+	TForm1 = class(TForm)
15	+	...
16	+	phong: TPhongShading;
17	+	```
18	+
19	+	When the form is created, we can create the class:
20	+
21	+	``` pascal
22	+	procedure TForm1.FormCreate(Sender: TObject);
23	+	begin
24	+	phong := TPhongShading.Create;
25	+	phong.LightPositionZ := 150;
26	+	phong.SpecularIndex := 20;
27	+	phong.AmbientFactor := 0.4;
28	+	phong.LightSourceIntensity := 250;
29	+	phong.LightSourceDistanceTerm := 200;
30	+	end;
31	+	```
32	+
33	+	The specular index indicates how concentrated the reflected light is.
34	+
35	+	When the form is destroyed:
36	+
37	+	``` pascal
38	+	procedure TForm1.FormDestroy(Sender: TObject);
39	+	begin
40	+	phong.Free;
41	+	end;
42	+	```
43	+
44	+	When the form is painted, add some phong shaded object:
45	+
46	+	``` pascal
47	+	procedure TForm1.FormPaint(Sender: TObject);
48	+	var
49	+	image: TBGRABitmap;
50	+
51	+	begin
52	+	image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
53	+
54	+	phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
55	+
56	+	image.Draw(Canvas,0,0,True);
57	+	image.free;
58	+	end;
59	+	```
60	+
61	+	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.
62	+
63	+	Finally when the mouse is moved, it would be nice that the light source followed:
64	+
65	+	``` pascal
66	+	procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
67	+	Y: Integer);
68	+	begin
69	+	phong.LightPosition := point(X,Y);
70	+	FormPaint(Sender);
71	+	end;
72	+	```
73	+
74	+	### Run the program
75	+
76	+	You should be able to play with the light on the sphere:
77	+
78	+	<figure>
79	+	<img src="BGRATutorial9a.png" title="BGRATutorial9a.png" />
80	+	<figcaption>BGRATutorial9a.png</figcaption>
81	+	</figure>
82	+
83	+	### Use phong shading to create textures
84	+
85	+	The following procedure creates a piece of chocolate:
86	+
87	+	``` pascal
88	+	function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
89	+	var
90	+	square,map: TBGRABitmap;
91	+	phong: TPhongShading;
92	+	margin: integer;
93	+	begin
94	+	margin := tx div 20; //empty space around the square
95	+	square := CreateRectangleMap(tx-2margin,ty-2margin,tx div 8);
96	+
97	+	//create a map with the square at the middle
98	+	map := TBGRABitmap.Create(tx,ty,BGRABlack);
99	+	map.PutImage(margin,margin,square,dmDrawWithTransparency);
100	+
101	+	//apply blur to make it smoother
102	+	BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
103	+	square.free;
104	+
105	+	//create resulting bitmap
106	+	result := TBGRABitmap.Create(tx,ty);
107	+
108	+	//use phong shading
109	+	phong := TPhongShading.Create;
110	+	phong.LightSourceDistanceFactor := 0;
111	+	phong.LightDestFactor := 0;
112	+	phong.LightSourceIntensity := 200;
113	+	phong.AmbientFactor := 0.5;
114	+	phong.LightPosition := Point(-50,-100);
115	+	phong.LightPositionZ := 80;
116	+
117	+	//draw the piece of chocolate with max altitude 20
118	+	phong.Draw(result,map,20,0,0,BGRA(86,41,38));
119	+	map.Free;
120	+	phong.Free;
121	+	end;
122	+	```
123	+
124	+	The phong shader uses a map of altitudes to render the light effects. Here, the map contains a square.
125	+
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.
127	+
128	+	Now, when the form is created, create the chocolate texture:
129	+
130	+	``` pascal
131	+	chocolate := CreateChocolateTexture(80,80);
132	+	```
133	+
134	+	And when the form is destroyed:
135	+
136	+	``` pascal
137	+	chocolate.Free;
138	+	```
139	+
140	+	Before phong.DrawSphere in the OnPaint event, add this line:
141	+
142	+	``` pascal
143	+	image.FillRect(0,0,807,804,chocolate,dmSet);
144	+	```
145	+
146	+	### Resulting code
147	+
148	+	``` pascal
149	+	unit UMain;
150	+
151	+	{$mode objfpc}{$H+}
152	+
153	+	interface
154	+
155	+	uses
156	+	Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
157	+	ExtCtrls, Buttons, BGRABitmap, BGRABitmapTypes, BGRAGradients;
158	+
159	+	type
160	+	{ TForm1 }
161	+
162	+	TForm1 = class(TForm)
163	+	Timer1: TTimer;
164	+	procedure FormCreate(Sender: TObject);
165	+	procedure FormDestroy(Sender: TObject);
166	+	procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
167	+	procedure FormPaint(Sender: TObject);
168	+	private
169	+	{ private declarations }
170	+	public
171	+	{ public declarations }
172	+	phong: TPhongShading;
173	+	chocolate: TBGRABitmap;
174	+	end;
175	+
176	+	var
177	+	Form1: TForm1;
178	+
179	+	implementation
180	+
181	+	function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
182	+	var
183	+	square,map: TBGRABitmap;
184	+	phong: TPhongShading;
185	+	margin: integer;
186	+	begin
187	+	margin := tx div 20;
188	+	square := CreateRectangleMap(tx-2margin,ty-2margin,tx div 8);
189	+	map := TBGRABitmap.Create(tx,ty,BGRABlack);
190	+	map.PutImage(margin,margin,square,dmDrawWithTransparency);
191	+	BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
192	+	square.free;
193	+
194	+	result := TBGRABitmap.Create(tx,ty);
195	+	phong := TPhongShading.Create;
196	+	phong.LightSourceDistanceFactor := 0;
197	+	phong.LightDestFactor := 0;
198	+	phong.LightSourceIntensity := 200;
199	+	phong.AmbientFactor := 0.5;
200	+	phong.LightPosition := Point(-50,-100);
201	+	phong.LightPositionZ := 80;
202	+	phong.Draw(result,map,20,0,0,BGRA(86,41,38));
203	+	map.Free;
204	+	phong.Free;
205	+	end;
206	+
207	+	{ TForm1 }
208	+
209	+	procedure TForm1.FormCreate(Sender: TObject);
210	+	begin
211	+	phong := TPhongShading.Create;
212	+	phong.LightPositionZ := 150;
213	+	phong.SpecularIndex := 20;
214	+	phong.AmbientFactor := 0.4;
215	+	phong.LightSourceIntensity := 250;
216	+	phong.LightSourceDistanceTerm := 200;
217	+
218	+	chocolate := CreateChocolateTexture(80,80);
219	+	end;
220	+
221	+	procedure TForm1.FormDestroy(Sender: TObject);
222	+	begin
223	+	phong.Free;
224	+	chocolate.Free;
225	+	end;
226	+
227	+	procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
228	+	Y: Integer);
229	+	begin
230	+	phong.LightPosition := point(X,Y);
231	+	FormPaint(Sender);
232	+	end;
233	+
234	+	procedure TForm1.FormPaint(Sender: TObject);
235	+	var
236	+	image: TBGRABitmap;
237	+	begin
238	+	image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
239	+
240	+	image.FillRect(0,0,807,804,chocolate,dmSet);
241	+	phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
242	+
243	+	image.Draw(Canvas,0,0,True);
244	+	image.free;
245	+	end;
246	+
247	+	initialization
248	+	{$I UMain.lrs}
249	+
250	+	end.
251	+	```
252	+
253	+	### Run the program
254	+
255	+	You should see a nice bar of chocolate with a big cherry:
256	+
257	+	<figure>
258	+	<img src="BGRATutorial9b.png" title="BGRATutorial9b.png" />
259	+	<figcaption>BGRATutorial9b.png</figcaption>
260	+	</figure>
261	+
262	+	### Using Perlin noise and phong shading together
263	+
264	+	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:
265	+
266	+	``` pascal
267	+	function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
268	+	var
269	+	temp: TBGRABitmap;
270	+	phong: TPhongShading;
271	+	begin
272	+	result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,0.6);
273	+	temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
274	+
275	+	phong := TPhongShading.Create;
276	+	phong.LightSourceDistanceFactor := 0;
277	+	phong.LightDestFactor := 0;
278	+	phong.LightSourceIntensity := 100;
279	+	phong.LightPositionZ := 100;
280	+	phong.NegativeDiffusionFactor := 0.3;
281	+	phong.AmbientFactor := 0.5;
282	+	phong.Draw(result,temp,30,-2,-2,BGRA(170,170,170));
283	+
284	+	phong.Free;
285	+	temp.Free;
286	+	end;
287	+	```
288	+
289	+	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.
290	+
291	+	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.
292	+
293	+	Now in the OnPaint event:
294	+
295	+	``` pascal
296	+	procedure TForm1.FormPaint(Sender: TObject);
297	+	var
298	+	image: TBGRABitmap;
299	+	stone: TBGRABitmap;
300	+	begin
301	+	image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
302	+
303	+	stone := CreateStoneTexture(100,100);
304	+	image.FillEllipseAntialias(200,100,150,50,stone);
305	+	stone.free;
306	+
307	+	image.Draw(Canvas,0,0,True);
308	+	image.free;
309	+	end;
310	+	```
311	+
312	+	### Run the program
313	+
314	+	You should see a form with a stoned background.
315	+
316	+	<figure>
317	+	<img src="BGRATutorial9c.png" title="BGRATutorial9c.png" />
318	+	<figcaption>BGRATutorial9c.png</figcaption>
319	+	</figure>
320	+
321	+	### Rendering water
322	+
323	+	It is almost the same procedure to generate water texture:
324	+
325	+	``` pascal
326	+	function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
327	+	const blurSize = 5;
328	+	var
329	+	temp: TBGRABitmap;
330	+	phong: TPhongShading;
331	+	begin
332	+	result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
333	+	temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize)) as TBGRABitmap;
334	+	BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));
335	+
336	+	phong := TPhongShading.Create;
337	+	phong.LightSourceDistanceFactor := 0;
338	+	phong.LightDestFactor := 0;
339	+	phong.LightSourceIntensity := 150;
340	+	phong.LightPositionZ := 80;
341	+	phong.LightColor := BGRA(105,233,240);
342	+	phong.NegativeDiffusionFactor := 0.3;
343	+	phong.SpecularIndex := 20;
344	+	phong.AmbientFactor := 0.4;
345	+
346	+	phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));
347	+	phong.Free;
348	+	temp.Free;
349	+	end;
350	+	```
351	+
352	+	The main difference is that we apply a blur filter to make it the water smooth and set the light color.
353	+
354	+	<figure>
355	+	<img src="BGRATutorial9d.png" title="BGRATutorial9d.png" />
356	+	<figcaption>BGRATutorial9d.png</figcaption>
357	+	</figure>
358	+
359	+	### Using thresholds to render snow prints
360	+
361	+	It is possible to keep only a small subrange of altitudes, to have a texture that shows foot prints in the snow.
362	+
363	+	``` pascal
364	+	function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
365	+	var
366	+	v: integer;
367	+	p: PBGRAPixel;
368	+	i: Integer;
369	+
370	+	temp: TBGRABitmap;
371	+	phong: TPhongShading;
372	+	begin
373	+	//here a random map is generated
374	+	result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
375	+
376	+	//now we apply thresholds
377	+	p := result.Data;
378	+	for i := 0 to result.NbPixels-1 do
379	+	begin
380	+	v := p^.red;
381	+	//if the value is above 80 or under 50, then we divide it by 10 to make it almost horizontal
382	+	if v > 80 then v := (v-80) div 10+80;
383	+	if v < 50 then v := 50-(50-v) div 10;
384	+	p^.red := v;
385	+	p^.green := v;
386	+	p^.blue := v;
387	+	inc(p);
388	+	end;
389	+
390	+	//to make phong shader aware of the cycle
391	+	temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
392	+	//apply a radial blur
393	+	BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
394	+	phong := TPhongShading.Create;
395	+	phong.LightSourceDistanceFactor := 0;
396	+	phong.LightDestFactor := 0;
397	+	phong.LightSourceIntensity := 100;
398	+	phong.LightPositionZ := 100;
399	+	phong.NegativeDiffusionFactor := 0.3; //want shadows
400	+	phong.Draw(result,temp,30,-2,-2,BGRAWhite);
401	+	phong.Free;
402	+	temp.Free;
403	+	end;
404	+	```
405	+
406	+	We obtain this:
407	+
408	+	<figure>
409	+	<img src="BGRATutorial9e.png" title="BGRATutorial9e.png" />
410	+	<figcaption>BGRATutorial9e.png</figcaption>
411	+	</figure>
412	+
413	+	[[BGRABitmap tutorial 8\|Previous tutorial (textures)]] [[BGRABitmap tutorial 10\|Next tutorial (texture mapping)]]
414	+
415	+	---
416	+	From the Free Pascal wiki, page "BGRABitmap tutorial 9", as it stood on 2020-01-02 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).
417	+	Category: BGRABitmap
418	+	Category: Graphics

Back to history