diff options
Diffstat (limited to 'sky.hs')
| -rw-r--r-- | sky.hs | 55 |
1 files changed, 55 insertions, 0 deletions
@@ -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] |