1 -- Copyright (c) 2000 Galois Connections, Inc.
    2 -- All rights reserved.  This software is distributed as
    3 -- free software under the license in the file "LICENSE",
    4 -- which is included in the distribution.
    5 
    6 module Surface
    7     ( SurfaceFn (..)
    8     , Properties
    9     , sfun, sconst
   10     , prop
   11     , matte, shiny
   12     , chgColor
   13     , surface
   14     ) where
   15 
   16 import Geometry
   17 import CSG
   18 import Misc
   19 
   20 -- the surface gets passed face then u then v.
   21 data SurfaceFn c v = SFun (Int -> Double -> Double -> Properties c v)
   22                    | SConst (Properties c v)
   23 
   24 sfun :: (Int -> Double -> Double -> Properties c v) -> SurfaceFn c v
   25 -- never enteredsfun = SFun
   26 sconst :: Properties c v -> SurfaceFn c v
   27 -- never enteredsconst = SConst
   28 
   29 type Properties c v = (c, v, v, v)
   30 
   31 -- entered 32,512 timesprop c d s p = (c, d, s, p)
   32 
   33 -- never enteredmatte = (white, 1.0, 0.0, 1.0)
   34 -- never enteredshiny = (white, 0.0, 1.0, 1.0)
   35 
   36 chgColor :: c -> Properties d v -> Properties c v
   37 -- never enteredchgColor c (_, d, s, p) = (c, d, s, p)
   38 
   39 instance (Show c, Show v) => Show (SurfaceFn c v) where
   40   -- never enteredshow (SFun _)   = "Surface function"
   41   -- show (SConst p) = "Surface constant: " ++ show p
   42   show (SConst p) = "Surface constant"
   43 
   44 evalSurface :: SurfaceFn Color Double -> Int -> Double -> Double -> Properties Color Double
   45 -- entered 32,512 timesevalSurface (SConst p) = \_ _ _ -> p
   46 evalSurface (SFun f)   = f
   47 
   48 -- calculate surface properties, given the type of
   49 -- surface, and intersection point in object coordinates
   50 
   51 -- surface :: Surface SurfaceFn -> (Int, Point) -> (Vector, Properties)
   52 
   53 -- entered 32,512 timessurface (Planar _ v0 v1) (n, p0, fn)
   54   = (norm, evalSurface fn n' u v)
   55   where norm = normalize $ cross v0 v1
   56         (n', u, v) = planarUV n p0
   57 
   58 surface (Spherical _ v0 v1) (_, p0, fn)
   59   = (norm, evalSurface fn 0 u v)
   60   where x = xCoord p0
   61         y = yCoord p0
   62         z = zCoord p0
   63         k = sqrt (1 - sq y)
   64         theta = adjustRadian (atan2 (x / k) (z / k))
   65         -- correct so that the image grows left-to-right
   66         -- instead of right-to-left
   67         u = 1.0 - clampf (theta / (2 * pi))
   68         v =       clampf ((y + 1) / 2)
   69         norm = normalize $ cross v0 v1
   70 
   71 -- ZZ ignore the (incorrect) surface model, and estimate the normal
   72 -- from the intersection in object space
   73 surface (Cylindrical _ v0 v1) (_, p0, fn)
   74   = (norm, evalSurface fn 0 u v)
   75   where x = xCoord p0
   76         y = yCoord p0
   77         z = zCoord p0
   78         u = clampf $ adjustRadian (atan2 x z) / (2 * pi)
   79         v = y
   80         norm = normalize $ cross v0 v1
   81 
   82 -- ZZ ignore the (incorrect) surface model, and estimate the normal
   83 -- from the intersection in object space
   84 surface (Conic _ v0 v1) (_, p0, fn)
   85   = (norm, evalSurface fn 0 u v)
   86   where x = xCoord p0
   87         y = yCoord p0
   88         z = zCoord p0
   89         u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)
   90         v = y
   91         norm = normalize $ cross v0 v1
   92 
   93 -- entered 32,512 timesplanarUV face p0
   94   = case face of
   95     PlaneFace      -> (0, x, z)
   96 
   97     CubeFront      -> (0, x, y)
   98     CubeBack       -> (1, x, y)
   99     CubeLeft       -> (2, z, y)
  100     CubeRight      -> (3, z, y)
  101     CubeTop        -> (4, x, z)
  102     CubeBottom     -> (5, x, z)
  103 
  104     CylinderTop    -> (1, (x + 1) / 2, (z + 1) / 2)
  105     CylinderBottom -> (2, (x + 1) / 2, (z + 1) / 2)
  106 
  107     ConeBase       -> (1, (x + 1) / 2, (z + 1) / 2)
  108   where x = xCoord p0
  109         y = yCoord p0
  110         z = zCoord p0
  111 
  112 -- misc
  113 
  114 adjustRadian :: Radian -> Radian
  115 -- never enteredadjustRadian r = if r > 0 then r else r + 2 * pi