{-# LANGUAGE FlexibleInstances #-} module RSAGL.RayTrace.Scattering (Scattering(..), absorbtionOverDistance, achromaticAbsorbtion, withoutAbsorbtion, withoutScattering, emissionOverDistance, traceScattering, traceAbsorbtion, linearSamples, AdaptiveSample, adaptiveSamples, dust, fog, rayleigh_sky, rayleigh, elasticBackScatter, elasticForwardScatter, elasticOmnidirectionalScatter) where import RSAGL.Math.Vector import RSAGL.Modeling.Color import RSAGL.Math.Angle import RSAGL.Math.Interpolation import RSAGL.Auxiliary.Auxiliary import Data.Monoid import Data.List import RSAGL.Types\end{code} \section{Scattering} \begin{code}

data Scattering = Scattering { scattering_absorb :: RGB, scattering_scatter :: Angle -> RGB }\end{code} \texttt{adjustDistance} multiplies the distance over which a \texttt{Scattering} media has its stated effect. For example, if medium \texttt{x} absorbs 50% of light passing through 3 units of distance, then \texttt{adjustDistance 2 x}, will absorb 50% of light passing through 6 units of distance. \begin{code}

adjustDistance :: RSdouble -> Scattering -> Scattering adjustDistance d s = Scattering { scattering_absorb = mapRGB (** (recip d)) $ scattering_absorb s, scattering_scatter = scaleRGB (recip d) . scattering_scatter s } mapAbsorbtion :: (RGB -> RGB) -> Scattering -> Scattering mapAbsorbtion f s = s { scattering_absorb = f $ scattering_absorb s } mapScattering :: (RGB -> RGB) -> Scattering -> Scattering mapScattering f s = s { scattering_scatter = f . scattering_scatter s }\end{code} \texttt{achromaticAbsorbtion} adjusts a \texttt{Scattering} media to absorb light equally in all colors. This is a simple way to fake a global lighting model for elastic scattering media, since without a global model absorbed light isn't re-scattered, resulting in wrong colors. \begin{code}

achromaticAbsorbtion :: Scattering -> Scattering achromaticAbsorbtion = mapAbsorbtion (gray . meanBrightness)\end{code} \texttt{withoutAbsorbtion} removes all absorbtion from a \texttt{Scattering} media. \begin{code}

withoutAbsorbtion :: Scattering -> Scattering withoutAbsorbtion = mapAbsorbtion (const $ gray 1)\end{code} \texttt{withoutScattering} removes all scattering from a \texttt{Scattering} media. \begin{code}

withoutScattering :: Scattering -> Scattering withoutScattering = mapScattering (const $ gray 0)\end{code} \texttt{absorbtionOverDistance} takes a distance and the filter color of the absorbion media through a distance of 1, and answers the resulting filter color of the media through that distance. \begin{code}

absorbtionOverDistance :: RSdouble -> RGB -> RGB absorbtionOverDistance trace_distance absorb_rgb = mapRGB (** trace_distance) absorb_rgb\end{code} \texttt{emissionOverDistance} takes a distance and the color of light being emitted by the media through a distance of 1, and answers the resulting light being emitted through that distance. \begin{code}

emissionOverDistance :: RSdouble -> RGB -> RGB emissionOverDistance trace_distance emit_rgb = scaleRGB trace_distance emit_rgb\end{code} \texttt{traceScattering} generates a pair (scattered light color,absorbtion filter color) by taking many samples of a \texttt{Scattering} medium along a line segment and accumulating the total scattering and absorbtion along that line segment. The density and composition of the \texttt{Scattering} medium as well as the direction and color of the light source may very with location. Scattered light is subject to absorbtion on the way back to the eye, use \texttt{withoutAbsorbtion} if you don't want this. Because of this back-absorbtion, numerous samples are necessary even if the medium and light source are constant. The \texttt{source} and \texttt{destination} points are not commutative: the \texttt{source} point should be position of the eye or camera or the nearest point to the eye along a ray passing from the eye through a media object. The second element of the result is normally the same as would be generated from traceAbsorbtion. \begin{code}

traceScattering :: (Point3D -> Scattering) -> (Point3D -> (Vector3D,RGB)) -> SamplingAlgorithm (RGB,RGB) -> Point3D -> Point3D -> Samples (RGB,RGB) traceScattering scatteringF lightingF samplingF source destination number_of_samples = foldl' (\(summed_scattering,summed_absorbtion) (this_scattering,this_absorbtion) -> (addRGB summed_scattering (filterRGB summed_absorbtion this_scattering), filterRGB summed_absorbtion this_absorbtion)) (gray 0,gray 1) $ sampleScattering scatteringF lightingF samplingF source destination number_of_samples sampleScattering :: (Point3D -> Scattering) -> (Point3D -> (Vector3D,RGB)) -> SamplingAlgorithm (RGB,RGB) -> Point3D -> Point3D -> Samples [(RGB,RGB)] sampleScattering scatteringF lightingF sampleF source destination = sampleF (\d p -> (scatteredLightAt d p,absorbedLightAt d p)) source destination where vector_to_viewer = vectorToFrom source destination scatteredLightAt this_distance this_point = let s = scatteringF this_point (light_vector,light_color) = lightingF this_point scattering_angle = angleBetween vector_to_viewer light_vector scatter_color = scattering_scatter s scattering_angle in emissionOverDistance this_distance $ filterRGB scatter_color light_color absorbedLightAt this_distance this_point = absorbtionOverDistance this_distance $ scattering_absorb $ scatteringF this_point\end{code} \texttt{traceAbsorbtion} takes many samples of a \texttt{Scattering} medium along a line segment and accumulates a total absorbtion along that line segment. For a constant medium, a single sample may be adequate. \begin{code}

traceAbsorbtion :: (Point3D -> Scattering) -> SamplingAlgorithm RGB -> Point3D -> Point3D -> Samples RGB traceAbsorbtion scatteringF samplingF source destination number_of_samples = foldr filterRGB (gray 1) $ samplingF (\d p -> absorbtionOverDistance d $ scattering_absorb $ scatteringF p) source destination number_of_samples\end{code} \subsection{Sampling} \texttt{linearSamples} takes samples evenly spaced along a line segment. \begin{code}

type Samples x = Integer -> x type SamplingAlgorithm a = (RSdouble -> Point3D -> a) -> Point3D -> Point3D -> Samples [a] class AdaptiveSample a where conspicuous :: a -> RSdouble instance AdaptiveSample RGB where conspicuous = recip . minRGB instance AdaptiveSample (RGB,RGB) where conspicuous (scattering_color,absorbtion_color) = maxRGB scattering_color / minRGB absorbtion_color data Sample a = Sample { sample_conspic :: RSdouble, sample_value :: a, sample_source :: Point3D, sample_midpoint :: Point3D, sample_destination :: Point3D } linearSamples :: SamplingAlgorithm a linearSamples sampleF source destination number_of_samples = map (sampleF sample_distances) sample_points where sample_points = map (flip lerp (source,destination)) $ zeroToOne number_of_samples sample_distances = distanceBetween source destination / fromInteger number_of_samples -- | 'adaptiveSamples' tries to selectively subdivide samples that seem most \"conspicuous\" using a user-supplied -- \"conspicuous-ness\" function. This should give a better result in less samples for highly detailed media models, -- but is likely to be slower that 'linearSamples' for the same number of samples. adaptiveSamples :: (AdaptiveSample a) => SamplingAlgorithm a adaptiveSamples sampleF source destination number_of_samples = map sample_value $ head $ dropWhile ((< fromInteger number_of_samples) . length) $ iterate (\samples -> concatMap (resampleRecursive 0 $ medianSamples samples) samples) seed_samples where seed_samples = [sampleBetween source destination] sampleBetween a b = Sample { sample_conspic = conspicuous s, sample_value = s, sample_source = a, sample_midpoint = p, sample_destination = b } where p = lerp 0.5 (a,b) s = sampleF (distanceBetween a b) p medianSamples samples = head $ drop (length conspics `div` 2) conspics where conspics = sort $ map sample_conspic samples recursive_limit = max 1 $ floor $ log (fromInteger number_of_samples) / log 4 resampleRecursive limit _ sample | limit > recursive_limit = [sample] resampleRecursive _ threshold sample | sample_conspic sample < threshold = [sample] resampleRecursive limit threshold sample = first_samples ++ second_samples where first_samples = resampleRecursive (limit+1) threshold $ sampleBetween (sample_source sample) (sample_midpoint sample) second_samples = resampleRecursive (limit+1) threshold $ sampleBetween (sample_midpoint sample) (sample_destination sample)\end{code} \subsection{Specific Scattering Functions} Elastic media \"absorb\" exactly the same amount of light as they scatter. If this light is colored then results may be strange, since without a global illumination model scattered light doesn't continue to propigate through the medium. Therefore, use \texttt{achromaticAbsorbtion} when measuring scattering. For elastic media, the absorbed color is the inverse of the scattering color. All media take the scattering color as their parameter. Inelastic media scatter less light than they absorb, and it may be the same color or achromatic. All of these \texttt{Scattering} media models accept a distance parameter. The greater the distance, the thinner the media. For example, \texttt{fog 5.0 (rgb 0.5 0.25 0.1)} absorbs 25\% of all green light passing through 5 units of the medium. \texttt{dust} represents many macroscopic spheres suspended in the atmosphere. This is an inelastic medium that always features achromatic absorbtion. \begin{code}

dust :: RSdouble -> RGB -> Scattering dust d c = adjustDistance d $ Scattering { scattering_absorb = gray 0.5, scattering_scatter = flip scaleRGB c . (*0.5) . (1-) . (*2) . f2f . toRotations_ }\end{code} \texttt{fog} is a colored media that scatters and absorbs the same color. \texttt{fog} might also be appropriate colored media for a solid translucent object. This is an inelastic medium. See \texttt{elasticOmnidirectionalScatter} for an elastic version of \texttt{fog}. \begin{code}

fog :: RSdouble -> RGB -> Scattering fog d c = adjustDistance d $ Scattering { scattering_absorb = c, scattering_scatter = const c }\end{code} \texttt{rayleigh} when used with \texttt{rayleigh_sky} as the color parameter simulates elastic scattering of light by very fine dust or even thin air. \begin{code}

rayleigh_sky :: RGB rayleigh_sky = rgb 0.06 0.10 0.23 rayleigh :: RSdouble -> RGB -> Scattering rayleigh d c = adjustDistance d $ Scattering { scattering_absorb = invertRGB c, scattering_scatter = \theta -> scaleRGB ((1 + f2f (cosine theta)^2)*0.75 ) c }\end{code} \texttt{elasticBackScatter} throws light back at the light source within a spcified cone. This medium doesn't absorb much light, especially when the scattering angle is very small, because while the scattered light may be very bright, being focused it doesn't represent as much energy as other \texttt{Scattering} media. \begin{code}

elasticBackScatter :: RSdouble -> Angle -> RGB -> Scattering elasticBackScatter d a c_ = adjustDistance d $ Scattering { scattering_absorb = invertRGB c, scattering_scatter = \theta -> scaleRGB (f2f $ max 0 $ n*(r - (toRadians_ theta)^2)) c } where r_ = toRadians a r = r_^2 n = recip $ (1 + r/2 - sin(r_)*r_ - cos(r_)) c = scaleRGB (f2f $ (toRotations a * 4)^2) c_\end{code} \texttt{elasticForwardScatter} is the reverse of \texttt{elasticBackScatter}. Use this to immitate Mie scattering. \begin{code}

elasticForwardScatter :: RSdouble -> Angle -> RGB -> Scattering elasticForwardScatter d a c = s { scattering_scatter = scattering_scatter s . supplementaryAngle } where s = elasticBackScatter d a c\end{code} \texttt{elasticOmnidirectionScatter} is like an elastic \texttt{fog}, scattering equally in every direction. \begin{code}

elasticOmnidirectionalScatter :: RSdouble -> RGB -> Scattering elasticOmnidirectionalScatter d c = adjustDistance d $ Scattering { scattering_absorb = invertRGB c, scattering_scatter = const c }\end{code} \subsection{Scattering Monoid} \begin{code}

instance Monoid Scattering where mempty = Scattering { scattering_absorb = gray 1.0, scattering_scatter = const $ gray 0 } x `mappend` y = Scattering { scattering_absorb = scattering_absorb x `filterRGB` scattering_absorb y, scattering_scatter = \u -> scattering_scatter x u `addRGB` scattering_scatter y u } mconcat [] = mempty mconcat [x] = x mconcat xs = mconcat a `mappend` mconcat b where (a,b) = splitAt (length xs `div` 2) xs\end{code}