module Env where import Bitmaps import Vectors import Colors import Basics type Env = (Vector -> Color) -- vector must be normalized -- instance Show Env where -- show _ = "" skyBitmapEnv :: Bitmap -> Env skyBitmapEnv bitmap (Vector x y z) = bitmap ! (x0, y0) where (width, height) = snd $ bounds $ bitmap y0 = inrange 0 height $ (1.0 - y) * (fromIntegral height) a = atan2 x z -- a in [-pi, pi] x0 = floor $ (a+pi) / (2.0*pi) * (fromIntegral width) inrange l h x = max (min (floor x) (h-1)) l rainbowEnv :: Env rainbowEnv (Vector x y z) = hsi h s i where h = atan2 x z s = 1 - (abs y) i = 0.75