1 /*
2 Copyright (c) 2017-2018 Timur Gafarov
3 
4 Boost Software License - Version 1.0 - August 17th, 2003
5 Permission is hereby granted, free of charge, to any person or organization
6 obtaining a copy of the software and accompanying documentation covered by
7 this license (the "Software") to use, reproduce, display, distribute,
8 execute, and transmit the Software, and to prepare derivative works of the
9 Software, and to permit third-parties to whom the Software is furnished to
10 do so, all subject to the following:
11 
12 The copyright notices in the Software and this entire statement, including
13 the above license grant, this restriction and the following disclaimer,
14 must be included in all copies of the Software, in whole or in part, and
15 all derivative works of the Software, unless such copies or derivative
16 works are solely in the form of machine-executable object code generated by
17 a source language processor.
18 
19 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
20 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
21 FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
22 SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
23 FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
24 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25 DEALINGS IN THE SOFTWARE.
26 */
27 
28 module dagon.graphics.materials.standard;
29 
30 import std.stdio;
31 import std.math;
32 
33 import dlib.core.memory;
34 import dlib.math.vector;
35 import dlib.math.matrix;
36 import dlib.math.transformation;
37 import dlib.math.interpolation;
38 import dlib.image.color;
39 
40 import derelict.opengl;
41 
42 import dagon.core.ownership;
43 import dagon.graphics.rc;
44 import dagon.graphics.shadow;
45 import dagon.graphics.clustered;
46 import dagon.graphics.texture;
47 import dagon.graphics.material;
48 import dagon.graphics.materials.generic;
49 
50 class StandardBackend: GLSLMaterialBackend
51 {
52     private string vsText = 
53     q{
54         #version 330 core
55         
56         uniform mat4 modelViewMatrix;
57         uniform mat4 normalMatrix;
58         uniform mat4 projectionMatrix;
59         
60         uniform mat4 invViewMatrix;
61         
62         uniform mat4 prevModelViewProjMatrix;
63         uniform mat4 blurModelViewProjMatrix;
64         
65         uniform mat4 shadowMatrix1;
66         uniform mat4 shadowMatrix2;
67         uniform mat4 shadowMatrix3;
68         
69         layout (location = 0) in vec3 va_Vertex;
70         layout (location = 1) in vec3 va_Normal;
71         layout (location = 2) in vec2 va_Texcoord;
72         
73         out vec4 position;
74         out vec4 blurPosition;
75         out vec4 prevPosition;
76         
77         out vec3 eyePosition;
78         out vec3 eyeNormal;
79         out vec2 texCoord;
80         
81         out vec3 worldPosition;
82         out vec3 worldView;
83         
84         out vec4 shadowCoord1;
85         out vec4 shadowCoord2;
86         out vec4 shadowCoord3;
87         
88         const float eyeSpaceNormalShift = 0.05;
89         
90         void main()
91         {
92             texCoord = va_Texcoord;
93             eyeNormal = (normalMatrix * vec4(va_Normal, 0.0)).xyz;
94             vec4 pos = modelViewMatrix * vec4(va_Vertex, 1.0);
95             eyePosition = pos.xyz;
96             
97             position = projectionMatrix * pos;
98             blurPosition = blurModelViewProjMatrix * vec4(va_Vertex, 1.0);
99             prevPosition = prevModelViewProjMatrix * vec4(va_Vertex, 1.0);
100             
101             worldPosition = (invViewMatrix * pos).xyz;
102 
103             vec3 worldCamPos = (invViewMatrix[3]).xyz;
104             worldView = worldPosition - worldCamPos;
105             
106             vec4 posShifted = pos + vec4(eyeNormal * eyeSpaceNormalShift, 0.0);
107             shadowCoord1 = shadowMatrix1 * posShifted;
108             shadowCoord2 = shadowMatrix2 * posShifted;
109             shadowCoord3 = shadowMatrix3 * posShifted;
110             
111             gl_Position = position;
112         }
113     };
114 
115     private string fsText =
116     q{
117         #version 330 core
118         
119         #define EPSILON 0.000001
120         #define PI 3.14159265359
121         const float PI2 = PI * 2.0;
122         
123         uniform mat4 viewMatrix;
124         uniform mat4 invViewMatrix;
125         
126         uniform mat4 shadowMatrix1;
127         uniform mat4 shadowMatrix2;
128         
129         uniform sampler2D diffuseTexture;
130         uniform sampler2D normalTexture;
131         uniform sampler2D emissionTexture;
132 
133         uniform sampler2D pbrTexture;
134         
135         uniform int parallaxMethod;
136         uniform float parallaxScale;
137         uniform float parallaxBias;
138 
139         uniform float emissionEnergy;
140         
141         uniform sampler2DArrayShadow shadowTextureArray;
142         uniform float shadowTextureSize;
143         uniform bool useShadows;
144         uniform vec4 shadowColor;
145         uniform float shadowBrightness;
146         uniform bool useHeightCorrectedShadows;
147         
148         uniform sampler2D environmentMap;
149         uniform bool useEnvironmentMap;
150         
151         uniform vec4 environmentColor;
152         uniform vec3 sunDirection;
153         uniform vec3 sunColor;
154         uniform float sunEnergy;
155         uniform vec4 fogColor;
156         uniform float fogStart;
157         uniform float fogEnd;
158         
159         uniform vec3 skyZenithColor;
160         uniform vec3 skyHorizonColor;
161         
162         uniform float invLightDomainSize;
163         uniform usampler2D lightClusterTexture;
164         uniform usampler1D lightIndexTexture;
165         uniform sampler2D lightsTexture;
166         
167         uniform float blurMask;
168         
169         uniform bool shaded;
170         uniform float transparency;
171         uniform bool usePCF;
172         //const bool shaded = true;
173         //const float transparency = 1.0;
174         //const bool usePCF = true;
175         
176         in vec3 eyePosition;
177         
178         in vec4 position;
179         in vec4 blurPosition;
180         in vec4 prevPosition;
181         
182         in vec3 eyeNormal;
183         in vec2 texCoord;
184         
185         in vec3 worldPosition;
186         in vec3 worldView;
187         
188         in vec4 shadowCoord1;
189         in vec4 shadowCoord2;
190         in vec4 shadowCoord3;
191 
192         layout(location = 0) out vec4 frag_color;
193         layout(location = 1) out vec4 frag_velocity;
194         layout(location = 2) out vec4 frag_luma;
195         layout(location = 3) out vec4 frag_position; // TODO: gbuffer prepass to do SSAO and SSLR
196         layout(location = 4) out vec4 frag_normal;   // TODO: gbuffer prepass to do SSAO and SSLR
197         
198         mat3 cotangentFrame(in vec3 N, in vec3 p, in vec2 uv)
199         {
200             vec3 dp1 = dFdx(p);
201             vec3 dp2 = dFdy(p);
202             vec2 duv1 = dFdx(uv);
203             vec2 duv2 = dFdy(uv);
204             vec3 dp2perp = cross(dp2, N);
205             vec3 dp1perp = cross(N, dp1);
206             vec3 T = dp2perp * duv1.x + dp1perp * duv2.x;
207             vec3 B = dp2perp * duv1.y + dp1perp * duv2.y;
208             float invmax = inversesqrt(max(dot(T, T), dot(B, B)));
209             return mat3(T * invmax, B * invmax, N);
210         }
211         
212         vec2 parallaxMapping(in vec3 V, in vec2 T, in float scale, out float h)
213         {
214             float height = texture(normalTexture, T).a;
215             h = height;
216             height = height * parallaxScale + parallaxBias;
217             return T + (height * V.xy);
218         }
219         
220         // Based on code written by Igor Dykhta (Sun and Black Cat)
221         // http://sunandblackcat.com/tipFullView.php?topicid=28
222         vec2 parallaxOcclusionMapping(in vec3 V, in vec2 T, in float scale, out float h)
223         {
224             const float minLayers = 10;
225             const float maxLayers = 15;
226             float numLayers = mix(maxLayers, minLayers, abs(dot(vec3(0, 0, 1), V)));
227 
228             float layerHeight = 1.0 / numLayers;
229             float curLayerHeight = 0;
230             vec2 dtex = scale * V.xy / V.z / numLayers;
231 
232             vec2 currentTextureCoords = T;
233             float heightFromTexture = texture(normalTexture, currentTextureCoords).a;
234             
235             h = heightFromTexture;
236 
237             while(heightFromTexture > curLayerHeight)
238             {
239                 curLayerHeight += layerHeight;
240                 currentTextureCoords += dtex;
241                 heightFromTexture = texture(normalTexture, currentTextureCoords).a;
242             }
243 
244             vec2 prevTCoords = currentTextureCoords - dtex;
245 
246             float nextH = heightFromTexture - curLayerHeight;
247             float prevH = texture(normalTexture, prevTCoords).a - curLayerHeight + layerHeight;
248             float weight = nextH / (nextH - prevH);
249             return prevTCoords * weight + currentTextureCoords * (1.0-weight);
250         }
251         
252         float shadowLookup(in sampler2DArrayShadow depths, in float layer, in vec4 coord, in vec2 offset)
253         {
254             float texelSize = 1.0 / shadowTextureSize;
255             vec2 v = offset * texelSize * coord.w;
256             vec4 c = (coord + vec4(v.x, v.y, 0.0, 0.0)) / coord.w;
257             c.w = c.z;
258             c.z = layer;
259             float s = texture(depths, c);
260             return s;
261         }
262         
263         float shadow(in sampler2DArrayShadow depths, in float layer, in vec4 coord, in float yshift)
264         {
265             return shadowLookup(depths, layer, coord, vec2(0.0, yshift));
266         }
267         
268         float shadowPCF(in sampler2DArrayShadow depths, in float layer, in vec4 coord, in float radius, in float yshift)
269         {
270             float s = 0.0;
271             float x, y;
272 	        for (y = -radius ; y < radius ; y += 1.0)
273 	        for (x = -radius ; x < radius ; x += 1.0)
274             {
275 	            s += shadowLookup(depths, layer, coord, vec2(x, y + yshift));
276             }
277 	        s /= radius * radius * 4.0;
278             return s;
279         }
280         
281         float weight(in vec4 tc, in float coef)
282         {
283             vec2 proj = vec2(tc.x / tc.w, tc.y / tc.w);
284             proj = (1.0 - abs(proj * 2.0 - 1.0)) * coef;
285             proj = clamp(proj, 0.0, 1.0);
286             return min(proj.x, proj.y);
287         }
288         
289         void sphericalAreaLightContrib(
290             in vec3 P, in vec3 N, in vec3 E, in vec3 R,
291             in vec3 lPos, in float lRadius,
292             in float shininess,
293             out float diff, out float spec)
294         {
295             vec3 positionToLightSource = lPos - P;
296 	        vec3 centerToRay = dot(positionToLightSource, R) * R - positionToLightSource;
297 	        vec3 closestPoint = positionToLightSource + centerToRay * clamp(lRadius / length(centerToRay), 0.0, 1.0);	
298 	        vec3 L = normalize(closestPoint);
299             float NH = dot(N, normalize(L + E));
300             spec = pow(max(NH, 0.0), shininess);
301             vec3 directionToLight = normalize(positionToLightSource);
302             diff = clamp(dot(N, directionToLight), 0.0, 1.0);
303         }
304         
305         vec3 fresnel(float cosTheta, vec3 f0)
306         {
307             return f0 + (1.0 - f0) * pow(1.0 - cosTheta, 5.0);
308         }
309 
310         vec3 fresnelRoughness(float cosTheta, vec3 f0, float roughness)
311         {
312             return f0 + (max(vec3(1.0 - roughness), f0) - f0) * pow(1.0 - cosTheta, 5.0);
313         }
314 
315         float distributionGGX(vec3 N, vec3 H, float roughness)
316         {
317             float a = roughness * roughness;
318             float a2 = a * a;
319             float NdotH = max(dot(N, H), 0.0);
320             float NdotH2 = NdotH * NdotH;
321             float num = a2;
322             float denom = max(NdotH2 * (a2 - 1.0) + 1.0, 0.001);
323             denom = PI * denom * denom;
324             return num / denom;
325         }
326 
327         float geometrySchlickGGX(float NdotV, float roughness)
328         {
329             float r = (roughness + 1.0);
330             float k = (r*r) / 8.0;
331             float num = NdotV;
332             float denom = NdotV * (1.0 - k) + k;
333             return num / denom;
334         }
335 
336         float geometrySmith(vec3 N, vec3 V, vec3 L, float roughness)
337         {
338             float NdotV = max(dot(N, V), 0.0);
339             float NdotL = max(dot(N, L), 0.0);
340             float ggx2  = geometrySchlickGGX(NdotV, roughness);
341             float ggx1  = geometrySchlickGGX(NdotL, roughness);
342             return ggx1 * ggx2;
343         }
344 
345         uniform vec3 groundColor;
346         uniform float skyEnergy;
347         uniform float groundEnergy;
348 
349         vec3 sky(vec3 wN, vec3 wSun, float roughness)
350         {            
351             float p1 = clamp(roughness, 0.5, 1.0);
352             float p2 = clamp(roughness, 0.4, 1.0);
353         
354             float horizonOrZenith = pow(clamp(dot(wN, vec3(0, 1, 0)), 0.0, 1.0), p1);
355             float groundOrSky = pow(clamp(dot(wN, vec3(0, -1, 0)), 0.0, 1.0), p2);
356 
357             vec3 env = mix(mix(skyHorizonColor * skyEnergy, groundColor * groundEnergy, groundOrSky), skyZenithColor * skyEnergy, horizonOrZenith);
358             
359             return env;
360         }
361         
362         vec2 envMapEquirect(vec3 dir)
363         {
364             float phi = acos(dir.y);
365             float theta = atan(dir.x, dir.z) + PI;
366             return vec2(theta / PI2, phi / PI);
367         }
368 
369         vec3 toLinear(vec3 v)
370         {
371             return pow(v, vec3(2.2));
372         }
373         
374         float luminance(vec3 color)
375         {
376             return (
377                 color.x * 0.27 +
378                 color.y * 0.67 +
379                 color.z * 0.06
380             );
381         }
382         
383         void main()
384         {     
385             // Common vectors
386             vec3 vN = normalize(eyeNormal);
387             vec3 N = vN;
388             vec3 E = normalize(-eyePosition);
389             mat3 TBN = cotangentFrame(N, eyePosition, texCoord);
390             vec3 tE = normalize(E * TBN);
391             
392             vec3 cameraPosition = invViewMatrix[3].xyz;
393             float linearDepth = -eyePosition.z;
394             
395             vec2 posScreen = (blurPosition.xy / blurPosition.w) * 0.5 + 0.5;
396             vec2 prevPosScreen = (prevPosition.xy / prevPosition.w) * 0.5 + 0.5;
397             vec2 screenVelocity = posScreen - prevPosScreen;
398 
399             // Parallax mapping
400             float height = 0.0;
401             vec2 shiftedTexCoord = texCoord;
402             if (parallaxMethod == 0)
403                 shiftedTexCoord = texCoord;
404             else if (parallaxMethod == 1)
405                 shiftedTexCoord = parallaxMapping(tE, texCoord, parallaxScale, height);
406             else if (parallaxMethod == 2)
407                 shiftedTexCoord = parallaxOcclusionMapping(tE, texCoord, parallaxScale, height);
408             
409             // Normal mapping
410             vec3 tN = normalize(texture(normalTexture, shiftedTexCoord).rgb * 2.0 - 1.0);
411             tN.y = -tN.y;
412             N = normalize(TBN * tN);
413              
414             // Calculate shadow from 3 cascades           
415             float s1, s2, s3;
416             if (shaded && useShadows)
417             {
418                 vec4 sc1 = useHeightCorrectedShadows? shadowMatrix1 * vec4(eyePosition + vN * height * 0.3, 1.0) : shadowCoord1;
419                 vec4 sc2 = useHeightCorrectedShadows? shadowMatrix2 * vec4(eyePosition + vN * height * 0.3, 1.0) : shadowCoord2;
420             
421                 s1 = usePCF? shadowPCF(shadowTextureArray, 0.0, sc1, 2.0, 0.0) : 
422                              shadow(shadowTextureArray, 0.0, sc1, 0.0);
423                 s2 = shadow(shadowTextureArray, 1.0, sc2, 0.0);
424                 s3 = shadow(shadowTextureArray, 2.0, shadowCoord3, 0.0);
425                 float w1 = weight(sc1, 8.0);
426                 float w2 = weight(sc2, 8.0);
427                 float w3 = weight(shadowCoord3, 8.0);
428                 s3 = mix(1.0, s3, w3); 
429                 s2 = mix(s3, s2, w2);
430                 s1 = mix(s2, s1, w1); // s1 stores resulting shadow value
431             }
432             else
433             {
434                 s1 = 1.0f;
435             }
436             
437             float roughness = texture(pbrTexture, shiftedTexCoord).r;
438             float metallic = texture(pbrTexture, shiftedTexCoord).g;
439             
440             vec3 R = reflect(E, N);
441             
442             vec3 worldN = N * mat3(viewMatrix);
443             vec3 worldR = reflect(normalize(worldView), worldN);
444             vec3 worldSun = sunDirection * mat3(viewMatrix);
445             
446             // Diffuse texture
447             vec4 diffuseColor = texture(diffuseTexture, shiftedTexCoord);
448             vec3 albedo = toLinear(diffuseColor.rgb);
449             
450             vec3 emissionColor = toLinear(texture(emissionTexture, shiftedTexCoord).rgb);
451             
452             vec3 f0 = vec3(0.04); 
453             f0 = mix(f0, albedo, metallic);
454             
455             vec3 Lo = vec3(0.0);
456             
457             // Sun light
458             float sunDiffuselight = 1.0;
459             // if (sunEnabled)
460             if (shaded)
461             {
462                 vec3 L = sunDirection;
463                 float NL = max(dot(N, L), 0.0); 
464                 vec3 H = normalize(E + L); 
465                 
466                 float NDF = distributionGGX(N, H, roughness);        
467                 float G = geometrySmith(N, E, L, roughness);
468                 vec3 F = fresnel(max(dot(H, E), 0.0), f0);
469                 
470                 vec3 kS = F;
471                 vec3 kD = vec3(1.0) - kS;
472                 kD *= 1.0 - metallic;
473 
474                 vec3 numerator = NDF * G * F;
475                 float denominator = 4.0 * max(dot(N, E), 0.0) * NL;
476                 vec3 specular = numerator / max(denominator, 0.001);
477                 
478                 sunDiffuselight = NL;
479 
480                 //shadow = mix(s1 * NL, 1.0, shadowBrightness);
481                 vec3 radiance = sunColor * sunEnergy * s1 * NL;
482                 Lo += (kD * albedo / PI + specular) * radiance;
483             }
484             
485             // Fetch light cluster slice
486             if (shaded)
487             {
488                 vec2 clusterCoord = (worldPosition.xz - cameraPosition.xz) * invLightDomainSize + 0.5;
489                 uint clusterIndex = texture(lightClusterTexture, clusterCoord).r;
490                 uint offset = (clusterIndex << 16) >> 16;
491                 uint size = (clusterIndex >> 16);
492                 
493                 // Point/area lights
494                 for (uint i = 0u; i < size; i++)
495                 {
496                     // Read light data
497                     uint u = texelFetch(lightIndexTexture, int(offset + i), 0).r;
498                     vec3 lightPos = texelFetch(lightsTexture, ivec2(u, 0), 0).xyz; 
499                     vec3 lightColor = toLinear(texelFetch(lightsTexture, ivec2(u, 1), 0).xyz); 
500                     vec3 lightProps = texelFetch(lightsTexture, ivec2(u, 2), 0).xyz;
501                     float lightRadius = lightProps.x;
502                     float lightAreaRadius = lightProps.y;
503                     float lightEnergy = lightProps.z;
504                     
505                     vec3 lightPosEye = (viewMatrix * vec4(lightPos, 1.0)).xyz;
506                     
507                     vec3 positionToLightSource = lightPosEye - eyePosition;
508                     float distanceToLight = length(positionToLightSource);
509                     vec3 directionToLight = normalize(positionToLightSource);                
510                     float attenuation = pow(clamp(1.0 - (distanceToLight / lightRadius), 0.0, 1.0), 2.0) * lightEnergy;
511                     
512                     vec3 Lpt = normalize(lightPosEye - eyePosition);
513 
514                     vec3 centerToRay = dot(positionToLightSource, R) * R - positionToLightSource;
515                     vec3 closestPoint = positionToLightSource + centerToRay * clamp(lightAreaRadius / length(centerToRay), 0.0, 1.0);
516                     vec3 L = normalize(closestPoint);  
517 
518                     float NL = max(dot(N, Lpt), 0.0); 
519                     vec3 H = normalize(E + L);
520                     
521                     float NDF = distributionGGX(N, H, roughness);        
522                     float G = geometrySmith(N, E, L, roughness);      
523                     vec3 F = fresnel(max(dot(H, E), 0.0), f0);
524                     
525                     vec3 kS = F;
526                     vec3 kD = vec3(1.0) - kS;
527                     kD *= 1.0 - metallic;
528 
529                     vec3 numerator = NDF * G * F;
530                     float denominator = 4.0 * max(dot(N, E), 0.0) * NL;
531                     vec3 specular = numerator / max(denominator, 0.001);
532                     
533                     vec3 radiance = lightColor * attenuation;
534                     
535                     Lo += (kD * albedo / PI + specular) * radiance * NL;
536                 }
537             }
538             
539             // Fog
540             float fogFactor = clamp((fogEnd - linearDepth) / (fogEnd - fogStart), 0.0, 1.0);
541             
542             // Environment light
543             if (shaded)
544             {
545                 vec3 ambientDiffuse;
546                 vec3 ambientSpecular;
547                 if (useEnvironmentMap)
548                 {
549                     ivec2 envMapSize = textureSize(environmentMap, 0);
550                     float maxLod = log2(float(max(envMapSize.x, envMapSize.y)));
551                     float diffLod = (maxLod - 1.0);
552                     float specLod = (maxLod - 1.0) * roughness;
553                     
554                     ambientDiffuse = textureLod(environmentMap, envMapEquirect(worldN), diffLod).rgb;
555                     ambientSpecular = textureLod(environmentMap, envMapEquirect(worldR), specLod).rgb;
556                 }
557                 else
558                 {
559                     ambientDiffuse = sky(worldN, worldSun, roughness);
560                     ambientSpecular = sky(worldR, worldSun, roughness);
561                 }
562                 
563                 float dayOrNight = float(worldSun.y < 0.0);
564                 
565                 float ambientBrightness = mix(s1 * sunDiffuselight, 1.0, mix(shadowBrightness, 1.0, dayOrNight));
566                 ambientDiffuse = ambientDiffuse * toLinear(shadowColor.rgb) * ambientBrightness;
567                 ambientSpecular = ambientSpecular * toLinear(shadowColor.rgb) * ambientBrightness;
568                 
569                 {
570                     vec3 F = fresnelRoughness(max(dot(N, E), 0.0), f0, roughness);
571                     vec3 kS = F;
572                     vec3 kD = 1.0 - kS;
573                     kD *= 1.0 - metallic;
574                     vec3 diffuse = ambientDiffuse * albedo;
575                     vec3 ambient = kD * diffuse + F * ambientSpecular;
576                     Lo += ambient;
577                 }
578             }
579             
580             vec3 emit = emissionColor + albedo * (1.0 - float(shaded));
581             
582             vec3 objColor = Lo + emit * emissionEnergy;
583             
584             vec3 fragColor = mix(fogColor.rgb, objColor, fogFactor);
585             float fresnelAlpha = shaded? pow(1.0 - max(0.0, dot(N, E)), 5.0) : 0.0; 
586             
587             float alpha = mix(diffuseColor.a * transparency, 1.0f, fresnelAlpha);
588             
589             frag_color = vec4(fragColor, alpha);
590             frag_velocity = vec4(screenVelocity, 0.0, blurMask);
591             frag_luma = vec4(luminance(fragColor));
592             frag_position = vec4(eyePosition.x, eyePosition.y, eyePosition.z, 0.0);
593             frag_normal = vec4(N, 0.0);
594         }
595     };
596     
597     override string vertexShaderSrc() {return vsText;}
598     override string fragmentShaderSrc() {return fsText;}
599 
600     GLint viewMatrixLoc;
601     GLint modelViewMatrixLoc;
602     GLint projectionMatrixLoc;
603     GLint normalMatrixLoc;
604     GLint invViewMatrixLoc;
605     
606     GLint prevModelViewProjMatrixLoc;
607     GLint blurModelViewProjMatrixLoc;
608     
609     GLint shadowMatrix1Loc;
610     GLint shadowMatrix2Loc; 
611     GLint shadowMatrix3Loc;
612     GLint shadowTextureArrayLoc;
613     GLint shadowTextureSizeLoc;
614     GLint useShadowsLoc;
615     GLint shadowColorLoc;
616     GLint shadowBrightnessLoc;
617     GLint useHeightCorrectedShadowsLoc;
618 
619     GLint pbrTextureLoc;
620     
621     GLint parallaxMethodLoc;
622     GLint parallaxScaleLoc;
623     GLint parallaxBiasLoc;
624     
625     GLint diffuseTextureLoc;
626     GLint normalTextureLoc;
627     GLint emissionTextureLoc;
628     GLint emissionEnergyLoc;
629     
630     GLint environmentMapLoc;
631     GLint useEnvironmentMapLoc;
632     
633     GLint environmentColorLoc;
634     GLint sunDirectionLoc;
635     GLint sunColorLoc;
636     GLint sunEnergyLoc;
637     GLint fogStartLoc;
638     GLint fogEndLoc;
639     GLint fogColorLoc;
640     
641     GLint skyZenithColorLoc;
642     GLint skyHorizonColorLoc;
643     GLint skyEnergyLoc;
644     GLint groundColorLoc;
645     GLint groundEnergyLoc;
646     
647     GLint invLightDomainSizeLoc;
648     GLint clusterTextureLoc;
649     GLint lightsTextureLoc;
650     GLint indexTextureLoc;
651     
652     GLint blurMaskLoc;
653     
654     GLint shadedLoc;
655     GLint transparencyLoc;
656     GLint usePCFLoc;
657     
658     ClusteredLightManager lightManager;
659     CascadedShadowMap shadowMap;
660     Matrix4x4f defaultShadowMat;
661     Vector3f defaultLightDir;
662     
663     this(ClusteredLightManager clm, Owner o)
664     {
665         super(o);
666         
667         lightManager = clm;
668 
669         viewMatrixLoc = glGetUniformLocation(shaderProgram, "viewMatrix");
670         modelViewMatrixLoc = glGetUniformLocation(shaderProgram, "modelViewMatrix");
671         projectionMatrixLoc = glGetUniformLocation(shaderProgram, "projectionMatrix");
672         normalMatrixLoc = glGetUniformLocation(shaderProgram, "normalMatrix");
673         invViewMatrixLoc = glGetUniformLocation(shaderProgram, "invViewMatrix");
674         
675         prevModelViewProjMatrixLoc = glGetUniformLocation(shaderProgram, "prevModelViewProjMatrix");
676         blurModelViewProjMatrixLoc = glGetUniformLocation(shaderProgram, "blurModelViewProjMatrix");
677         
678         shadowMatrix1Loc = glGetUniformLocation(shaderProgram, "shadowMatrix1");
679         shadowMatrix2Loc = glGetUniformLocation(shaderProgram, "shadowMatrix2");
680         shadowMatrix3Loc = glGetUniformLocation(shaderProgram, "shadowMatrix3");
681         shadowTextureArrayLoc = glGetUniformLocation(shaderProgram, "shadowTextureArray");
682         shadowTextureSizeLoc = glGetUniformLocation(shaderProgram, "shadowTextureSize");
683         useShadowsLoc = glGetUniformLocation(shaderProgram, "useShadows");
684         shadowColorLoc = glGetUniformLocation(shaderProgram, "shadowColor");
685         shadowBrightnessLoc = glGetUniformLocation(shaderProgram, "shadowBrightness");
686         useHeightCorrectedShadowsLoc = glGetUniformLocation(shaderProgram, "useHeightCorrectedShadows");
687 
688         pbrTextureLoc = glGetUniformLocation(shaderProgram, "pbrTexture");
689        
690         parallaxMethodLoc = glGetUniformLocation(shaderProgram, "parallaxMethod");
691         parallaxScaleLoc = glGetUniformLocation(shaderProgram, "parallaxScale");
692         parallaxBiasLoc = glGetUniformLocation(shaderProgram, "parallaxBias");
693         
694         diffuseTextureLoc = glGetUniformLocation(shaderProgram, "diffuseTexture");
695         normalTextureLoc = glGetUniformLocation(shaderProgram, "normalTexture");
696         emissionTextureLoc = glGetUniformLocation(shaderProgram, "emissionTexture");
697         emissionEnergyLoc = glGetUniformLocation(shaderProgram, "emissionEnergy");
698         
699         environmentMapLoc = glGetUniformLocation(shaderProgram, "environmentMap");
700         useEnvironmentMapLoc = glGetUniformLocation(shaderProgram, "useEnvironmentMap");
701         
702         environmentColorLoc = glGetUniformLocation(shaderProgram, "environmentColor");
703         sunDirectionLoc = glGetUniformLocation(shaderProgram, "sunDirection");
704         sunColorLoc = glGetUniformLocation(shaderProgram, "sunColor");
705         sunEnergyLoc = glGetUniformLocation(shaderProgram, "sunEnergy");
706         fogStartLoc = glGetUniformLocation(shaderProgram, "fogStart");
707         fogEndLoc = glGetUniformLocation(shaderProgram, "fogEnd");
708         fogColorLoc = glGetUniformLocation(shaderProgram, "fogColor");
709         groundColorLoc = glGetUniformLocation(shaderProgram, "groundColor");
710         groundEnergyLoc = glGetUniformLocation(shaderProgram, "groundEnergy");
711         
712         skyZenithColorLoc = glGetUniformLocation(shaderProgram, "skyZenithColor");
713         skyHorizonColorLoc = glGetUniformLocation(shaderProgram, "skyHorizonColor");
714         skyEnergyLoc = glGetUniformLocation(shaderProgram, "skyEnergy");
715         
716         clusterTextureLoc = glGetUniformLocation(shaderProgram, "lightClusterTexture");
717         invLightDomainSizeLoc = glGetUniformLocation(shaderProgram, "invLightDomainSize");
718         lightsTextureLoc = glGetUniformLocation(shaderProgram, "lightsTexture");
719         indexTextureLoc = glGetUniformLocation(shaderProgram, "lightIndexTexture");
720         
721         blurMaskLoc = glGetUniformLocation(shaderProgram, "blurMask");
722         
723         shadedLoc = glGetUniformLocation(shaderProgram, "shaded");
724         transparencyLoc = glGetUniformLocation(shaderProgram, "transparency");
725         usePCFLoc = glGetUniformLocation(shaderProgram, "usePCF");
726     }
727     
728     override void bind(GenericMaterial mat, RenderingContext* rc)
729     {
730         auto idiffuse = "diffuse" in mat.inputs;
731         auto inormal = "normal" in mat.inputs;
732         auto iheight = "height" in mat.inputs;
733         auto iemission = "emission" in mat.inputs;
734         auto iEnergy = "energy" in mat.inputs;
735         auto ipbr = "pbr" in mat.inputs;
736         auto iroughness = "roughness" in mat.inputs;
737         auto imetallic = "metallic" in mat.inputs;
738         bool fogEnabled = boolProp(mat, "fogEnabled");
739         bool shadowsEnabled = boolProp(mat, "shadowsEnabled");
740         int parallaxMethod = intProp(mat, "parallax");
741         if (parallaxMethod > ParallaxOcclusionMapping)
742             parallaxMethod = ParallaxOcclusionMapping;
743         if (parallaxMethod < 0)
744             parallaxMethod = 0;
745                 
746         auto ishadeless = "shadeless" in mat.inputs;
747         auto itransparency = "transparency" in mat.inputs;
748         auto ishadowFilter = "shadowFilter" in mat.inputs;
749         
750         glUseProgram(shaderProgram);
751         
752         glUniform1f(blurMaskLoc, rc.blurMask);
753         
754         // Matrices
755         glUniformMatrix4fv(viewMatrixLoc, 1, GL_FALSE, rc.viewMatrix.arrayof.ptr);
756         glUniformMatrix4fv(modelViewMatrixLoc, 1, GL_FALSE, rc.modelViewMatrix.arrayof.ptr);
757         glUniformMatrix4fv(projectionMatrixLoc, 1, GL_FALSE, rc.projectionMatrix.arrayof.ptr);
758         glUniformMatrix4fv(normalMatrixLoc, 1, GL_FALSE, rc.normalMatrix.arrayof.ptr);
759         glUniformMatrix4fv(invViewMatrixLoc, 1, GL_FALSE, rc.invViewMatrix.arrayof.ptr);
760         
761         glUniformMatrix4fv(prevModelViewProjMatrixLoc, 1, GL_FALSE, rc.prevModelViewProjMatrix.arrayof.ptr);
762         glUniformMatrix4fv(blurModelViewProjMatrixLoc, 1, GL_FALSE, rc.blurModelViewProjMatrix.arrayof.ptr);
763         
764         // Environment parameters
765         Color4f environmentColor = Color4f(0.0f, 0.0f, 0.0f, 1.0f);
766         Vector4f sunHGVector = Vector4f(0.0f, 1.0f, 0.0, 0.0f);
767         Vector3f sunColor = Vector3f(1.0f, 1.0f, 1.0f);
768         float sunEnergy = 100.0f;
769         if (rc.environment)
770         {
771             environmentColor = rc.environment.ambientConstant;
772             sunHGVector = Vector4f(rc.environment.sunDirection);
773             sunHGVector.w = 0.0;
774             sunColor = rc.environment.sunColor;
775             sunEnergy = rc.environment.sunEnergy;
776         }
777         glUniform4fv(environmentColorLoc, 1, environmentColor.arrayof.ptr);
778         Vector3f sunDirectionEye = sunHGVector * rc.viewMatrix;
779         glUniform3fv(sunDirectionLoc, 1, sunDirectionEye.arrayof.ptr);
780         glUniform3fv(sunColorLoc, 1, sunColor.arrayof.ptr);
781         glUniform1f(sunEnergyLoc, sunEnergy);
782         Color4f fogColor = Color4f(0.0f, 0.0f, 0.0f, 1.0f);
783         float fogStart = float.max;
784         float fogEnd = float.max;
785         if (fogEnabled)
786         {
787             if (rc.environment)
788             {                
789                 fogColor = rc.environment.fogColor;
790                 fogStart = rc.environment.fogStart;
791                 fogEnd = rc.environment.fogEnd;
792             }
793         }
794         glUniform4fv(fogColorLoc, 1, fogColor.arrayof.ptr);
795         glUniform1f(fogStartLoc, fogStart);
796         glUniform1f(fogEndLoc, fogEnd);
797         
798         Color4f skyZenithColor = environmentColor;
799         Color4f skyHorizonColor = environmentColor;
800         float skyEnergy = 1.0f;
801         Color4f groundColor = environmentColor;
802         float groundEnergy = 1.0f;
803         if (rc.environment)
804         {
805             skyZenithColor = rc.environment.skyZenithColor;
806             skyHorizonColor = rc.environment.skyHorizonColor;
807             groundColor = rc.environment.groundColor;
808             skyEnergy = rc.environment.skyEnergy;
809             groundEnergy = rc.environment.groundEnergy;
810         }
811         glUniform3fv(skyZenithColorLoc, 1, skyZenithColor.arrayof.ptr);
812         glUniform3fv(skyHorizonColorLoc, 1, skyHorizonColor.arrayof.ptr);
813         glUniform1f(skyEnergyLoc, skyEnergy);
814         glUniform3fv(groundColorLoc, 1, groundColor.arrayof.ptr);
815         glUniform1f(groundEnergyLoc, groundEnergy);
816                 
817         // Texture 0 - diffuse texture
818         if (idiffuse.texture is null)
819         {
820             Color4f color = Color4f(idiffuse.asVector4f);
821             idiffuse.texture = makeOnePixelTexture(mat, color);
822         }
823         glActiveTexture(GL_TEXTURE0);
824         idiffuse.texture.bind();
825         glUniform1i(diffuseTextureLoc, 0);
826         
827         // Texture 1 - normal map + parallax map
828         float parallaxScale = 0.03f;
829         float parallaxBias = -0.01f;
830         bool normalTexturePrepared = inormal.texture !is null;
831         if (normalTexturePrepared) 
832             normalTexturePrepared = inormal.texture.image.channels == 4;
833         if (!normalTexturePrepared)
834         {
835             if (inormal.texture is null)
836             {
837                 Color4f color = Color4f(0.5f, 0.5f, 1.0f, 0.0f); // default normal pointing upwards
838                 inormal.texture = makeOnePixelTexture(mat, color);
839             }
840             else
841             {
842                 if (iheight.texture !is null)
843                     packAlphaToTexture(inormal.texture, iheight.texture);
844                 else
845                     packAlphaToTexture(inormal.texture, 0.0f);
846             }
847         }
848         glActiveTexture(GL_TEXTURE1);
849         inormal.texture.bind();
850         glUniform1i(normalTextureLoc, 1);
851         glUniform1f(parallaxScaleLoc, parallaxScale);
852         glUniform1f(parallaxBiasLoc, parallaxBias);
853         glUniform1i(parallaxMethodLoc, parallaxMethod);
854         
855         // Texture 2 is - PBR maps (roughness + metallic)
856         if (ipbr is null)
857         {
858             mat.setInput("pbr", 0.0f);
859             ipbr = "pbr" in mat.inputs;
860         }
861         
862         if (ipbr.texture is null)
863         {       
864             ipbr.texture = makeTextureFrom(mat, *iroughness, *imetallic, materialInput(0.0f), materialInput(0.0f));
865         }
866         glActiveTexture(GL_TEXTURE2);
867         glUniform1i(pbrTextureLoc, 2);
868         ipbr.texture.bind();
869         
870         // Texture 3 - emission map
871         if (iemission.texture is null)
872         {
873             Color4f color = Color4f(iemission.asVector4f);
874             iemission.texture = makeOnePixelTexture(mat, color);
875         }
876         glActiveTexture(GL_TEXTURE3);
877         iemission.texture.bind();
878         glUniform1i(emissionTextureLoc, 3);
879         glUniform1f(emissionEnergyLoc, iEnergy.asFloat); 
880         
881         // Texture 4 - environment map
882         bool useEnvmap = false;
883         if (rc.environment)
884         {
885             if (rc.environment.environmentMap)
886                 useEnvmap = true;
887         }
888         
889         if (useEnvmap)
890         {
891             glActiveTexture(GL_TEXTURE4);
892             rc.environment.environmentMap.bind();
893             glUniform1i(useEnvironmentMapLoc, 1);
894         }
895         else
896         {
897             glUniform1i(useEnvironmentMapLoc, 0);
898         }
899         glUniform1i(environmentMapLoc, 4);
900         
901         // Texture 5 - shadow map cascades (3 layer texture array)
902         float shadowBrightness = 0.1f;
903         bool useHeightCorrectedShadows = false;
904         Color4f shadowColor = Color4f(1.0f, 1.0f, 1.0f, 1.0f);
905         if (shadowMap && shadowsEnabled)
906         {
907             glActiveTexture(GL_TEXTURE5);
908             glBindTexture(GL_TEXTURE_2D_ARRAY, shadowMap.depthTexture);
909 
910             glUniform1i(shadowTextureArrayLoc, 5);
911             glUniform1f(shadowTextureSizeLoc, cast(float)shadowMap.size);
912             glUniformMatrix4fv(shadowMatrix1Loc, 1, 0, shadowMap.area1.shadowMatrix.arrayof.ptr);
913             glUniformMatrix4fv(shadowMatrix2Loc, 1, 0, shadowMap.area2.shadowMatrix.arrayof.ptr);
914             glUniformMatrix4fv(shadowMatrix3Loc, 1, 0, shadowMap.area3.shadowMatrix.arrayof.ptr);
915             glUniform1i(useShadowsLoc, 1);            
916             // TODO: shadowFilter
917             
918             shadowBrightness = shadowMap.shadowBrightness;
919             useHeightCorrectedShadows = shadowMap.useHeightCorrectedShadows;
920             shadowColor = shadowMap.shadowColor;
921         }
922         else
923         {        
924             glUniformMatrix4fv(shadowMatrix1Loc, 1, 0, defaultShadowMat.arrayof.ptr);
925             glUniformMatrix4fv(shadowMatrix2Loc, 1, 0, defaultShadowMat.arrayof.ptr);
926             glUniformMatrix4fv(shadowMatrix3Loc, 1, 0, defaultShadowMat.arrayof.ptr);
927             glUniform1i(useShadowsLoc, 0);
928         }
929         glUniform4fv(shadowColorLoc, 1, shadowColor.arrayof.ptr);
930         glUniform1f(shadowBrightnessLoc, shadowBrightness);
931         glUniform1i(useHeightCorrectedShadowsLoc, useHeightCorrectedShadows);
932 
933         // Texture 6 - light clusters
934         glActiveTexture(GL_TEXTURE6);
935         lightManager.bindClusterTexture();
936         glUniform1i(clusterTextureLoc, 6);
937         glUniform1f(invLightDomainSizeLoc, lightManager.invSceneSize);
938         
939         // Texture 7 - light data
940         glActiveTexture(GL_TEXTURE7);
941         lightManager.bindLightTexture();
942         glUniform1i(lightsTextureLoc, 7);
943         
944         // Texture 8 - light indices per cluster
945         glActiveTexture(GL_TEXTURE8);
946         lightManager.bindIndexTexture();
947         glUniform1i(indexTextureLoc, 8);
948         
949         bool shaded = true;
950         if (ishadeless)
951             shaded = !(ishadeless.asBool);
952         glUniform1i(shadedLoc, shaded);
953 
954         float transparency = 1.0f;
955         if (itransparency)
956             transparency = itransparency.asFloat;
957         glUniform1f(transparencyLoc, transparency);
958         
959         bool usePCF = false;
960         if (ishadowFilter)
961             usePCF = (ishadowFilter.asInteger == ShadowFilterPCF);
962         glUniform1i(usePCFLoc, usePCF);
963         
964         glActiveTexture(GL_TEXTURE0);
965     }
966     
967     override void unbind(GenericMaterial mat, RenderingContext* rc)
968     {
969         auto idiffuse = "diffuse" in mat.inputs;
970         auto inormal = "normal" in mat.inputs;
971         auto iemission = "emission" in mat.inputs;
972         auto ipbr = "pbr" in mat.inputs;
973         
974         glActiveTexture(GL_TEXTURE0);
975         idiffuse.texture.unbind();
976         
977         glActiveTexture(GL_TEXTURE1);
978         inormal.texture.unbind();
979         
980         glActiveTexture(GL_TEXTURE1);
981         ipbr.texture.unbind();
982         
983         glActiveTexture(GL_TEXTURE3);
984         iemission.texture.unbind();
985         
986         bool useEnvmap = false;
987         if (rc.environment)
988         {
989             if (rc.environment.environmentMap)
990                 useEnvmap = true;
991         }
992         
993         if (useEnvmap)
994         {
995             glActiveTexture(GL_TEXTURE4);
996             rc.environment.environmentMap.unbind();
997         }
998 
999         glActiveTexture(GL_TEXTURE5);
1000         glBindTexture(GL_TEXTURE_2D_ARRAY, 0);
1001         
1002         glActiveTexture(GL_TEXTURE6);
1003         lightManager.unbindClusterTexture();
1004         
1005         glActiveTexture(GL_TEXTURE7);
1006         lightManager.unbindLightTexture();
1007         
1008         glActiveTexture(GL_TEXTURE8);
1009         lightManager.unbindIndexTexture();
1010         
1011         glActiveTexture(GL_TEXTURE0);
1012         
1013         glUseProgram(0);
1014     }
1015 }