108 lines
3.8 KiB
Haskell
108 lines
3.8 KiB
Haskell
module Dodge.Room.Furniture
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Placement.PlaceSpot
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Foreground
|
|
import Dodge.Default.Wall
|
|
import Geometry
|
|
import Shape
|
|
import Color
|
|
--import Quaternion
|
|
|
|
roundTank :: Color -> Float -> Float -> Placement
|
|
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
|
|
(PutForeground $ colorSH col $
|
|
upperPrismPoly 31 thecircle
|
|
<> foldMap toprail ( take 8 [0,pi/4..])
|
|
)
|
|
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
|
|
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
|
|
(PutForeground $ colorSH col $
|
|
upperPrismPoly 31 thecircle
|
|
<> 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
|
|
(PutForeground $ 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
|
|
|
|
tankSquareCross :: Color -> Float -> Float -> Placement
|
|
tankSquareCross = tankRectCross 20 20
|
|
|
|
lowWall :: [Point2] -> Placement
|
|
lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
|
|
$ sps0 $ PutWall ps theWall
|
|
where
|
|
col = _wlColor defaultWall
|
|
theWall = defaultWall
|
|
{ _wlOpacity = SeeAbove
|
|
, _wlDraw = False
|
|
}
|
|
|
|
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
|
|
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
|
|
(PutForeground $ 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}
|
|
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)
|
|
|
|
tankSquare :: Color -> Float -> Float -> Placement
|
|
tankSquare = tankRect 20 20
|
|
|
|
tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
|
|
tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
|
|
(PutForeground $ 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}
|
|
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]
|
|
|
|
tankSquareEmboss :: Color -> Float -> Float -> Placement
|
|
tankSquareEmboss = tankRectEmboss 20 20
|
|
|
|
tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
|
|
tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
|
|
(PutForeground $ 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}
|
|
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)
|
|
|
|
tankSquareEmboss4 :: Color -> Float -> Float -> Placement
|
|
tankSquareEmboss4 = tankRectEmboss4 20 20
|