Add rooms, placements and room positions

This commit is contained in:
2022-03-08 22:57:58 +00:00
parent 2e1c7f2687
commit ff6064a3b6
14 changed files with 315 additions and 138 deletions
@@ -107,13 +107,6 @@ mntLightLnkCond f = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLSCond shp f
unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
unusedLnkToPS rp _ = case rp of
UnusedLink p a -> Just (PS p a,UsedSpot p a)
-- UsedInLink _ p a -> Just (PS p a,UsedSpot p a)
-- UsedOutLink _ _ p a -> Just (PS p a,UsedSpot p a)
_ -> Nothing
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h)
$ sps0 $ PutShape $ thinHighBar h a b
+51 -68
View File
@@ -1,7 +1,6 @@
module Dodge.Placement.Instance.Tank where
import Dodge.Data
--import Dodge.Placement.PlaceSpot
import Dodge.Placement.Shift
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Default.Wall
@@ -10,90 +9,74 @@ import Shape
import Color
--import Quaternion
roundTank :: Color -> Float -> Float -> Placement
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
tankShape baseshape facade col col' = ps0jPushPS
(PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
$ sps0 $ PutWall baseshape defaultWall
{_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
roundTank :: Color -> Color -> Placement
roundTank = tankShape (polyCirc 4 20)
$ \_ c' -> colorSH c' $ foldMap toprail (take 8 [0,pi/4..])
where
toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi/4) $ V2 0 20)
thecircle = polyCirc 4 20
roundTankCross :: Color -> Float -> Float -> Placement
roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col $
upperPrismPoly 31 thecircle
<> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
roundTankCross :: Color -> Color -> Placement
roundTankCross = tankShape (polyCirc 4 20)
$ \_ c -> colorSH c $ thinHighBar 31 (V2 20 0) (V2 (-20) 0)
<> thinHighBar 31 (V2 0 20) (V2 0 (-20))
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
thecircle = polyCirc 4 20
tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
tankRectCross :: Float -> Float -> Color -> Color -> Placement
tankRectCross = tankRectDecorate $ \ w h _ c -> colorSH c $
thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
tankSquareCross :: Color -> Float -> Float -> Placement
tankSquareCross :: Color -> Color -> Placement
tankSquareCross = tankRectCross 20 20
tankRectDecorate :: (Float -> Float -> Color -> Color -> Shape)
-> Float -> Float -> Color -> Color -> Placement
tankRectDecorate f w h = tankShape (rectWH w h) (f w h)
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col
$ upperPrismPoly 31 therect
<> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
)
$ sps0 $ PutWall therect defaultWall
{_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
tankRect :: Float -> Float -> Color -> Color -> Placement
tankRect = tankRectDecorate g
where
therect = rectWH w h
w' = w - 1.5
h' = h - 1.5
f (a,b,c,d) = thinHighBar 31 (V2 a b) (V2 c d)
g w h _ col = colorSH col $ foldMap f
[(w',-w',h',h')
,(w',-w',-h',-h')
,(w',w',h',-h')
,(-w',-w',h',-h')
]
where
w' = w - 1.5
h' = h - 1.5
f (a,c,b,d) = thinHighBar 31 (V2 a b) (V2 c d)
tankSquare :: Color -> Float -> Float -> Placement
tankSquare :: Color -> Color -> Placement
tankSquare = tankRect 20 20
tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> embossingR
<> rotateSH pi embossingR
<> thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0)
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
tankRectEmboss :: Float -> Float -> Color -> Color -> Placement
tankRectEmboss = tankRectDecorate f
where
w' = 0.3 * w
therect = rectWH w h
embossingR = prismPoly
[V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
[V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
f w h _ c = embossingR
<> rotateSH pi embossingR
<> colorSH c (thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0))
where
w' = 0.3 * w
embossingR = colorSH c $ prismPoly
[V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
[V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
tankSquareEmboss :: Color -> Float -> Float -> Placement
tankSquareEmboss :: Color -> Color -> Placement
tankSquareEmboss = tankRectEmboss 20 20
tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
tankRectEmboss4 :: Float -> Float -> Color -> Color -> Placement
tankRectEmboss4 = tankRectDecorate g
where
therect = rectWH w h
f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
g w h _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
where
f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
tankSquareEmboss4 :: Color -> Float -> Float -> Placement
tankSquareEmboss4 :: Color -> Color -> Placement
tankSquareEmboss4 = tankRectEmboss4 20 20