module Main where

import System.IO
import Control.Monad

data Vector = Vector Float Float Float
data Object = Sphere Vector Float Color
data Color = Color Int Int Int

nullVec = Vector 0 0 0

imageWidth = 1024
imageHeight = 1024

nearZ = 25
nearWidth :: Float
nearWidth = 100.0
nearHeight :: Float
nearHeight = 100.0

white = Color 255 255 255
black = Color 0 0 0
red = Color 255 0 0
green = Color 0 255 0
blue = Color 0 0 255

scene :: [Object]
scene = [Sphere (Vector (-20) (-20) 80) 50 red, Sphere (Vector 0 0 100) 50 blue, Sphere (Vector 20 20 120) 50 green]

ppmHeader = "P3\n" ++ show imageWidth ++ " " ++ show imageHeight ++ "\n255\n"
writeRow = (foldr (++) [] $ replicate imageWidth "0 0 0 ") ++ "\n"

dot :: Vector -> Vector -> Float
dot (Vector x1 y1 z1) (Vector x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2

vecOp :: (Float -> Float -> Float) -> Vector -> Vector -> Vector
vecOp f (Vector x1 y1 z1) (Vector x2 y2 z2) = Vector (f x1 x2) (f y1 y2)
    (f z1 z2)
add v w = vecOp (+) v w
sub v w = vecOp (-) v w

printColor :: Color -> String
printColor (Color r g b) = show r ++ " " ++ show g ++ " " ++ show b ++ " "

makeRay :: Float -> Float -> Vector
makeRay x y = Vector (x) (y) nearZ

intersect :: Vector -> Object -> Maybe Color
intersect v (Sphere c r col) =
	if d > 0
		then Just col
		else Nothing
		where
			d = (2 * (s `dot` v))^2 - 4 * (v `dot` v) *
			    ((s `dot` s) - r^ 2)
			s = v `sub` c

traceRay :: (Float, Float) -> String
traceRay (x, y) =
	case (filter (notNothing) $ map (intersect (makeRay x y)) scene) of
		(Just c : _) -> printColor c
		_ -> printColor black
		where
			notNothing Nothing = False
			notNothing _ = True

trace :: String
trace = concat $ map (traceRay . translate)
    [(x, y) | x <- [0 .. imageWidth - 1], y <- [0 .. imageHeight - 1]]
	where
		translate (x,y) = (tX (fromIntegral x), tY (fromIntegral y))
		tX x = x / (fromIntegral imageWidth) * nearWidth - nearWidth / 2
		tY y = -y / (fromIntegral imageHeight) * nearHeight +
		    nearHeight / 2

main :: IO ()
main = do
	h <- openFile "output.ppm" WriteMode
	hPutStr h ppmHeader
	hPutStr h trace
	hFlush h