module Geometry.Algorithms.Clipping.CohenSutherland (cohenSutherland) where



import Data.Bits
import Geometry.Core
import Util



-- $setup
-- >>> import Geometry.Algorithms.Sampling
-- >>> import Control.Monad
-- >>> import Control.Monad.ST
-- >>> import Draw
-- >>> import Data.Maybe
-- >>> import Data.Traversable
-- >>> import qualified Graphics.Rendering.Cairo as C
-- >>> import qualified System.Random.MWC as MWC


-- | Constrain a line to the inside of a box with the Cohen-Sutherland clipping algorithm.
--
-- <<docs/haddock/Geometry/Algorithms/Clipping/CohenSutherland/cohenSutherland.svg>>
--
-- === __(image code)__
-- >>> :{
-- haddockRender "Geometry/Algorithms/Clipping/CohenSutherland/cohenSutherland.svg" 300 200 $ \_ -> do
--     let viewport = boundingBox [zero, Vec2 300 200]
--         mask = shrinkBoundingBox 20 viewport
--         lines = runST $ do
--             gen <- MWC.create
--             ps <- poissonDisc gen mask 20 4
--             for ps $ \p -> do
--                 angle <- MWC.uniformM gen
--                 let makeLooong = resizeLineSymmetric (const 500)
--                 pure (makeLooong (Line p (p +. polar angle 1)))
--         clippedLines = mapMaybe (cohenSutherland mask) lines
--     for_ clippedLines $ \line -> cairoScope $ do
--         setColor (mma 1)
--         sketch line
--         C.stroke
--     cairoScope $ do
--         C.setLineWidth 2
--         setColor (mma 0)
--         sketch (boundingBoxPolygon mask)
--         C.stroke
-- :}
-- Generated file: size 22KB, crc32: 0xa5dc883f
cohenSutherland :: BoundingBox -> Line -> Maybe Line
cohenSutherland :: BoundingBox -> Line -> Maybe Line
cohenSutherland BoundingBox
bb = \Line
line -> let Line Vec2
start Vec2
end = Line
line in Line -> Int -> Int -> Maybe Line
loop Line
line (Vec2 -> Int
outCode Vec2
start) (Vec2 -> Int
outCode Vec2
end)
  where

    BoundingBox (Vec2 Double
xMin Double
yMin) (Vec2 Double
xMax Double
yMax) = BoundingBox
bb

    -- Translated from Wikipedia’s pseudocode
    bit_LEFT :: Int
bit_LEFT   = Int -> Int
forall a. Bits a => Int -> a
bit Int
1 :: Int
    bit_RIGHT :: Int
bit_RIGHT  = Int -> Int
forall a. Bits a => Int -> a
bit Int
2
    bit_BOTTOM :: Int
bit_BOTTOM = Int -> Int
forall a. Bits a => Int -> a
bit Int
3
    bit_TOP :: Int
bit_TOP    = Int -> Int
forall a. Bits a => Int -> a
bit Int
4

    outCode :: Vec2 -> Int
outCode (Vec2 Double
x Double
y) =
        let codeX :: Int
codeX | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
xMin = Int
bit_LEFT
                  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
xMax = Int
bit_RIGHT
                  | Bool
otherwise = Int
0
            codeY :: Int
codeY | Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
yMin = Int
bit_TOP
                  | Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
yMax = Int
bit_BOTTOM
                  | Bool
otherwise = Int
0
        in Int
codeX Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
codeY

    loop :: Line -> Int -> Int -> Maybe Line
loop line :: Line
line@(Line p0 :: Vec2
p0@(Vec2 Double
x0 Double
y0) p1 :: Vec2
p1@(Vec2 Double
x1 Double
y1)) Int
outcode0 Int
outcode1

        -- Both points are inside the window, no clipping necessary
        | Int
outcode0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
outcode1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Line -> Maybe Line
forall a. a -> Maybe a
Just Line
line

        -- Both points share an outside region of the window, so the line is not
        -- inside the bounding box at all.
        | Int
outcode0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
outcode1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Maybe Line
forall a. Maybe a
Nothing

        -- Clipping necessary
        | Bool
otherwise =
            let outcode' :: Int
outcode' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
outcode0 Int
outcode1
                p :: Vec2
p | Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outcode' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
bit_BOTTOM = Double -> Double -> Vec2
Vec2 (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
yMaxDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0)) Double
yMax
                  | Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outcode' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
bit_TOP    = Double -> Double -> Vec2
Vec2 (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
yMinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0)) Double
yMin
                  | Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outcode' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
bit_RIGHT  = Double -> Double -> Vec2
Vec2 Double
xMax (Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
xMaxDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0))
                  | Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outcode' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
bit_LEFT   = Double -> Double -> Vec2
Vec2 Double
xMin (Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
xMinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0))
                  | Bool
otherwise = String -> String -> Vec2
forall a. String -> String -> a
bugError String
"cohenSutherland" String
"Impossible!"

            in if Int
outcode' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
outcode0
                then Line -> Int -> Int -> Maybe Line
loop (Vec2 -> Vec2 -> Line
Line Vec2
p Vec2
p1) (Vec2 -> Int
outCode Vec2
p) Int
outcode1
                else Line -> Int -> Int -> Maybe Line
loop (Vec2 -> Vec2 -> Line
Line Vec2
p0 Vec2
p) Int
outcode0 (Vec2 -> Int
outCode Vec2
p)