$ mvn -C clean install
<dependency> <groupId>com.io7m.r1</groupId> <artifactId>io7m-r1-kernel</artifactId> <version>0.10.0</version> </dependency>
Copyright © 2014 <code@io7m.com> http://io7m.com Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
module LightDiffuse where import qualified Color3 import qualified Direction import qualified Normal import qualified Spaces import qualified Vector3f diffuse :: Direction.T Spaces.Eye -> Normal.T -> Color3.T -> Float -> Vector3f.T diffuse stl n light_color light_intensity = let factor = max 0.0 (Vector3f.dot3 stl n) light_scaled = Vector3f.scale light_color light_intensity in Vector3f.scale light_scaled factor
Type | Description |
---|---|
RMatrixI3x3F<T extends RTransformType> | Immutable 3x3 matrix type |
RMatrixI4x4F<T extends RTransformType> | Immutable 4x4 matrix type |
RMatrixM4x4F<T extends RTransformType> | Mutable 4x4 matrix type |
RMatrixM3x3F<T extends RTransformType> | Mutable 3x3 matrix type |
RVectorI2F<T extends RTransformType> | Immutable 2D vector type |
RVectorI3F<T extends RTransformType> | Immutable 3D vector type |
RVectorI4F<T extends RTransformType> | Immutable 4D vector type |
RVectorM3F<T extends RTransformType> | Mutable 3D vector type |
RVectorM4F<T extends RTransformType> | Mutable 4D vector type |
cube = { (-0.5, -0.5, -0.5), ( 0.5, -0.5, -0.5), ( 0.5, -0.5, 0.5), (-0.5, -0.5, 0.5), (-0.5, 0.5, -0.5), ( 0.5, 0.5, -0.5), ( 0.5, 0.5, 0.5), (-0.5, 0.5, 0.5) }
After clipping and division by w, depth coordinates range from -1 to 1, corresponding to the near and far clipping planes. glDepthRange specifies a linear mapping of the normalized depth coordinates in this range to window depth coordinates. Regardless of the actual depth buffer implementation, window coordinate depth values are treated as though they range from 0 through 1 (like color components). Thus, the values accepted by glDepthRange are both clamped to this range before they are accepted. The setting of (0,1) maps the near plane to 0 and the far plane to 1. With this mapping, the depth buffer range is fully utilized.
/* * Copyright © 2014 <code@io7m.com> http://io7m.com * * Permission to use, copy, modify, and/or distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY * SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR * IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ package com.io7m.r1.documentation.examples; import com.io7m.jfunctional.Unit; import com.io7m.junreachable.UnreachableCodeException; import com.io7m.r1.kernel.types.KMaterialAlbedoTextured; import com.io7m.r1.kernel.types.KMaterialAlbedoType; import com.io7m.r1.kernel.types.KMaterialAlbedoUntextured; import com.io7m.r1.kernel.types.KMaterialAlbedoVisitorType; import com.io7m.r1.types.RException; /** * An example of pattern matching on materials. */ public final class Match0 { private Match0() { throw new UnreachableCodeException(); } public static void whichAlbedoType( final KMaterialAlbedoType m) throws RException { m .albedoAccept(new KMaterialAlbedoVisitorType<Unit, UnreachableCodeException>() { @Override public Unit textured( final KMaterialAlbedoTextured mt) { System.out.println("Textured"); return Unit.unit(); } @Override public Unit untextured( final KMaterialAlbedoUntextured mu) { System.out.println("Untextured"); return Unit.unit(); } }); } }
module Albedo where import qualified Color4 import qualified Vector4f albedo :: Color4.T -> Float -> Color4.T -> Color4.T albedo base mix t = Vector4f.interpolate base ((Vector4f.w t) * mix) t
Name | Type | Description |
---|---|---|
v_position | vector_3f | The object-space position of the vertex |
v_normal | vector_3f | The object-space normal vector of the vertex |
v_uv | vector_2f | The UV coordinates of the vertex |
v_tangent | vector_4f | The tangent vector of the vertex |
module NormalCompress where import qualified Vector3f import qualified Vector2f import qualified Normal compress :: Normal.T -> Vector2f.T compress n = let p = sqrt ((Vector3f.z n * 8.0) + 8.0) x = (Vector3f.x n / p) + 0.5 y = (Vector3f.y n / p) + 0.5 in Vector2f.V2 x y
module NormalDecompress where import qualified Vector3f import qualified Vector2f import qualified Normal decompress :: Vector2f.T -> Normal.T decompress v = let fn = Vector2f.V2 ((Vector2f.x v * 4.0) - 2.0) ((Vector2f.y v * 4.0) - 2.0) f = Vector2f.dot2 fn fn g = sqrt (1.0 - (f / 4.0)) x = (Vector2f.x fn) * g y = (Vector2f.y fn) * g z = 1.0 - (f / 2.0) in Vector3f.V3 x y z
module ScreenToTexture where import qualified Vector2f screen_to_texture :: Vector2f.T -> Float -> Float -> Vector2f.T screen_to_texture position width height = let u = (Vector2f.x position) / width v = (Vector2f.y position) / height in Vector2f.V2 u v
module ScreenDepthToNDC where screen_depth_to_ndc :: Float -> Float screen_depth_to_ndc screen_depth = (screen_depth * 2.0) - 1.0
module ClipSpaceZLong where import qualified Matrix4f as M4x4; import qualified Vector4f as V4; clip_z_long :: M4x4.T -> V4.T -> Float clip_z_long m eye = let m20 = M4x4.row_column m (2, 0) m21 = M4x4.row_column m (2, 1) m22 = M4x4.row_column m (2, 2) m23 = M4x4.row_column m (2, 3) k0 = (V4.x eye) * m20 k1 = (V4.y eye) * m21 k2 = (V4.z eye) * m22 k3 = (V4.w eye) * m23 in k0 + k1 + k2 + k3
module ClipSpaceWLong where import qualified Matrix4f as M4x4; import qualified Vector4f as V4; clip_w_long :: M4x4.T -> V4.T -> Float clip_w_long m eye = let m30 = M4x4.row_column m (3, 0) m31 = M4x4.row_column m (3, 1) m32 = M4x4.row_column m (3, 2) m33 = M4x4.row_column m (3, 3) k0 = (V4.x eye) * m30 k1 = (V4.y eye) * m31 k2 = (V4.z eye) * m32 k3 = (V4.w eye) * m33 in k0 + k1 + k2 + k3
module ClipSpaceZSimple where import qualified Matrix4f as M4x4; import qualified Vector4f as V4; clip_z_simple :: M4x4.T -> V4.T -> Float clip_z_simple m eye = let m22 = M4x4.row_column m (2, 2) m23 = M4x4.row_column m (2, 3) in ((V4.z eye) * m22) + m23
module ClipSpaceWSimple where import qualified Matrix4f as M4x4; import qualified Vector4f as V4; clip_w_simple :: M4x4.T -> V4.T -> Float clip_w_simple m eye = let m32 = M4x4.row_column m (3, 2) m33 = M4x4.row_column m (3, 3) in ((V4.z eye) * m32) + m33
module EyeSpaceZ where import qualified Matrix4f as M4x4; eye_z :: M4x4.T -> Float -> Float eye_z m ndc_z = let m22 = M4x4.row_column m (2, 2) m23 = M4x4.row_column m (2, 3) m32 = M4x4.row_column m (3, 2) m33 = M4x4.row_column m (3, 3) a = (ndc_z * m33) - m32 b = (ndc_z * m23) - m22 in - (a / b)
module NDCCorners where import qualified Vector4f as V4 near_x0y0 :: V4.T near_x0y0 = V4.V4 (-1.0) (-1.0) (-1.0) 1.0 near_x1y0 :: V4.T near_x1y0 = V4.V4 1.0 (-1.0) (-1.0) 1.0 near_x0y1 :: V4.T near_x0y1 = V4.V4 (-1.0) 1.0 (-1.0) 1.0 near_x1y1 :: V4.T near_x1y1 = V4.V4 1.0 1.0 (-1.0) 1.0 far_x0y0 :: V4.T far_x0y0 = V4.V4 (-1.0) (-1.0) 1.0 1.0 far_x1y0 :: V4.T far_x1y0 = V4.V4 1.0 (-1.0) 1.0 1.0 far_x0y1 :: V4.T far_x0y1 = V4.V4 (-1.0) 1.0 1.0 1.0 far_x1y1 :: V4.T far_x1y1 = V4.V4 1.0 1.0 1.0 1.0
module RayAndQ where import qualified Matrix4f as M4x4 import qualified Vector4f as V4 -- | Calculate @(ray, q)@ for the given inverse projection matrix and frustum corners ray_and_q :: M4x4.T -> (V4.T, V4.T) -> (V4.T, V4.T) ray_and_q inverse_m (near, far) = let -- Unproject the NDC coordinates to eye-space near_hom = M4x4.mult_v inverse_m near near_eye = V4.div_s near_hom (V4.w near_hom) far_hom = M4x4.mult_v inverse_m far far_eye = V4.div_s far_hom (V4.w far_hom) -- Calculate a ray with ray.z == 1.0 ray_initial = V4.sub4 far_eye near_eye ray = V4.div_s ray_initial (V4.z ray_initial) -- Subtract the scaled ray from the near corner to calculate q q = V4.sub4 near_eye (V4.scale ray (V4.z near_eye)) in (ray, q)
module RayAndQAll where import qualified NDCCorners import qualified RayAndQ import qualified Matrix4f as M4x4 import qualified Vector4f as V4 data T = T { q_x0y0 :: V4.T, q_x1y0 :: V4.T, q_x0y1 :: V4.T, q_x1y1 :: V4.T, ray_x0y0 :: V4.T, ray_x1y0 :: V4.T, ray_x0y1 :: V4.T, ray_x1y1 :: V4.T } deriving (Eq, Ord, Show) -- | Calculate all rays and qs for the four pairs of near/far frustum corners calculate :: M4x4.T -> T calculate inverse_m = let (x0y0_ray, x0y0_q) = RayAndQ.ray_and_q inverse_m (NDCCorners.near_x0y0, NDCCorners.far_x0y0) (x1y0_ray, x1y0_q) = RayAndQ.ray_and_q inverse_m (NDCCorners.near_x1y0, NDCCorners.far_x1y0) (x0y1_ray, x0y1_q) = RayAndQ.ray_and_q inverse_m (NDCCorners.near_x0y1, NDCCorners.far_x0y1) (x1y1_ray, x1y1_q) = RayAndQ.ray_and_q inverse_m (NDCCorners.near_x1y1, NDCCorners.far_x1y1) in T { q_x0y0 = x0y0_q, q_x1y0 = x1y0_q, q_x0y1 = x0y1_q, q_x1y1 = x1y1_q, ray_x0y0 = x0y0_ray, ray_x1y0 = x1y0_ray, ray_x0y1 = x0y1_ray, ray_x1y1 = x1y1_ray }
module Bilinear4 where import qualified Vector2f as V2 import qualified Vector4f as V4 interpolate :: (V4.T, V4.T, V4.T, V4.T) -> V2.T -> V4.T interpolate (x0y0, x1y0, x0y1, x1y1) position = let u0 = V4.interpolate x0y0 (V2.x position) x1y0 u1 = V4.interpolate x0y1 (V2.x position) x1y1 in V4.interpolate u0 (V2.y position) u1
-- -- Copyright © 2014 <code@io7m.com> http://io7m.com -- -- Permission to use, copy, modify, and/or distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR -- IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package com.io7m.r1.core; -- -- Functions for handling logarithmic depth buffers. -- module LogDepth is import com.io7m.parasol.Float as F; function prepare_eye_z (z : float) : float = F.add (F.negate (z), 1.0); function encode_partial ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); value clamp_z = F.maximum (0.000001, z); in F.multiply (F.log2 (clamp_z), half_co) end; function encode_full ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); value clamp_z = F.maximum (0.000001, F.add (z, 1.0)); in F.multiply (F.log2 (clamp_z), half_co) end; function decode ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); in F.subtract (F.power (2.0, F.divide (z, half_co)), 1.0) end; end;
-- -- Copyright © 2014 <code@io7m.com> http://io7m.com -- -- Permission to use, copy, modify, and/or distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR -- IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package com.io7m.r1.core; -- -- Position reconstruction for deferred rendering. -- module Reconstruction is import com.io7m.parasol.Float as F; import com.io7m.parasol.Vector2f as V2; import com.io7m.parasol.Vector3f as V3; import com.io7m.parasol.Vector4f as V4; import com.io7m.r1.core.Bilinear; import com.io7m.r1.core.Transform; import com.io7m.r1.core.Viewport; import com.io7m.r1.core.ViewRays; function reconstruct_eye ( screen_depth : float, screen_uv : vector_2f, m_projection : matrix_4x4f, view_rays : ViewRays.t ) : vector_4f = let value eye_depth = Transform.ndc_to_eye_z ( m_projection, Transform.screen_depth_to_ndc (screen_depth) ); in reconstruct_eye_with_eye_z ( eye_depth, screen_uv, m_projection, view_rays ) end; function reconstruct_eye_with_eye_z ( eye_depth : float, screen_uv : vector_2f, m_projection : matrix_4x4f, view_rays : ViewRays.t ) : vector_4f = let value origin = Bilinear.interpolate_3f ( view_rays.origin_x0y0, view_rays.origin_x1y0, view_rays.origin_x0y1, view_rays.origin_x1y1, screen_uv ); value ray_normal = Bilinear.interpolate_3f ( view_rays.ray_x0y0, view_rays.ray_x1y0, view_rays.ray_x0y1, view_rays.ray_x1y1, screen_uv ); value ray = V3.multiply_scalar ( ray_normal, eye_depth ); in new vector_4f (V3.add (origin, ray), 1.0) end; end;
-- -- Copyright © 2014 <code@io7m.com> http://io7m.com -- -- Permission to use, copy, modify, and/or distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR -- IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package com.io7m.r1.core; module ViewRays is type t is record origin_x0y0 : vector_3f, origin_x1y0 : vector_3f, origin_x0y1 : vector_3f, origin_x1y1 : vector_3f, ray_x0y0 : vector_3f, ray_x1y0 : vector_3f, ray_x0y1 : vector_3f, ray_x1y1 : vector_3f end; end;
module LogDepth where newtype LogDepth = LogDepth Float deriving (Eq, Ord, Show) type Depth = Float log2 :: Float -> Float log2 = logBase 2.0 depth_coefficient :: Float -> Float depth_coefficient far = 2.0 / log2 (far + 1.0) encode :: Float -> Depth -> LogDepth encode depth_co depth = let hco = depth_co * 0.5 in LogDepth $ log2 (depth + 1.0) * hco decode :: Float -> LogDepth -> Depth decode depth_co (LogDepth depth) = let hco = depth_co * 0.5 in (2.0 ** (depth / hco)) - 1
-- -- Copyright © 2014 <code@io7m.com> http://io7m.com -- -- Permission to use, copy, modify, and/or distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY -- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR -- IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package com.io7m.r1.core; -- -- Functions for handling logarithmic depth buffers. -- module LogDepth is import com.io7m.parasol.Float as F; function prepare_eye_z (z : float) : float = F.add (F.negate (z), 1.0); function encode_partial ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); value clamp_z = F.maximum (0.000001, z); in F.multiply (F.log2 (clamp_z), half_co) end; function encode_full ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); value clamp_z = F.maximum (0.000001, F.add (z, 1.0)); in F.multiply (F.log2 (clamp_z), half_co) end; function decode ( z : float, depth_coefficient : float ) : float = let value half_co = F.multiply (depth_coefficient, 0.5); in F.subtract (F.power (2.0, F.divide (z, half_co)), 1.0) end; end;
module Reflection where import qualified Vector3f as V3 reflection :: V3.T -> V3.T -> V3.T reflection v0 v1 = V3.sub3 v0 (V3.scale v1 (2.0 * (V3.dot3 v1 v0)))
module LightDiffuse where import qualified Color3 import qualified Direction import qualified Normal import qualified Spaces import qualified Vector3f diffuse :: Direction.T Spaces.Eye -> Normal.T -> Color3.T -> Float -> Vector3f.T diffuse stl n light_color light_intensity = let factor = max 0.0 (Vector3f.dot3 stl n) light_scaled = Vector3f.scale light_color light_intensity in Vector3f.scale light_scaled factor
module LightSpecular where import qualified Color3 import qualified Direction import qualified Normal import qualified Reflection import qualified Spaces import qualified Specular import qualified Vector3f specular :: Direction.T Spaces.Eye -> Direction.T Spaces.Eye -> Normal.T -> Color3.T -> Float -> Specular.T -> Vector3f.T specular stl view n light_color light_intensity (Specular.S surface_spec surface_exponent) = let reflection = Reflection.reflection view n factor = (max 0.0 (Vector3f.dot3 reflection stl)) ** surface_exponent light_raw = Vector3f.scale light_color light_intensity light_scaled = Vector3f.scale light_raw factor in Vector3f.mult3 light_scaled surface_spec
module Attenuation where attenuation_from_inverses :: Float -> Float -> Float -> Float attenuation_from_inverses inverse_maximum_range inverse_falloff distance = max 0.0 (1.0 - (distance * inverse_maximum_range) ** inverse_falloff) attenuation :: Float -> Float -> Float -> Float attenuation maximum_range falloff distance = attenuation_from_inverses (1.0 / maximum_range) (1.0 / falloff) distance
module Directional where import qualified Color4 import qualified Direction import qualified LightDirectional import qualified LightDiffuse import qualified LightSpecular import qualified Normal import qualified Position3 import qualified Spaces import qualified Specular import qualified Vector3f import qualified Vector4f directional :: Direction.T Spaces.Eye -> Normal.T -> Position3.T Spaces.Eye -> LightDirectional.T -> Specular.T -> Color4.T -> Vector3f.T directional view n position light specular (Vector4f.V4 sr sg sb _) = let stl = Vector3f.normalize (Vector3f.negation position) light_color = LightDirectional.color light light_intensity = LightDirectional.intensity light light_d = LightDiffuse.diffuse stl n light_color light_intensity light_s = LightSpecular.specular stl view n light_color light_intensity specular lit_d = Vector3f.mult3 (Vector3f.V3 sr sg sb) light_d lit_s = Vector3f.add3 lit_d light_s in lit_s
module Spherical where import qualified Attenuation import qualified Color4 import qualified Direction import qualified LightDiffuse import qualified LightSpecular import qualified LightSpherical import qualified Normal import qualified Position3 import qualified Specular import qualified Spaces import qualified Vector3f import qualified Vector4f spherical :: Direction.T Spaces.Eye -> Normal.T -> Position3.T Spaces.Eye -> LightSpherical.T -> Specular.T -> Color4.T -> Vector3f.T spherical view n surface_position light specular (Vector4f.V4 sr sg sb _) = let position_diff = Position3.sub3 surface_position (LightSpherical.origin light) stl = Vector3f.normalize (Vector3f.negation position_diff) distance = Vector3f.magnitude (position_diff) attenuation = Attenuation.attenuation (LightSpherical.radius light) (LightSpherical.falloff light) distance light_color = LightSpherical.color light light_intensity = LightSpherical.intensity light light_d = LightDiffuse.diffuse stl n light_color light_intensity light_s = LightSpecular.specular stl view n light_color light_intensity specular light_da = Vector3f.scale light_d attenuation light_sa = Vector3f.scale light_s attenuation lit_d = Vector3f.mult3 (Vector3f.V3 sr sg sb) light_da lit_s = Vector3f.add3 lit_d light_sa in lit_s
module Projective where import qualified Attenuation import qualified Color3 import qualified Color4 import qualified Direction import qualified LightDiffuse import qualified LightSpecular import qualified LightProjective import qualified Normal import qualified Position3 import qualified Specular import qualified Spaces import qualified Vector3f import qualified Vector4f projective :: Direction.T Spaces.Eye -> Normal.T -> Position3.T Spaces.Eye -> LightProjective.T -> Specular.T -> Float -> Color3.T -> Color4.T -> Vector3f.T projective view n surface_position light specular shadow texture (Vector4f.V4 sr sg sb _) = let position_diff = Position3.sub3 surface_position (LightProjective.origin light) stl = Vector3f.normalize (Vector3f.negation position_diff) distance = Vector3f.magnitude (position_diff) attenuation_raw = Attenuation.attenuation (LightProjective.radius light) (LightProjective.falloff light) distance attenuation = attenuation_raw * shadow light_color = Vector3f.mult3 (LightProjective.color light) texture light_intensity = LightProjective.intensity light light_d = LightDiffuse.diffuse stl n light_color light_intensity light_s = LightSpecular.specular stl view n light_color light_intensity specular light_da = Vector3f.scale light_d attenuation light_sa = Vector3f.scale light_s attenuation lit_d = Vector3f.mult3 (Vector3f.V3 sr sg sb) light_da lit_s = Vector3f.add3 lit_d light_sa in lit_s
module ProjectiveMatrix where import qualified Matrix4f projective_matrix :: Matrix4f.T -> Matrix4f.T -> Matrix4f.T -> Matrix4f.T projective_matrix camera_view light_view light_projection = case Matrix4f.inverse camera_view of Just cv -> Matrix4f.mult (Matrix4f.mult light_projection light_view) cv Nothing -> undefined -- A view matrix is always invertible
module ShadowVarianceChebyshev0 where chebyshev :: (Float, Float) -> Float -> Float chebyshev (d, ds) t = let p = if t <= d then 1.0 else 0.0 variance = ds - (d * d) du = t - d p_max = variance / (variance + (du * du)) in max p p_max factor :: (Float, Float) -> Float -> Float factor = chebyshev
module ShadowVarianceChebyshev1 where data T = T { minimum_variance :: Float } deriving (Eq, Show) chebyshev :: (Float, Float) -> Float -> Float -> Float chebyshev (d, ds) min_variance t = let p = if t <= d then 1.0 else 0.0 variance = max (ds - (d * d)) min_variance du = t - d p_max = variance / (variance + (du * du)) in max p p_max factor :: T -> (Float, Float) -> Float -> Float factor shadow (d, ds) t = chebyshev (d, ds) (minimum_variance shadow) t
module ShadowVarianceChebyshev2 where data T = T { minimum_variance :: Float, bleed_reduction :: Float } deriving (Eq, Show) chebyshev :: (Float, Float) -> Float -> Float -> Float chebyshev (d, ds) min_variance t = let p = if t <= d then 1.0 else 0.0 variance = max (ds - (d * d)) min_variance du = t - d p_max = variance / (variance + (du * du)) in max p p_max clamp :: Float -> (Float, Float) -> Float clamp x (lower, upper) = max (min x upper) lower linear_step :: Float -> Float -> Float -> Float linear_step lower upper x = clamp ((x - lower) / (upper - lower)) (0.0, 1.0) factor :: T -> (Float, Float) -> Float -> Float factor shadow (d, ds) t = let u = chebyshev (d, ds) (minimum_variance shadow) t in linear_step (bleed_reduction shadow) 1.0 u
module FogFactorZ where clamp :: Float -> (Float, Float) -> Float clamp x (lower, upper) = max (min x upper) lower fog_factor :: Float -> (Float, Float) -> Float fog_factor z (near, far) = let r = (z - near) / (far - near) in clamp r (0.0, 1.0)
module FogFactorY where clamp :: Float -> (Float, Float) -> Float clamp x (lower, upper) = max (min x upper) lower fog_factor :: Float -> (Float, Float) -> Float fog_factor y (lower, upper) = let r = (y - lower) / (upper - lower) in clamp r (0.0, 1.0)