119 lines
3.5 KiB
Haskell
119 lines
3.5 KiB
Haskell
{-# 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 . flat2) (diagonalLinesRect pb pa w d (3*pi/4))
|
|
++
|
|
map (flip thickLine 3 . flat2) (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@(xx,xy) y =
|
|
[ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,h))))
|
|
$ boxABC (a,b,0) (a',b',0) (0,0,10)
|
|
-- ,verticalPipe 5 orange x 0 100
|
|
-- ,verticalPipe 5 orange y 0 100
|
|
-- ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100
|
|
]
|
|
where
|
|
(a,b) = y -.- x
|
|
(a',b') = 10 *.* (normalizeV $ vNormal (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 . flat2) 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 . flat2) as'
|
|
++ map (flip thickLine 3 . flat2) 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 . flat2) 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 =
|