> import List(partition)
> import Monad(foldM)

Solution to ACM ECNA Regional, 2000, Problem G: BSP Trees

Representation of a BSP tree: (render first child then second child)

> data BSP = Branch BSP BSP | Leaf [Obj]

Representation of an object: label and list of vertices:

> data Obj = Obj Char [(Int,Int)]

A line: two distinct points on the line, assuming the first point
has the smaller x coordinate:

> data Line = Line (Int,Int) (Int,Int)
> instance Read Line where
>   readsPrec _ s = [(makeline (x1,z1) (x2,z2), t) |
>                    (x1,s1) <- reads s,
>                    (z1,s2) <- reads s1,
>                    (x2,s3) <- reads s2,
>                    (z2,t) <- reads s3]
>     where makeline p@(x1,z1) q@(x2,z2) | x1 < x2 = Line p q
>                                        | otherwise = Line q p

Given a line AB and a point Q, Q is on the viewer's side of AB iff the
triangle ABQ is clockwise.  This can be determined by computing the
signed area of ABQ.  (Actually we compute twice the area.)

Now since an object is assumed to be entirely on one side of the line,
we just need to test this on any vertex Q of the object.

> viewerside (Line (x1,z1) (x2,z2)) (Obj _ ((xq,zq):_)) =
>   x1*z2 + x2*zq + xq*z1 - x1*zq - x2*z1 - xq*z2 < 0

To subdivide a BSP by a line:

> refine l x@(Leaf os) = let (f,b) = partition (viewerside l) os
>                            in if null f || null b then x
>                               else Branch (Leaf b) (Leaf f)
> refine l (Branch x y) = Branch (refine l x) (refine l y)

To print the rendering order:

> instance Show BSP where
>   showsPrec _ = showsBSP
>     where showsBSP (Leaf os) = (++) (map (\(Obj c _) -> c) os)
>           showsBSP (Branch x y) = showsBSP x . showsBSP y

The main program:

> main = do os <- readObjs
>           ln <- readLn
>           t <- foldM (flip ($)) (Leaf os) (replicate ln doLine)
>           print t
>   where
>   readObjs = do on <- readLn
>                 mapM readObj (take on ['A'..'Z'])
>     where readObj c = do s <- getLine
>                          let [(x,z)] = [ (x,z) |
>                                          (m, s1) <- (reads :: ReadS Int) s,
>                                          (x,s2) <- reads s1,
>                                          (z,_) <- reads s2 ]
>                          return (Obj c [(x,z)])
>   doLine t = do l <- readLn
>                 return (refine l t)