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