{-# LANGUAGE TupleSections #-}
module Dodge.Room.Foreground
    where
import Dodge.Picture
import Dodge.Base
import Picture
import Geometry
--import Geometry.Data
import Geometry.Vector3D
import Polyhedra
import Polyhedra.Data

import Data.List
import Data.Maybe

highDiagonalMesh
    :: Point2 
    -> Point2 
    -> Float    -- ^ width
    -> Float    -- ^ vertical distance between lines
    -> Picture
highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
    map (flip thickLine 3 . tflat2) (diagonalLinesRect pb pa w d (3*pi/4))
    ++ 
    map (flip thickLine 3 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
  where
    pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
    h = dist pa pb

diagonalLinesRect 
    :: Point2 
    -> Point2 
    -> Float    -- ^ width
    -> Float    -- ^ vertical distance between lines
    -> Float
    -> [(Point2,Point2)]
diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
  where
    xVec = negate w *.* vNormal (normalizeV $ pb -.- pa)
    diVec = rotateV ang xVec
    pax = pa +.+ xVec
    pbx = pb +.+ xVec
    lhsPoints = divideLineExact d (pa -.- yN) (pb +.+ yN)
    findDiPoint p = head . sortOn (dist p) $ catMaybes 
        [intersectLineLine' p (p +.+ diVec) pax pbx
        ,intersectSegLine' pa pax p (p +.+ diVec)
        ,intersectSegLine' pb pbx p (p +.+ diVec)
        ]
    yN = d * 0.5 *.* normalizeV (pa -.- pb)

highPipe :: Float -> Point2 -> Point2 -> [Polyhedra]
highPipe h x@(V2 xx xy) y = 
    [ Polyhedron . map (map ( (,orange) . (+.+.+ V3 xx xy h))) 
        $ boxABC (V3 a b 0) (V3 a' b' 0) (V3 0 0 5)
    ]
  where
    (V2 a b) = y -.- x
    (V2 a' b') = 10 *.* normalizeV (vNormal (V2 a b))

girderZ :: Float -> Point2 -> Point2 -> Picture
girderZ w x y = setDepth 50 $ color red $ pictures $
    [ thickLine [xt,yt] 3 
    , thickLine [xb,yb] 3
    ]
    ++ map (flip thickLine 3 . tflat2) ls
  where
    n = w *.* normalizeV (vNormal $ y -.- x)
    xb = x +.+ n
    yb = y +.+ n
    xt = x -.- n
    yt = y -.- n
    ps = divideLineExact (w*2) xb yb
    dia = rotateV (pi/4) n
    ps' = map (\p -> intersectSegLine' xt yt p (p +.+ dia)) ps
    ls = catMaybes $ zipWith (fmap . (,)) ps ps'
girderV :: Color -> Float -> Point2 -> Point2 -> Picture
girderV col w x y = setDepth 50 $ color col $ pictures $
    [ thickLine [xt,yt] 3 
    , thickLine [xb,yb] 3
    ]
    ++ map (flip thickLine 3 . tflat2) as'
    ++ map (flip thickLine 3 . tflat2) bs'
  where
    n = w *.* normalizeV (vNormal $ y -.- x)
    xb = x +.+ n
    yb = y +.+ n
    xt = x -.- n
    yt = y -.- n
    ps = divideLineExact (w*2) xb yb
    (as,_) = evenOddSplit ps
    f a = map (\p -> intersectSegLine' xt yt p (p +.+ rotateV a n))
    as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
    bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
girder :: Color -> Float -> Point2 -> Point2 -> Picture
girder col w x y = pictures $
    setDepth 50 (color col $ pictures $
        [ thickLine [xt,yt] 3 
        , thickLine [xb,yb] 3
        ]
        ++ map (flip thickLine 3 . tflat2) ls
    )
    : map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
  where
    n = w *.* normalizeV (vNormal $ y -.- x)
    xb = x +.+ n
    yb = y +.+ n
    xt = x -.- n
    yt = y -.- n
    ps = divideLineExact (w*2) xb yb
    ps' = map (\p -> intersectSegLine' xt yt p (p +.+ n)) ps
    ls = catMaybes $ zipWith (fmap . (,)) ps ps'


--highGirder :: Point2 -> Point2 -> Picture
--highGirder x y =