From faf9dde792d631fb3c9b0f6619b47b575f51d6b7 Mon Sep 17 00:00:00 2001 From: "Matthias P. Braendli" Date: Thu, 5 Dec 2013 23:07:26 +0100 Subject: add stars to the sky --- raytracer.hs | 51 +++++++++++++++++++++++++++++++++++++++++---------- sky.hs | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+), 10 deletions(-) create mode 100644 sky.hs diff --git a/raytracer.hs b/raytracer.hs index 63489a3..063e205 100644 --- a/raytracer.hs +++ b/raytracer.hs @@ -82,30 +82,40 @@ beta2 = 120 * degrees floorscale = 4 -w = 192 * 8 -h = 108 * 8 +w :: Int +w = 192 * 6 +h :: Int +h = 108 * 6 -oversampling = 4 -- each pixel is oversampling^2 rays +oversampling = 1 -- each pixel is oversampling^2 rays black :: Color black = (0,0,0) -ov_alphaoffset = ((alpha2 - alpha1) / (w-1)) / oversampling -ov_betaoffset = ((beta2 - beta1) / (h-1)) / oversampling +ov_alphaoffset = ((alpha2 - alpha1) / (fromIntegral w-1)) / oversampling +ov_betaoffset = ((beta2 - beta1) / (fromIntegral h-1)) / oversampling ov_alphaoffsets = take (round oversampling) [0,ov_alphaoffset..] ov_betaoffsets = take (round oversampling) [0,ov_betaoffset..] -imgheader = "P3 " ++ (show $ round w) ++ " " ++ (show $ round h) ++ " 255\n" +imgheader = "P3 " ++ show w ++ " " ++ show h ++ " 255\n" -alphas = take (round w) [alpha1,(alpha1 + ((alpha2 - alpha1) / (w-1)))..] -betas = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..] +alphas = take w [alpha1,(alpha1 + ((alpha2 - alpha1) / (fromIntegral w-1)))..] +betas = take h [beta1,(beta1 + ((beta2 - beta1) / (fromIntegral h-1)))..] attenuate_color :: Double -> Color -> Color attenuate_color factor (r,g,b) = ( round $ fromIntegral r * factor, round $ fromIntegral g * factor, round $ fromIntegral b * factor) +colormix :: Double -> Color -> Color -> Color +colormix amount c1 c2 = (round $ p*fromIntegral r1 + (1-p)*fromIntegral r2, + round $ p*fromIntegral g1 + (1-p)*fromIntegral g2, + round $ p*fromIntegral b1 + (1-p)*fromIntegral b2) + where (r1, g1, b1) = c1 + (r2, g2, b2) = c2 + p = max 0 $ min 1 amount + (a, b, c) `dot` (d, e, f) = a*d + b*e + c*f (a, b, c) `plus` (d, e, f) = (a+d, b+e, c+f) (a, b, c) `minus` (d, e, f) = (a-d, b-e, c-f) @@ -221,13 +231,34 @@ intersect_floor source (alpha, beta) where attn = max 0 (round (255 - 4*(sqrt $ abs t))) ((x, y, z), t) = intersect_point_floor source (alpha, beta) --- blue is beautiful, but a green tint is nice too +-- blue is beautiful, but a green tint is nice too. with stars it's even better + +is_star_center crit (x, y) = (((x^2 + y^3 + (x+y+2)^3) `mod` (131*90)) < (90 `div` crit)) + +stardist :: Direction -> (Int, Int) -> Double +stardist p1 p2 = sqrt ( (x1-fromIntegral x2)^2 + (y1-fromIntegral y2)^2) + where (x1, y1) = p1 + (x2, y2) = p2 + +roughness = 3 +nearest_potential_star_centre :: Direction -> (Int, Int) +nearest_potential_star_centre (x, y) = (((round x) `div` roughness) * roughness + (roughness `div` 2), + ((round y) `div` roughness) * roughness + (roughness `div` 2)) + +star_color crit darkness (x, y) = if is_star_center crit nearest + then colormix ((stardist (x,y) nearest) / 2 ) darkness starlight + else darkness + where nearest = nearest_potential_star_centre (x,y) + +starlight = (250, 250, 180) + skycolor :: Coord -> Direction -> Color -skycolor source (alpha, beta) = (r,g,b) +skycolor source (alpha, beta) = star_color 2 darkness (10*alpha/degrees, 10*beta/degrees) where r = 60 g = max 0 $ round $ (sqrt (greenness/2)) * 64 b = max 0 $ round $ (sqrt (-beta+90*degrees)) / (sqrt (90 * degrees)) * 255 greenness = cos (alpha) + 1 + darkness = (r,g,b) data SphereIntersect = SphereIntersect Double Color deriving (Eq, Show) -- distance color instance Ord SphereIntersect where diff --git a/sky.hs b/sky.hs new file mode 100644 index 0000000..f31abff --- /dev/null +++ b/sky.hs @@ -0,0 +1,55 @@ +import System.IO +import Data.Char +import Debug.Trace + +w = 192 * 4 +h = 108 * 4 + +type Color = (Int, Int, Int) -- red green blue +darkness = (0, 0, 50) +starlight = (250, 250, 180) + +colormix :: Double -> Color -> Color -> Color +colormix amount c1 c2 = (round $ p*fromIntegral r1 + (1-p)*fromIntegral r2, + round $ p*fromIntegral g1 + (1-p)*fromIntegral g2, + round $ p*fromIntegral b1 + (1-p)*fromIntegral b2) + where (r1, g1, b1) = c1 + (r2, g2, b2) = c2 + p = max 0 $ min 1 amount + +imgheader = "P3 " ++ (show w) ++ " " ++ (show h) ++ " 255\n" + +cartProd xs ys = [(x,y) | y <- ys, x <- xs] + +pixels = cartProd (take w [0,1..]) (take h [0,1..]) + +star_luminosity crit (x, y) = fromIntegral + (min 4 $ + ( ((x^2 + y^3 + (x+y+2)^3) `mod` (256)) `div` (256 `div` crit) ) + ) / 4 + +stardist :: (Int, Int) -> (Int, Int) -> Double +stardist p1 p2 = sqrt $ fromIntegral ( (x1-x2)^2 + (y1-y2)^2) + where (x1, y1) = p1 + (x2, y2) = p2 + +roughness = 5 +nearest_potential_star_centre :: (Int, Int) -> (Int, Int) +nearest_potential_star_centre (x, y) = ((x `div` roughness) * roughness + (roughness `div` 2), + (y `div` roughness) * roughness + (roughness `div` 2)) + +star_color crit (x, y) = colormix (lum * (stardist (x,y) nearest) / 2 ) darkness starlight + where nearest = nearest_potential_star_centre (x,y) + lum = star_luminosity crit nearest + +pixel_to_ppm :: Color -> String +pixel_to_ppm (r,g,b) = show r ++ " " ++ show g ++ " " ++ show b ++ "\n" + +image :: Int -> String +image crit = imgheader ++ (foldr (++) "" (map (pixel_to_ppm . star_color crit) pixels)) + +write_sky :: Int -> IO () +write_sky crit = trace ("Rendering " ++ show crit) + writeFile ("skyimg/sky" ++ show crit ++ ".ppm") (image crit) + +main = mapM write_sky [2, 20,30,40,50] -- cgit v1.2.3