diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs index c5de93c77..01051ad9a 100644 --- a/src/Dodge/Picture.hs +++ b/src/Dodge/Picture.hs @@ -52,5 +52,5 @@ verticalPipe w col (xx,xy) za zb = pictures $ map (poly3D . f) ps g (a,b,_) = (a,b,zb) f' a = (a,col) -thickLinePlane :: Float -> Point3 -> Point3 -> Point3 -> [Point3] -thickLinePlane = undefined +expandLine :: Point3 -> Point3 -> Point3 -> [Point3] +expandLine v x y = [x -.-.- v, y -.-.- v, y +.+.+ v, x +.+.+ v] diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 3624af7ed..ff1e75263 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -1,6 +1,7 @@ module Dodge.Room.Foreground where import Dodge.Picture +import Dodge.Base import Picture import Geometry import Geometry.Data @@ -52,5 +53,56 @@ highPipe x y = pictures ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) (-0.1) (-0.2) ] +girderZ :: Float -> Point2 -> Point2 -> Picture +girderZ w x y = setDepth (-0.1) $ 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 :: Float -> Point2 -> Point2 -> Picture +girderV w x y = setDepth (-0.1) $ color red $ 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,bs) = 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 :: Float -> Point2 -> Point2 -> Picture +girder w x y = setDepth (-0.1) $ 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 + ps' = map (\p -> intersectSegLine' xt yt p (p +.+ n)) ps + ls = catMaybes $ zipWith (fmap . (,)) ps ps' + + --highGirder :: Point2 -> Point2 -> Picture --highGirder x y = diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index f242ae0ae..15dd59d03 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -26,5 +26,6 @@ startRoom = do ---- ] --, highDiagonalMesh (w,0) (0,0) h 50 [ highPipe (0,h/2) (w, h/2) + , girderV 10 (0,3*h/4) (w, 3*h/4) ] pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))