112 lines
3.3 KiB
Haskell
112 lines
3.3 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 Shape
|
|
|
|
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 -> Shape
|
|
highPipe h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5
|
|
[x +.+ n, y +.+ n, y -.- n, x -.- n]
|
|
where
|
|
n = 2.5 *.* normalizeV (vNormal (y -.- x))
|
|
|
|
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 =
|