content: -- Copyright (c) 2000 Galois Connections, Inc.
  -- All rights reserved.  This software is distributed as
  -- free software under the license in the file "LICENSE",
  -- which is included in the distribution.
  
  module Surface
      ( SurfaceFn (..)
      , Properties
      , sfun, sconst
      , prop
      , matte, shiny
      , chgColor
      , surface
      ) where
  
  import Geometry
  import CSG
  import Misc
  
  -- the surface gets passed face then u then v.
  data SurfaceFn c v = SFun (Int -> Double -> Double -> Properties c v)
                     | SConst (Properties c v)
  
  sfun :: (Int -> Double -> Double -> Properties c v) -> SurfaceFn c v
  sfun = SFun
  sconst :: Properties c v -> SurfaceFn c v
  sconst = SConst
  
  type Properties c v = (c, v, v, v)
  
  prop c d s p = (c, d, s, p)
  
  matte = (white, 1.0, 0.0, 1.0)
  shiny = (white, 0.0, 1.0, 1.0)
  
  chgColor :: c -> Properties d v -> Properties c v
  chgColor c (_, d, s, p) = (c, d, s, p)
  
  instance (Show c, Show v) => Show (SurfaceFn c v) where
    show (SFun _)   = "Surface function"
    -- show (SConst p) = "Surface constant: " ++ show p
    show (SConst p) = "Surface constant"
  
  evalSurface :: SurfaceFn Color Double -> Int -> Double -> Double -> Properties Color Double
  evalSurface (SConst p) = \_ _ _ -> p
  evalSurface (SFun f)   = f
  
  -- calculate surface properties, given the type of
  -- surface, and intersection point in object coordinates
  
  -- surface :: Surface SurfaceFn -> (Int, Point) -> (Vector, Properties)
  
  surface (Planar _ v0 v1) (n, p0, fn)
    = (norm, evalSurface fn n' u v)
    where norm = normalize $ cross v0 v1
  	(n', u, v) = planarUV n p0
  
  surface (Spherical _ v0 v1) (_, p0, fn)
    = (norm, evalSurface fn 0 u v)
    where x = xCoord p0
  	y = yCoord p0
  	z = zCoord p0
  	k = sqrt (1 - sq y)
  	theta = adjustRadian (atan2 (x / k) (z / k))
  	-- correct so that the image grows left-to-right
  	-- instead of right-to-left
  	u = 1.0 - clampf (theta / (2 * pi))
  	v =       clampf ((y + 1) / 2)
  	norm = normalize $ cross v0 v1
  
  -- ZZ ignore the (incorrect) surface model, and estimate the normal
  -- from the intersection in object space
  surface (Cylindrical _ v0 v1) (_, p0, fn)
    = (norm, evalSurface fn 0 u v)
    where x = xCoord p0
  	y = yCoord p0
  	z = zCoord p0
  	u = clampf $ adjustRadian (atan2 x z) / (2 * pi)
  	v = y
  	norm = normalize $ cross v0 v1
  
  -- ZZ ignore the (incorrect) surface model, and estimate the normal
  -- from the intersection in object space
  surface (Conic _ v0 v1) (_, p0, fn)
    = (norm, evalSurface fn 0 u v)
    where x = xCoord p0
  	y = yCoord p0
  	z = zCoord p0
  	u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)
  	v = y
  	norm = normalize $ cross v0 v1
  
  planarUV face p0
    = case face of
      PlaneFace      -> (0, x, z)
  
      CubeFront      -> (0, x, y)
      CubeBack       -> (1, x, y)
      CubeLeft       -> (2, z, y)
      CubeRight      -> (3, z, y)
      CubeTop        -> (4, x, z)
      CubeBottom     -> (5, x, z)
  
      CylinderTop    -> (1, (x + 1) / 2, (z + 1) / 2)
      CylinderBottom -> (2, (x + 1) / 2, (z + 1) / 2)
  
      ConeBase       -> (1, (x + 1) / 2, (z + 1) / 2)
    where x = xCoord p0
  	y = yCoord p0
  	z = zCoord p0
  
  -- misc
  
  adjustRadian :: Radian -> Radian
  adjustRadian r = if r > 0 then r else r + 2 * pi
  