add stars to the sky

2 files changed, 96 insertions, 10 deletions

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]