content: {-# LANGUAGE BangPatterns #-}
  
  module Object
          ( Color
          , Object(..)
          , translateObject
          , castRay
          , castRay_continuation
          , checkRay
          , surfaceNormal
          , colorOfObject
          , shineOfObject)
  where
  import Vec3
  
  type Color      = Vec3
  
  -- | An object in the world
  data Object
          = Sphere
          { spherePos             :: !Vec3
          , sphereRadius          :: !Float
          , sphereColor           :: !Color
          , sphereShine           :: !Float }
  
          | Plane
          { planePos              :: !Vec3
          , planeNormal           :: !Vec3
          , planeColor            :: !Color
          , planeShine            :: !Float }
  
          | PlaneCheck
          { planeCheckPos         :: !Vec3
          , planeCheckNormal      :: !Vec3
          , planeCheckShine       :: !Float }
          deriving (Eq, Show)
  
  
  translateObject :: Vec3 -> Object -> Object
  translateObject v obj
   = case obj of
          Sphere{}        -> obj { spherePos     = spherePos     obj + v }
          Plane{}         -> obj { planePos      = planePos      obj + v }
          PlaneCheck{}    -> obj { planeCheckPos = planeCheckPos obj + v }
  {-# INLINE translateObject #-}
  
  
  -- | Find the nearest point of intersection for a ray
  castRay :: [Object]        -- check for intersections on all these objects
          -> Vec3            -- ray origin
          -> Vec3            -- ray direction
          -> Maybe
                  ( Object   -- object of first intersected
                  , Vec3)    -- position of intersection, on surface of object
  
  castRay !objs !orig !dir
   = go0 objs
   where -- We haven't hit any objects yet.
         go0 []     = Nothing
         go0 (obj:rest)
          = case distanceToObject obj orig dir of
             Nothing    -> go0 rest
             Just dist  -> go1 rest obj dist
  
         -- We hit an object before, and we're testing others
         -- to see if they're closer.
         go1 []         !objClose !dist
          = Just (objClose, orig + dir `mulsV3` dist)
  
         go1 (obj:rest) !objClose !dist
          = case distanceToObject obj orig dir of
             Nothing         -> go1 rest objClose dist
             Just dist'
              | dist' < dist -> go1 rest obj      dist'
              | otherwise    -> go1 rest objClose dist
  {-# INLINE castRay #-}
  
  
  -- | Like castRay, but take continuations for the Nothing and Just branches to
  --   eliminate intermediate unboxings.
  castRay_continuation
          :: [Object]        -- check for intersections on all these objects
          -> Vec3            -- ray origin
          -> Vec3            -- ray direction
  
          -> a                     -- continuation when no intersection
          -> (Object -> Vec3 -> a) -- continuation with intersection
          -> a
  
  castRay_continuation !objs !orig !dir contNone contJust
   = go0 objs
   where -- We haven't hit any objects yet.
         go0 []     = contNone
         go0 (obj:rest)
          = case distanceToObject obj orig dir of
             Nothing    -> go0 rest
             Just dist  -> go1 rest obj dist
  
         -- We hit an object before, and we're testing others
         -- to see if they're closer.
         go1 []         !objClose !dist
          = contJust objClose (orig + dir `mulsV3` dist)
  
         go1 (obj:rest) !objClose !dist
          = case distanceToObject obj orig dir of
             Nothing         -> go1 rest objClose dist
             Just dist'
              | dist' < dist -> go1 rest obj      dist'
              | otherwise    -> go1 rest objClose dist
  {-# INLINE castRay_continuation #-}
  
  
  -- | Simplified version of `castRay` that only checks whether there is some
  --   object closer than a given mimimum distance.
  checkRay :: [Object]    -- ^ Check for intersection on all these objects.
           -> Vec3        -- ^ Ray origin.
           -> Vec3        -- ^ Ray direction.
           -> Float       -- ^ Minimum distance.
           -> Bool
  
  checkRay !objs !orig !dir !dist
   = go0 objs
   where  go0 []          = False
          go0 (obj:rest)
           = case distanceToObject obj orig dir of
              Nothing             -> go0 rest
              Just dist'
               | dist' < dist     -> True
               | otherwise        -> go0 rest
  {-# INLINE checkRay #-}
  
  
  -- | Compute the distance to the surface of this shape
  distanceToObject
          :: Object       -- ^ Towards this object.
          -> Vec3         -- ^ Start from this point.
          -> Vec3         -- ^ Along this ray.
          -> Maybe Float  -- ^ Distance to intersection, if there is one.
  
  distanceToObject !obj !orig !dir
   = case obj of
      Sphere pos radius _ _
       -> let !p       = orig + dir `mulsV3` ((pos - orig) `dotV3` dir)
              !d_cp    = magnitudeV3 (p - pos)
          in  if    d_cp >= radius                  then Nothing
              else if (p - orig) `dotV3` dir <= 0.0 then Nothing
              else Just $ magnitudeV3 (p - orig) - sqrt (radius * radius - d_cp * d_cp)
  
      Plane pos normal _ _
       -> if dotV3 dir normal >= 0.0
                  then Nothing
                  else Just (((pos - orig) `dotV3` normal) / (dir `dotV3` normal))
  
      PlaneCheck pos normal _
       -> if dotV3 dir normal >= 0.0
                  then Nothing
                  else Just (((pos - orig) `dotV3` normal) / (dir `dotV3` normal))
  {-# INLINE distanceToObject #-}
  
  
  -- | Compute the surface normal of the shape at this point
  surfaceNormal
          :: Object
          -> Vec3         -- ^ A point on the surface of the shape.
          -> Vec3
  
  surfaceNormal obj point
   = case obj of
      Sphere     pos _ _ _    -> normaliseV3 (point - pos)
      Plane      _ normal _ _ -> normal
      PlaneCheck _ normal _   -> normal
  {-# INLINE surfaceNormal #-}
  
  
  -- | Get the color of an object at the given point.
  colorOfObject :: Object -> Vec3 -> Color
  colorOfObject obj point
   = case obj of
          Sphere _ _ c _   -> c
          Plane  _ _ c _   -> c
          PlaneCheck{}     -> checkers point
  {-# INLINE colorOfObject #-}
  
  
  -- | Get the shine of an object at the given point.
  shineOfObject :: Object -> Vec3 -> Float
  shineOfObject obj _point
   = case obj of
          Sphere _ _ _ s   -> s
          Plane  _ _ _ s   -> s
          PlaneCheck _ _ s -> s
  {-# INLINE shineOfObject #-}
  
  
  -- | A checkerboard pattern along the x/z coords
  checkers :: Vec3 -> Vec3
  checkers (Vec3 x _ z)
          |       ((truncate (z / 100.0) :: Int)`mod` 2 == 0)
            `xor` ((truncate (x / 100.0) :: Int) `mod` 2 == 0)
            `xor` (x < 0.0)
            `xor` (z < 0.0)
          = Vec3 1.0 1.0 1.0
  
          | otherwise
          = Vec3 0.4 0.4 0.4
  
  
  xor :: Bool -> Bool -> Bool
  xor x1 x2
   = case (x1, x2) of
          (False, False)  -> False
          (False, True)   -> True
          (True,  False)  -> True
          (True,  True)   -> False
  {-# INLINE xor #-}
  