    {-# LANGUAGE ConstraintKinds       #-}
    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RankNTypes            #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE UndecidableInstances  #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.ThreeD.Shapes
    -- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Various three-dimensional shapes.
    --
    -----------------------------------------------------------------------------

    module Diagrams.ThreeD.Shapes
      (
        -- * Skinned class
        Skinned(..)

        -- * Basic 3D shapes
      , Ellipsoid(..)
      , sphere

      , Box(..)
      , cube

      , Frustum(..)
      , frustum
      , cone
      , cylinder

        -- * Constructive solid geometry
      , CSG(..)
      , union
      , intersection
      , difference
      ) where

    import           Control.Lens              (review, (^.), _1)
    import           Data.Typeable

    import           Data.Semigroup
    import           Diagrams.Angle
    import           Diagrams.Core
    import           Diagrams.Core.Trace
    import           Diagrams.Points
    import           Diagrams.Query
    import           Diagrams.Solve.Polynomial
    import           Diagrams.ThreeD.Types
    import           Diagrams.ThreeD.Vector

    import           Linear.Affine
    import           Linear.Metric
    import           Linear.Vector

    data Ellipsoid n = Ellipsoid (Transformation V3 n)
      deriving Typeable

    type instance V (Ellipsoid n) = V3
    type instance N (Ellipsoid n) = n

    instance Fractional n => Transformable (Ellipsoid n) where
      transform :: Transformation (V (Ellipsoid n)) (N (Ellipsoid n))
    -> Ellipsoid n -> Ellipsoid n
    transform Transformation (V (Ellipsoid n)) (N (Ellipsoid n))
    t1 (Ellipsoid Transformation V3 n
    t2) = Transformation V3 n -> Ellipsoid n
    forall n. Transformation V3 n -> Ellipsoid n
    Ellipsoid (Transformation (V (Ellipsoid n)) (N (Ellipsoid n))
    Transformation V3 n
    t1 Transformation V3 n -> Transformation V3 n -> Transformation V3 n
    forall a. Semigroup a => a -> a -> a
    <> Transformation V3 n
    t2)

    instance Fractional n => Renderable (Ellipsoid n) NullBackend where
      render :: NullBackend
    -> Ellipsoid n
    -> Render NullBackend (V (Ellipsoid n)) (N (Ellipsoid n))
    render NullBackend
    _ Ellipsoid n
    _ = Render NullBackend (V (Ellipsoid n)) (N (Ellipsoid n))
    Render NullBackend V3 n
    forall a. Monoid a => a
    mempty

    instance OrderedField n => Enveloped (Ellipsoid n) where
      getEnvelope :: Ellipsoid n -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n))
    getEnvelope (Ellipsoid Transformation V3 n
    tr) = Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    -> Envelope V3 n -> Envelope V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    Transformation V3 n
    tr (Envelope V3 n -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n)))
    -> ((V3 n -> n) -> Envelope V3 n)
    -> (V3 n -> n)
    -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (V3 n -> n) -> Envelope V3 n
    forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope ((V3 n -> n) -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n)))
    -> (V3 n -> n) -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a b. (a -> b) -> a -> b
    $ \V3 n
    v -> n
    1 n -> n -> n
    forall a. Fractional a => a -> a -> a
    / V3 n -> n
    forall a. Floating a => V3 a -> a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm V3 n
    v

    instance OrderedField n => Traced (Ellipsoid n) where
      getTrace :: Ellipsoid n -> Trace (V (Ellipsoid n)) (N (Ellipsoid n))
    getTrace (Ellipsoid Transformation V3 n
    tr) = Transformation (V (Trace V3 n)) (N (Trace V3 n))
    -> Trace V3 n -> Trace V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Trace V3 n)) (N (Trace V3 n))
    Transformation V3 n
    tr (Trace V3 n -> Trace (V (Ellipsoid n)) (N (Ellipsoid n)))
    -> ((Point V3 n -> V3 n -> SortedList n) -> Trace V3 n)
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Ellipsoid n)) (N (Ellipsoid n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace ((Point V3 n -> V3 n -> SortedList n)
     -> Trace (V (Ellipsoid n)) (N (Ellipsoid n)))
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a b. (a -> b) -> a -> b
    $ \(P V3 n
    p) V3 n
    v -> let
        a :: n
    a  =    V3 n
    v V3 n -> V3 n -> n
    forall a. Num a => V3 a -> V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` V3 n
    v
        b :: n
    b  = n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    * (V3 n
    p V3 n -> V3 n -> n
    forall a. Num a => V3 a -> V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` V3 n
    v)
        c :: n
    c  =    (V3 n
    p V3 n -> V3 n -> n
    forall a. Num a => V3 a -> V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` V3 n
    p) n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    1
        in
         [n] -> SortedList n
    forall a. Ord a => [a] -> SortedList a
    mkSortedList ([n] -> SortedList n) -> [n] -> SortedList n
    forall a b. (a -> b) -> a -> b
    $ n -> n -> n -> [n]
    forall d. (Floating d, Ord d) => d -> d -> d -> [d]
    quadForm n
    a n
    b n
    c

    -- | A sphere of radius 1 with its center at the origin.
    sphere :: Num n => Ellipsoid n
    sphere :: forall n. Num n => Ellipsoid n
    sphere = Transformation V3 n -> Ellipsoid n
    forall n. Transformation V3 n -> Ellipsoid n
    Ellipsoid Transformation V3 n
    forall a. Monoid a => a
    mempty

    data Box n = Box (Transformation V3 n)
      deriving Typeable

    type instance V (Box n) = V3
    type instance N (Box n) = n

    instance Fractional n => Transformable (Box n) where
      transform :: Transformation (V (Box n)) (N (Box n)) -> Box n -> Box n
    transform Transformation (V (Box n)) (N (Box n))
    t1 (Box Transformation V3 n
    t2) = Transformation V3 n -> Box n
    forall n. Transformation V3 n -> Box n
    Box (Transformation (V (Box n)) (N (Box n))
    Transformation V3 n
    t1 Transformation V3 n -> Transformation V3 n -> Transformation V3 n
    forall a. Semigroup a => a -> a -> a
    <> Transformation V3 n
    t2)

    instance Fractional n => Renderable (Box n) NullBackend where
      render :: NullBackend -> Box n -> Render NullBackend (V (Box n)) (N (Box n))
    render NullBackend
    _ Box n
    _ = Render NullBackend (V (Box n)) (N (Box n))
    Render NullBackend V3 n
    forall a. Monoid a => a
    mempty

    instance OrderedField n => Enveloped (Box n) where
      getEnvelope :: Box n -> Envelope (V (Box n)) (N (Box n))
    getEnvelope (Box Transformation V3 n
    tr) = Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    -> Envelope V3 n -> Envelope V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    Transformation V3 n
    tr (Envelope V3 n -> Envelope (V (Box n)) (N (Box n)))
    -> ((V3 n -> n) -> Envelope V3 n)
    -> (V3 n -> n)
    -> Envelope (V (Box n)) (N (Box n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (V3 n -> n) -> Envelope V3 n
    forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope ((V3 n -> n) -> Envelope (V (Box n)) (N (Box n)))
    -> (V3 n -> n) -> Envelope (V (Box n)) (N (Box n))
    forall a b. (a -> b) -> a -> b
    $ \V3 n
    v ->
        [n] -> n
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ((V3 n -> n) -> [V3 n] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (V3 n
    v V3 n -> V3 n -> n
    forall a. Num a => V3 a -> V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot`) [V3 n]
    corners) n -> n -> n
    forall a. Fractional a => a -> a -> a
    / V3 n -> n
    forall a. Num a => V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
    quadrance V3 n
    v where
          corners :: [V3 n]
    corners = n -> n -> n -> V3 n
    forall n. n -> n -> n -> V3 n
    mkR3 (n -> n -> n -> V3 n) -> [n] -> [n -> n -> V3 n]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [n
    0,n
    1] [n -> n -> V3 n] -> [n] -> [n -> V3 n]
    forall a b. [a -> b] -> [a] -> [b]
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [n
    0,n
    1] [n -> V3 n] -> [n] -> [V3 n]
    forall a b. [a -> b] -> [a] -> [b]
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [n
    0,n
    1]

    instance (Fractional n, Ord n) => Traced (Box n) where
      getTrace :: Box n -> Trace (V (Box n)) (N (Box n))
    getTrace (Box Transformation V3 n
    tr) = Transformation (V (Trace V3 n)) (N (Trace V3 n))
    -> Trace V3 n -> Trace V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Trace V3 n)) (N (Trace V3 n))
    Transformation V3 n
    tr (Trace V3 n -> Trace (V (Box n)) (N (Box n)))
    -> ((Point V3 n -> V3 n -> SortedList n) -> Trace V3 n)
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Box n)) (N (Box n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace ((Point V3 n -> V3 n -> SortedList n)
     -> Trace (V (Box n)) (N (Box n)))
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Box n)) (N (Box n))
    forall a b. (a -> b) -> a -> b
    $ \Point V3 n
    p V3 n
    v -> let
        (n
    x0, n
    y0, n
    z0) = Point V3 n -> (n, n, n)
    forall n. P3 n -> (n, n, n)
    unp3 Point V3 n
    p
        (n
    vx, n
    vy, n
    vz) = V3 n -> (n, n, n)
    forall n. V3 n -> (n, n, n)
    unr3 V3 n
    v
        intersections :: a -> a -> [a]
    intersections a
    f a
    d = case a
    d of
          a
    0 -> []
          a
    _ -> [-a
    fa -> a -> a
    forall a. Fractional a => a -> a -> a
    /a
    d, (a
    1a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    f)a -> a -> a
    forall a. Fractional a => a -> a -> a
    /a
    d]
        ts :: [n]
    ts = [[n]] -> [n]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[n]] -> [n]) -> [[n]] -> [n]
    forall a b. (a -> b) -> a -> b
    $ (n -> n -> [n]) -> [n] -> [n] -> [[n]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith n -> n -> [n]
    forall {a}. (Eq a, Fractional a) => a -> a -> [a]
    intersections [n
    x0,n
    y0,n
    z0] [n
    vx,n
    vy,n
    vz]
        atT :: n -> Point V3 n
    atT n
    t = Point V3 n
    p Point V3 n -> Diff (Point V3) n -> Point V3 n
    forall a. Num a => Point V3 a -> Diff (Point V3) a -> Point V3 a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^ (n
    tn -> V3 n -> V3 n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^V3 n
    v)
        range :: P3 a -> Bool
    range P3 a
    u = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1, a
    y a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    y a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1, a
    z a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    z a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1] where
          (a
    x, a
    y, a
    z) = P3 a -> (a, a, a)
    forall n. P3 n -> (n, n, n)
    unp3 P3 a
    u
        in
         -- ts gives all intersections with the planes forming the box
         -- filter keeps only those actually on the box surface
         [n] -> SortedList n
    forall a. Ord a => [a] -> SortedList a
    mkSortedList ([n] -> SortedList n) -> ([n] -> [n]) -> [n] -> SortedList n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Point V3 n -> Bool
    forall {a}. (Ord a, Num a) => P3 a -> Bool
    range (Point V3 n -> Bool) -> (n -> Point V3 n) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Point V3 n
    atT) ([n] -> SortedList n) -> [n] -> SortedList n
    forall a b. (a -> b) -> a -> b
    $ [n]
    ts where

    -- | A cube with side length 1, in the positive octant, with one
    -- vertex at the origin.
    cube :: Num n => Box n
    cube :: forall n. Num n => Box n
    cube = Transformation V3 n -> Box n
    forall n. Transformation V3 n -> Box n
    Box Transformation V3 n
    forall a. Monoid a => a
    mempty

    data Frustum n = Frustum n n (Transformation V3 n)
      deriving Typeable

    type instance V (Frustum n) = V3
    type instance N (Frustum n) = n

    instance Fractional n => Transformable (Frustum n) where
      transform :: Transformation (V (Frustum n)) (N (Frustum n))
    -> Frustum n -> Frustum n
    transform Transformation (V (Frustum n)) (N (Frustum n))
    t1 (Frustum n
    r0 n
    r1 Transformation V3 n
    t2) = n -> n -> Transformation V3 n -> Frustum n
    forall n. n -> n -> Transformation V3 n -> Frustum n
    Frustum n
    r0 n
    r1 (Transformation (V (Frustum n)) (N (Frustum n))
    Transformation V3 n
    t1 Transformation V3 n -> Transformation V3 n -> Transformation V3 n
    forall a. Semigroup a => a -> a -> a
    <> Transformation V3 n
    t2)

    instance Fractional n => Renderable (Frustum n) NullBackend where
      render :: NullBackend
    -> Frustum n -> Render NullBackend (V (Frustum n)) (N (Frustum n))
    render NullBackend
    _ Frustum n
    _ = Render NullBackend (V (Frustum n)) (N (Frustum n))
    Render NullBackend V3 n
    forall a. Monoid a => a
    mempty

    instance (OrderedField n, RealFloat n) => Enveloped (Frustum n) where
      -- The plane containing v and the z axis intersects the frustum in a trapezoid
      -- Test the four corners of this trapezoid; one must determine the Envelope
      getEnvelope :: Frustum n -> Envelope (V (Frustum n)) (N (Frustum n))
    getEnvelope (Frustum n
    r0 n
    r1 Transformation V3 n
    tr) = Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    -> Envelope V3 n -> Envelope V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Envelope V3 n)) (N (Envelope V3 n))
    Transformation V3 n
    tr (Envelope V3 n -> Envelope (V (Frustum n)) (N (Frustum n)))
    -> ((V3 n -> n) -> Envelope V3 n)
    -> (V3 n -> n)
    -> Envelope (V (Frustum n)) (N (Frustum n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (V3 n -> n) -> Envelope V3 n
    forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope ((V3 n -> n) -> Envelope (V (Frustum n)) (N (Frustum n)))
    -> (V3 n -> n) -> Envelope (V (Frustum n)) (N (Frustum n))
    forall a b. (a -> b) -> a -> b
    $ \V3 n
    v ->let
        θ :: Angle n
    θ = V3 n
    v V3 n -> Getting (Angle n) (V3 n) (Angle n) -> Angle n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Angle n) (V3 n) (Angle n)
    forall n. RealFloat n => Lens' (V3 n) (Angle n)
    Lens' (V3 n) (Angle n)
    forall (t :: * -> *) n.
    (HasTheta t, RealFloat n) =>
    Lens' (t n) (Angle n)
    _theta
        corners :: [(n, Angle n, n)]
    corners = [(n
    r1,Angle n
    θ,n
    1), (-n
    r1,Angle n
    θ,n
    1), (n
    r0,Angle n
    θ,n
    0), (-n
    r0,Angle n
    θ,n
    0)]
        in
         [n] -> n
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([n] -> n) -> ([(n, Angle n, n)] -> [n]) -> [(n, Angle n, n)] -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((n, Angle n, n) -> n) -> [(n, Angle n, n)] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (V3 n -> n
    forall a. Floating a => V3 a -> a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm (V3 n -> n) -> ((n, Angle n, n) -> V3 n) -> (n, Angle n, n) -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . V3 n -> V3 n -> V3 n
    forall (v :: * -> *) a.
    (Metric v, Fractional a) =>
    v a -> v a -> v a
    project V3 n
    v (V3 n -> V3 n)
    -> ((n, Angle n, n) -> V3 n) -> (n, Angle n, n) -> V3 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AReview (V3 n) (n, Angle n, n) -> (n, Angle n, n) -> V3 n
    forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
    review AReview (V3 n) (n, Angle n, n)
    forall n. RealFloat n => Iso' (V3 n) (n, Angle n, n)
    Iso' (V3 n) (n, Angle n, n)
    r3CylindricalIso) ([(n, Angle n, n)] -> n) -> [(n, Angle n, n)] -> n
    forall a b. (a -> b) -> a -> b
    $ [(n, Angle n, n)]
    corners

    instance (RealFloat n, Ord n) => Traced (Frustum n) where
      -- The trace can intersect the sides of the cone or one of the end
      -- caps The sides are described by a quadric equation; substitute
      -- in the parametric form of the ray but disregard any
      -- intersections outside z = [0,1] Similarly, find intersections
      -- with the planes z=0, z=1, but disregard any r>r0, r>r1
      getTrace :: Frustum n -> Trace (V (Frustum n)) (N (Frustum n))
    getTrace (Frustum n
    r0 n
    r1 Transformation V3 n
    tr) = Transformation (V (Trace V3 n)) (N (Trace V3 n))
    -> Trace V3 n -> Trace V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Trace V3 n)) (N (Trace V3 n))
    Transformation V3 n
    tr (Trace V3 n -> Trace (V (Frustum n)) (N (Frustum n)))
    -> ((Point V3 n -> V3 n -> SortedList n) -> Trace V3 n)
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Frustum n)) (N (Frustum n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace ((Point V3 n -> V3 n -> SortedList n)
     -> Trace (V (Frustum n)) (N (Frustum n)))
    -> (Point V3 n -> V3 n -> SortedList n)
    -> Trace (V (Frustum n)) (N (Frustum n))
    forall a b. (a -> b) -> a -> b
    $ \Point V3 n
    p V3 n
    v -> let
        (n
    px, n
    py, n
    pz) = Point V3 n -> (n, n, n)
    forall n. P3 n -> (n, n, n)
    unp3 Point V3 n
    p
        (n
    vx, n
    vy, n
    vz) = V3 n -> (n, n, n)
    forall n. V3 n -> (n, n, n)
    unr3 V3 n
    v
        ray :: n -> Point V3 n
    ray n
    t = Point V3 n
    p Point V3 n -> Diff (Point V3) n -> Point V3 n
    forall a. Num a => Point V3 a -> Diff (Point V3) a -> Point V3 a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^ n
    t n -> V3 n -> V3 n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^ V3 n
    v
        dr :: n
    dr = n
    r1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    r0
        a :: n
    a = n
    vxn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    vyn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    vzn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    drn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2
        b :: n
    b = n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    * (n
    px n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    vx n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    py n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    vy n -> n -> n
    forall a. Num a => a -> a -> a
    - (n
    r0n -> n -> n
    forall a. Num a => a -> a -> a
    +n
    pzn -> n -> n
    forall a. Num a => a -> a -> a
    *n
    dr) n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    dr  n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    vz)
        c :: n
    c = n
    pxn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    pyn -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2 n -> n -> n
    forall a. Num a => a -> a -> a
    - (n
    r0 n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    drn -> n -> n
    forall a. Num a => a -> a -> a
    *n
    pz)n -> n -> n
    forall a. Floating a => a -> a -> a
    **n
    2
        zbounds :: n -> Bool
    zbounds n
    t = n -> Point V3 n
    ray n
    t Point V3 n -> Getting n (Point V3 n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (Point V3 n) n
    forall a. Lens' (Point V3 a) a
    forall (t :: * -> *) a. R3 t => Lens' (t a) a
    _z n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >= n
    0
             Bool -> Bool -> Bool
    && n -> Point V3 n
    ray n
    t Point V3 n -> Getting n (Point V3 n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (Point V3 n) n
    forall a. Lens' (Point V3 a) a
    forall (t :: * -> *) a. R3 t => Lens' (t a) a
    _z n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= n
    1
        ends :: [n]
    ends = (n -> [n]) -> [n] -> [n]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap n -> [n]
    cap [n
    0,n
    1]
        cap :: n -> [n]
    cap n
    z = [ n
    t | n -> Point V3 n
    ray n
    t Point V3 n -> Getting n (Point V3 n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. (V3 n -> Const n (V3 n)) -> Point V3 n -> Const n (Point V3 n)
    forall (f1 :: * -> *) a (g :: * -> *) b (f2 :: * -> *).
    Functor f2 =>
    (f1 a -> f2 (g b)) -> Point f1 a -> f2 (Point g b)
    lensP ((V3 n -> Const n (V3 n)) -> Point V3 n -> Const n (Point V3 n))
    -> ((n -> Const n n) -> V3 n -> Const n (V3 n))
    -> Getting n (Point V3 n) n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((n, Angle n, n) -> Const n (n, Angle n, n))
    -> V3 n -> Const n (V3 n)
    forall n. RealFloat n => Iso' (V3 n) (n, Angle n, n)
    Iso' (V3 n) (n, Angle n, n)
    r3CylindricalIso (((n, Angle n, n) -> Const n (n, Angle n, n))
     -> V3 n -> Const n (V3 n))
    -> ((n -> Const n n) -> (n, Angle n, n) -> Const n (n, Angle n, n))
    -> (n -> Const n n)
    -> V3 n
    -> Const n (V3 n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> Const n n) -> (n, Angle n, n) -> Const n (n, Angle n, n)
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens (n, Angle n, n) (n, Angle n, n) n n
    _1 n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < n
    r0 n -> n -> n
    forall a. Num a => a -> a -> a
    + n
    z n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    dr ]
          where
          t :: n
    t = (n
    z n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    pz) n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    vz
        in
         [n] -> SortedList n
    forall a. Ord a => [a] -> SortedList a
    mkSortedList ([n] -> SortedList n) -> [n] -> SortedList n
    forall a b. (a -> b) -> a -> b
    $ (n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter n -> Bool
    zbounds (n -> n -> n -> [n]
    forall d. (Floating d, Ord d) => d -> d -> d -> [d]
    quadForm n
    a n
    b n
    c) [n] -> [n] -> [n]
    forall a. [a] -> [a] -> [a]
    ++ [n]
    ends

    -- | A frustum of a right circular cone.  It has height 1 oriented
    -- along the positive z axis, and radii r0 and r1 at Z=0 and Z=1.
    -- 'cone' and 'cylinder' are special cases.
    frustum :: Num n => n -> n -> Frustum n
    frustum :: forall n. Num n => n -> n -> Frustum n
    frustum n
    r0 n
    r1 = n -> n -> Transformation V3 n -> Frustum n
    forall n. n -> n -> Transformation V3 n -> Frustum n
    Frustum n
    r0 n
    r1 Transformation V3 n
    forall a. Monoid a => a
    mempty

    -- | A cone with its base centered on the origin, with radius 1 at the
    -- base, height 1, and it's apex on the positive Z axis.
    cone :: Num n => Frustum n
    cone :: forall n. Num n => Frustum n
    cone = n -> n -> Frustum n
    forall n. Num n => n -> n -> Frustum n
    frustum n
    1 n
    0

    -- | A circular cylinder of radius 1 with one end cap centered on the
    -- origin, and extending to Z=1.
    cylinder :: Num n => Frustum n
    cylinder :: forall n. Num n => Frustum n
    cylinder = n -> n -> Frustum n
    forall n. Num n => n -> n -> Frustum n
    frustum n
    1 n
    1

    -- | Types which can be rendered as 3D Diagrams.
    class Skinned t where
      skin :: (Renderable t b, N t ~ n, TypeableFloat n) => t -> QDiagram b V3 n Any

    instance (Num n, Ord n) => HasQuery (Ellipsoid n) Any where
      getQuery :: Ellipsoid n -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    getQuery (Ellipsoid Transformation V3 n
    tr) = Transformation
      (V (Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any))
      (N (Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any))
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation
      (V (Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any))
      (N (Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any))
    Transformation V3 n
    tr (Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
     -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any)
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall a b. (a -> b) -> a -> b
    $
        (Point (V (Ellipsoid n)) (N (Ellipsoid n)) -> Any)
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
    Query ((Point (V (Ellipsoid n)) (N (Ellipsoid n)) -> Any)
     -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any)
    -> (Point (V (Ellipsoid n)) (N (Ellipsoid n)) -> Any)
    -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall a b. (a -> b) -> a -> b
    $ \Point (V (Ellipsoid n)) (N (Ellipsoid n))
    v -> Bool -> Any
    Any (Bool -> Any) -> Bool -> Any
    forall a b. (a -> b) -> a -> b
    $ V3 n -> n
    forall a. Num a => V3 a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
    quadrance (Point (V (Ellipsoid n)) (N (Ellipsoid n))
    Point V3 n
    v Point V3 n -> Point V3 n -> Diff (Point V3) n
    forall a. Num a => Point V3 a -> Point V3 a -> Diff (Point V3) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. Point V3 n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin) n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= n
    1

    instance OrderedField n => Skinned (Ellipsoid n) where
      skin :: forall b n.
    (Renderable (Ellipsoid n) b, N (Ellipsoid n) ~ n,
     TypeableFloat n) =>
    Ellipsoid n -> QDiagram b V3 n Any
    skin Ellipsoid n
    s = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (Ellipsoid n -> Prim b (V (Ellipsoid n)) (N (Ellipsoid n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim Ellipsoid n
    s) (Ellipsoid n -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Ellipsoid n
    s) (Ellipsoid n -> Trace (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Ellipsoid n
    s) SubMap b V3 n Any
    forall a. Monoid a => a
    mempty (Ellipsoid n -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Ellipsoid n
    s)

    instance (Num n, Ord n) => HasQuery (Box n) Any where
      getQuery :: Box n -> Query (V (Box n)) (N (Box n)) Any
    getQuery (Box Transformation V3 n
    tr) = Transformation (V (Query V3 n Any)) (N (Query V3 n Any))
    -> Query V3 n Any -> Query V3 n Any
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Query V3 n Any)) (N (Query V3 n Any))
    Transformation V3 n
    tr (Query V3 n Any -> Query (V (Box n)) (N (Box n)) Any)
    -> ((Point V3 n -> Any) -> Query V3 n Any)
    -> (Point V3 n -> Any)
    -> Query (V (Box n)) (N (Box n)) Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point V3 n -> Any) -> Query V3 n Any
    forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
    Query ((Point V3 n -> Any) -> Query (V (Box n)) (N (Box n)) Any)
    -> (Point V3 n -> Any) -> Query (V (Box n)) (N (Box n)) Any
    forall a b. (a -> b) -> a -> b
    $ Bool -> Any
    Any (Bool -> Any) -> (Point V3 n -> Bool) -> Point V3 n -> Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point V3 n -> Bool
    forall {a}. (Ord a, Num a) => P3 a -> Bool
    range where
        range :: P3 a -> Bool
    range P3 a
    u = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1, a
    y a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    y a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1, a
    z a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0, a
    z a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    1] where
          (a
    x, a
    y, a
    z) = P3 a -> (a, a, a)
    forall n. P3 n -> (n, n, n)
    unp3 P3 a
    u

    instance OrderedField n => Skinned (Box n) where
      skin :: forall b n.
    (Renderable (Box n) b, N (Box n) ~ n, TypeableFloat n) =>
    Box n -> QDiagram b V3 n Any
    skin Box n
    s = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (Box n -> Prim b (V (Box n)) (N (Box n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim Box n
    s) (Box n -> Envelope (V (Box n)) (N (Box n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Box n
    s) (Box n -> Trace (V (Box n)) (N (Box n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Box n
    s) SubMap b V3 n Any
    forall a. Monoid a => a
    mempty (Box n -> Query (V (Box n)) (N (Box n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Box n
    s)

    instance (OrderedField n) => HasQuery (Frustum n) Any where
      getQuery :: Frustum n -> Query (V (Frustum n)) (N (Frustum n)) Any
    getQuery (Frustum n
    r0 n
    r1 Transformation V3 n
    tr)= Transformation
      (V (Query (V (Frustum n)) (N (Frustum n)) Any))
      (N (Query (V (Frustum n)) (N (Frustum n)) Any))
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation
      (V (Query (V (Frustum n)) (N (Frustum n)) Any))
      (N (Query (V (Frustum n)) (N (Frustum n)) Any))
    Transformation V3 n
    tr (Query (V (Frustum n)) (N (Frustum n)) Any
     -> Query (V (Frustum n)) (N (Frustum n)) Any)
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall a b. (a -> b) -> a -> b
    $
        (Point (V (Frustum n)) (N (Frustum n)) -> Any)
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
    Query ((Point (V (Frustum n)) (N (Frustum n)) -> Any)
     -> Query (V (Frustum n)) (N (Frustum n)) Any)
    -> (Point (V (Frustum n)) (N (Frustum n)) -> Any)
    -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall a b. (a -> b) -> a -> b
    $ \Point (V (Frustum n)) (N (Frustum n))
    p -> let
          z :: n
    z = Point (V (Frustum n)) (N (Frustum n))
    Point V3 n
    pPoint V3 n -> Getting n (Point V3 n) n -> n
    forall s a. s -> Getting a s a -> a
    ^.Getting n (Point V3 n) n
    forall a. Lens' (Point V3 a) a
    forall (t :: * -> *) a. R3 t => Lens' (t a) a
    _z
          r :: n
    r = n
    r0 n -> n -> n
    forall a. Num a => a -> a -> a
    + (n
    r1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    r0)n -> n -> n
    forall a. Num a => a -> a -> a
    *n
    z
          v :: Diff (Point V3) n
    v = Point (V (Frustum n)) (N (Frustum n))
    Point V3 n
    p Point V3 n -> Point V3 n -> Diff (Point V3) n
    forall a. Num a => Point V3 a -> Point V3 a -> Diff (Point V3) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. Point V3 n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin
          a :: n
    a = V3 n -> n
    forall a. Floating a => V3 a -> a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm (V3 n -> n) -> V3 n -> n
    forall a b. (a -> b) -> a -> b
    $ V3 n -> V3 n
    forall {f :: * -> *} {a}.
    (Metric f, Fractional a, R3 f) =>
    f a -> f a
    projectXY V3 n
    Diff (Point V3) n
    v
          projectXY :: f a -> f a
    projectXY f a
    u = f a
    u f a -> f a -> f a
    forall a. Num a => f a -> f a -> f a
    forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
    ^-^ f a -> f a -> f a
    forall (v :: * -> *) a.
    (Metric v, Fractional a) =>
    v a -> v a -> v a
    project f a
    forall (v :: * -> *) n. (R3 v, Additive v, Num n) => v n
    unitZ f a
    u
          in
           Bool -> Any
    Any (Bool -> Any) -> Bool -> Any
    forall a b. (a -> b) -> a -> b
    $ n
    z n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >= n
    0 Bool -> Bool -> Bool
    && n
    z n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= n
    1 Bool -> Bool -> Bool
    && n
    a n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= n
    r

    instance Skinned (Frustum n) where
      skin :: forall b n.
    (Renderable (Frustum n) b, N (Frustum n) ~ n, TypeableFloat n) =>
    Frustum n -> QDiagram b V3 n Any
    skin Frustum n
    s = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (Frustum n -> Prim b (V (Frustum n)) (N (Frustum n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim Frustum n
    s) (Frustum n -> Envelope (V (Frustum n)) (N (Frustum n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Frustum n
    s) (Frustum n -> Trace (V (Frustum n)) (N (Frustum n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Frustum n
    s) SubMap b V3 n Any
    forall a. Monoid a => a
    mempty (Frustum n -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Frustum n
    s)

    -- The CSG type needs to form a tree to be useful.  This
    -- implementation requires Backends to support all the included
    -- primitives.  If that turns out to be a problem, we have several
    -- options:
    -- a) accept runtime errors for unsupported primitives
    -- b) carry the set of primitives in a row type in the CSG type
    -- c) implement CSG in Haskell, so Backends supporting triangle meshes
    --    can fall back to those.
    -- (c) is worth doing anyway; I'm ambivalent about the others.  -DMB

    -- | A tree of Constructive Solid Geometry operations and the primitives that
    -- can be used in them.
    data CSG n
      = CsgEllipsoid (Ellipsoid n)
      | CsgBox (Box n)
      | CsgFrustum (Frustum n)
      | CsgUnion [CSG n]
      | CsgIntersection [CSG n]
      | CsgDifference (CSG n) (CSG n)
      deriving Typeable

    type instance V (CSG n) = V3
    type instance N (CSG n) = n

    instance Fractional n => Transformable (CSG n) where
      transform :: Transformation (V (CSG n)) (N (CSG n)) -> CSG n -> CSG n
    transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgEllipsoid Ellipsoid n
    p) = Ellipsoid n -> CSG n
    forall n. Ellipsoid n -> CSG n
    CsgEllipsoid (Ellipsoid n -> CSG n) -> Ellipsoid n -> CSG n
    forall a b. (a -> b) -> a -> b
    $ Transformation (V (Ellipsoid n)) (N (Ellipsoid n))
    -> Ellipsoid n -> Ellipsoid n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    Transformation (V (Ellipsoid n)) (N (Ellipsoid n))
    t Ellipsoid n
    p
      transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgBox Box n
    p) = Box n -> CSG n
    forall n. Box n -> CSG n
    CsgBox (Box n -> CSG n) -> Box n -> CSG n
    forall a b. (a -> b) -> a -> b
    $ Transformation (V (Box n)) (N (Box n)) -> Box n -> Box n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    Transformation (V (Box n)) (N (Box n))
    t Box n
    p
      transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgFrustum Frustum n
    p) = Frustum n -> CSG n
    forall n. Frustum n -> CSG n
    CsgFrustum (Frustum n -> CSG n) -> Frustum n -> CSG n
    forall a b. (a -> b) -> a -> b
    $ Transformation (V (Frustum n)) (N (Frustum n))
    -> Frustum n -> Frustum n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    Transformation (V (Frustum n)) (N (Frustum n))
    t Frustum n
    p
      transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgUnion [CSG n]
    ps) = [CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgUnion ([CSG n] -> CSG n) -> [CSG n] -> CSG n
    forall a b. (a -> b) -> a -> b
    $ (CSG n -> CSG n) -> [CSG n] -> [CSG n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Transformation (V (CSG n)) (N (CSG n)) -> CSG n -> CSG n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    t) [CSG n]
    ps
      transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgIntersection [CSG n]
    ps) = [CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgIntersection ([CSG n] -> CSG n) -> [CSG n] -> CSG n
    forall a b. (a -> b) -> a -> b
    $ (CSG n -> CSG n) -> [CSG n] -> [CSG n]
    forall a b. (a -> b) -> [a] -> [b]
    map (Transformation (V (CSG n)) (N (CSG n)) -> CSG n -> CSG n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    t) [CSG n]
    ps
      transform Transformation (V (CSG n)) (N (CSG n))
    t (CsgDifference CSG n
    p1 CSG n
    p2) = CSG n -> CSG n -> CSG n
    forall n. CSG n -> CSG n -> CSG n
    CsgDifference (Transformation (V (CSG n)) (N (CSG n)) -> CSG n -> CSG n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    t CSG n
    p1) (Transformation (V (CSG n)) (N (CSG n)) -> CSG n -> CSG n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (CSG n)) (N (CSG n))
    t CSG n
    p2)

    -- | The Envelope for an Intersection or Difference is simply the
    -- Envelope of the Union.  This is wrong but easy to implement.
    instance RealFloat n => Enveloped (CSG n) where
      getEnvelope :: CSG n -> Envelope (V (CSG n)) (N (CSG n))
    getEnvelope (CsgEllipsoid Ellipsoid n
    p)      = Ellipsoid n -> Envelope (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Ellipsoid n
    p
      getEnvelope (CsgBox Box n
    p)            = Box n -> Envelope (V (Box n)) (N (Box n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Box n
    p
      getEnvelope (CsgFrustum Frustum n
    p)        = Frustum n -> Envelope (V (Frustum n)) (N (Frustum n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope Frustum n
    p
      getEnvelope (CsgUnion [CSG n]
    ps)         = (CSG n -> Envelope V3 n) -> [CSG n] -> Envelope V3 n
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CSG n -> Envelope (V (CSG n)) (N (CSG n))
    CSG n -> Envelope V3 n
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope [CSG n]
    ps
      getEnvelope (CsgIntersection [CSG n]
    ps)  = (CSG n -> Envelope V3 n) -> [CSG n] -> Envelope V3 n
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CSG n -> Envelope (V (CSG n)) (N (CSG n))
    CSG n -> Envelope V3 n
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope [CSG n]
    ps
      getEnvelope (CsgDifference CSG n
    p1 CSG n
    p2) = CSG n -> Envelope (V (CSG n)) (N (CSG n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope CSG n
    p1 Envelope V3 n -> Envelope V3 n -> Envelope V3 n
    forall a. Semigroup a => a -> a -> a
    <> CSG n -> Envelope (V (CSG n)) (N (CSG n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope CSG n
    p2
    -- TODO after implementing some approximation scheme, calculate
    -- correct (approximate) envelopes for intersections and difference.

    instance (Floating n, Ord n) => HasQuery (CSG n) Any where
      getQuery :: CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    getQuery (CsgEllipsoid Ellipsoid n
    prim) = Ellipsoid n -> Query (V (Ellipsoid n)) (N (Ellipsoid n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Ellipsoid n
    prim
      getQuery (CsgBox Box n
    prim) = Box n -> Query (V (Box n)) (N (Box n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Box n
    prim
      getQuery (CsgFrustum Frustum n
    prim) = Frustum n -> Query (V (Frustum n)) (N (Frustum n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery Frustum n
    prim
      getQuery (CsgUnion [CSG n]
    ps) = (CSG n -> Query V3 n Any) -> [CSG n] -> Query V3 n Any
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    CSG n -> Query V3 n Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery [CSG n]
    ps
      getQuery (CsgIntersection [CSG n]
    ps) =
        Bool -> Any
    Any (Bool -> Any) -> (All -> Bool) -> All -> Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . All -> Bool
    getAll (All -> Any) -> Query V3 n All -> Query V3 n Any
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (CSG n -> Query V3 n All) -> [CSG n] -> Query V3 n All
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((Any -> All) -> Query V3 n Any -> Query V3 n All
    forall a b. (a -> b) -> Query V3 n a -> Query V3 n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> All
    All (Bool -> All) -> (Any -> Bool) -> Any -> All
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Bool
    getAny) (Query V3 n Any -> Query V3 n All)
    -> (CSG n -> Query V3 n Any) -> CSG n -> Query V3 n All
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    CSG n -> Query V3 n Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery) [CSG n]
    ps
      getQuery (CsgDifference CSG n
    p1 CSG n
    p2) = Any -> Any -> Any
    inOut (Any -> Any -> Any) -> Query V3 n Any -> Query V3 n (Any -> Any)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery CSG n
    p1 Query V3 n (Any -> Any) -> Query V3 n Any -> Query V3 n Any
    forall a b. Query V3 n (a -> b) -> Query V3 n a -> Query V3 n b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery CSG n
    p2 where
        inOut :: Any -> Any -> Any
    inOut (Any Bool
    a) (Any Bool
    b) = Bool -> Any
    Any (Bool -> Any) -> Bool -> Any
    forall a b. (a -> b) -> a -> b
    $ Bool
    a Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    b

    instance (RealFloat n, Ord n) => Traced (CSG n) where
      getTrace :: CSG n -> Trace (V (CSG n)) (N (CSG n))
    getTrace (CsgEllipsoid Ellipsoid n
    p) = Ellipsoid n -> Trace (V (Ellipsoid n)) (N (Ellipsoid n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Ellipsoid n
    p
      getTrace (CsgBox Box n
    p) = Box n -> Trace (V (Box n)) (N (Box n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Box n
    p
      getTrace (CsgFrustum Frustum n
    p) = Frustum n -> Trace (V (Frustum n)) (N (Frustum n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace Frustum n
    p
      -- on surface of some p, and not inside any of the others
      getTrace (CsgUnion []) = Trace (V (CSG n)) (N (CSG n))
    Trace V3 n
    forall a. Monoid a => a
    mempty
      getTrace (CsgUnion (CSG n
    s:[CSG n]
    ss)) = (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace Point V3 n -> V3 n -> SortedList n
    t where
        t :: Point V3 n -> V3 n -> SortedList n
    t Point V3 n
    pt V3 n
    v = ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ CSG n -> n -> Bool
    without CSG n
    s) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace ([CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgUnion [CSG n]
    ss)) Point V3 n
    pt V3 n
    v)
             SortedList n -> SortedList n -> SortedList n
    forall a. Semigroup a => a -> a -> a
    <> ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ CSG n -> n -> Bool
    without ([CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgUnion [CSG n]
    ss)) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace CSG n
    s) Point V3 n
    pt V3 n
    v) where
          newPt :: n -> Point V3 n
    newPt n
    dist = Point V3 n
    pt Point V3 n -> Diff (Point V3) n -> Point V3 n
    forall a. Num a => Point V3 a -> Diff (Point V3) a -> Point V3 a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^ V3 n
    v V3 n -> n -> V3 n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
    ^* n
    dist
          without :: CSG n -> n -> Bool
    without CSG n
    prim = Bool -> Bool
    not (Bool -> Bool) -> (n -> Bool) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CSG n -> Point (V (CSG n)) (N (CSG n)) -> Bool
    forall t. HasQuery t Any => t -> Point (V t) (N t) -> Bool
    inquire CSG n
    prim (Point V3 n -> Bool) -> (n -> Point V3 n) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Point V3 n
    newPt
      -- on surface of some p, and inside all the others
      getTrace (CsgIntersection []) = Trace (V (CSG n)) (N (CSG n))
    Trace V3 n
    forall a. Monoid a => a
    mempty
      getTrace (CsgIntersection (CSG n
    s:[CSG n]
    ss)) = (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace Point V3 n -> V3 n -> SortedList n
    t where
        t :: Point V3 n -> V3 n -> SortedList n
    t Point V3 n
    pt V3 n
    v = ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ CSG n -> n -> Bool
    within CSG n
    s) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace ([CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgIntersection [CSG n]
    ss)) Point V3 n
    pt V3 n
    v)
             SortedList n -> SortedList n -> SortedList n
    forall a. Semigroup a => a -> a -> a
    <> ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ CSG n -> n -> Bool
    within ([CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgIntersection [CSG n]
    ss)) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace CSG n
    s) Point V3 n
    pt V3 n
    v) where
          newPt :: n -> Point V3 n
    newPt n
    dist = Point V3 n
    pt Point V3 n -> Diff (Point V3) n -> Point V3 n
    forall a. Num a => Point V3 a -> Diff (Point V3) a -> Point V3 a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^ V3 n
    v V3 n -> n -> V3 n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
    ^* n
    dist
          within :: CSG n -> n -> Bool
    within CSG n
    prim = CSG n -> Point (V (CSG n)) (N (CSG n)) -> Bool
    forall t. HasQuery t Any => t -> Point (V t) (N t) -> Bool
    inquire CSG n
    prim (Point V3 n -> Bool) -> (n -> Point V3 n) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Point V3 n
    newPt
      -- on surface of p1, outside p2, or on surface of p2, inside p1
      getTrace (CsgDifference CSG n
    s1 CSG n
    s2) = (Point V3 n -> V3 n -> SortedList n) -> Trace V3 n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace Point V3 n -> V3 n -> SortedList n
    t where
        t :: Point V3 n -> V3 n -> SortedList n
    t Point V3 n
    pt V3 n
    v = ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool) -> (n -> Bool) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CSG n -> n -> Bool
    within CSG n
    s2) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace CSG n
    s1) Point V3 n
    pt V3 n
    v)
             SortedList n -> SortedList n -> SortedList n
    forall a. Semigroup a => a -> a -> a
    <> ([n] -> [n]) -> SortedList n -> SortedList n
    forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((n -> Bool) -> [n] -> [n]) -> (n -> Bool) -> [n] -> [n]
    forall a b. (a -> b) -> a -> b
    $ CSG n -> n -> Bool
    within CSG n
    s1) (Trace V3 n -> Point V3 n -> V3 n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace CSG n
    s2) Point V3 n
    pt V3 n
    v) where
          newPt :: n -> Point V3 n
    newPt n
    dist = Point V3 n
    pt Point V3 n -> Diff (Point V3) n -> Point V3 n
    forall a. Num a => Point V3 a -> Diff (Point V3) a -> Point V3 a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^ V3 n
    v V3 n -> n -> V3 n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
    ^* n
    dist
          within :: CSG n -> n -> Bool
    within CSG n
    prim = CSG n -> Point (V (CSG n)) (N (CSG n)) -> Bool
    forall t. HasQuery t Any => t -> Point (V t) (N t) -> Bool
    inquire CSG n
    prim (Point V3 n -> Bool) -> (n -> Point V3 n) -> n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> Point V3 n
    newPt

    instance (RealFloat n, Ord n) => Skinned (CSG n) where
      skin :: forall b n.
    (Renderable (CSG n) b, N (CSG n) ~ n, TypeableFloat n) =>
    CSG n -> QDiagram b V3 n Any
    skin CSG n
    s = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (CSG n -> Prim b (V (CSG n)) (N (CSG n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim CSG n
    s) (CSG n -> Envelope (V (CSG n)) (N (CSG n))
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope CSG n
    s) (CSG n -> Trace (V (CSG n)) (N (CSG n))
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace CSG n
    s) SubMap b V3 n Any
    forall a. Monoid a => a
    mempty (CSG n -> Query (V (CSG n)) (N (CSG n)) Any
    forall t m. HasQuery t m => t -> Query (V t) (N t) m
    getQuery CSG n
    s)

    -- | Types which can be included in CSG trees.
    class CsgPrim a where
      toCsg :: a n -> CSG n

    instance CsgPrim Ellipsoid where
      toCsg :: forall n. Ellipsoid n -> CSG n
    toCsg = Ellipsoid n -> CSG n
    forall n. Ellipsoid n -> CSG n
    CsgEllipsoid

    instance CsgPrim Box where
      toCsg :: forall n. Box n -> CSG n
    toCsg = Box n -> CSG n
    forall n. Box n -> CSG n
    CsgBox

    instance CsgPrim Frustum where
      toCsg :: forall n. Frustum n -> CSG n
    toCsg = Frustum n -> CSG n
    forall n. Frustum n -> CSG n
    CsgFrustum

    instance CsgPrim CSG where
      toCsg :: forall n. CSG n -> CSG n
    toCsg = CSG n -> CSG n
    forall a. a -> a
    id

    union :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n
    union :: forall (a :: * -> *) (b :: * -> *) n.
    (CsgPrim a, CsgPrim b) =>
    a n -> b n -> CSG n
    union a n
    a b n
    b = [CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgUnion [a n -> CSG n
    forall n. a n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg a n
    a, b n -> CSG n
    forall n. b n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg b n
    b]

    intersection :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n
    intersection :: forall (a :: * -> *) (b :: * -> *) n.
    (CsgPrim a, CsgPrim b) =>
    a n -> b n -> CSG n
    intersection a n
    a b n
    b = [CSG n] -> CSG n
    forall n. [CSG n] -> CSG n
    CsgIntersection [a n -> CSG n
    forall n. a n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg a n
    a, b n -> CSG n
    forall n. b n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg b n
    b]

    difference :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n
    difference :: forall (a :: * -> *) (b :: * -> *) n.
    (CsgPrim a, CsgPrim b) =>
    a n -> b n -> CSG n
    difference a n
    a b n
    b = CSG n -> CSG n -> CSG n
    forall n. CSG n -> CSG n -> CSG n
    CsgDifference (a n -> CSG n
    forall n. a n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg a n
    a) (b n -> CSG n
    forall n. b n -> CSG n
    forall (a :: * -> *) n. CsgPrim a => a n -> CSG n
    toCsg b n
    b)