jort-1.0.0: Env.hs

module Env where
    
import Bitmaps
import Vectors
import Colors
import Basics

type Env = (Vector -> Color) -- vector must be normalized

-- instance Show Env where
--     show _ = "<Env>"

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