29 lines
883 B
Haskell
29 lines
883 B
Haskell
module Dodge.Placement.Instance.Block where
|
|
|
|
import Color
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Block
|
|
import Dodge.Default.Wall
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
decoratedBlock :: BlSh -> Material -> Color -> Float -> [Point2] -> PSType
|
|
decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
|
|
where
|
|
bl =
|
|
defaultBlock
|
|
& blDraw .~ BlockDraws [BlockDrawColHeightPoss col h (reverse ps), BlockDrawBlSh decf]
|
|
--(\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl'))
|
|
& blHeight .~ h
|
|
& blMaterial .~ mat
|
|
wl =
|
|
defaultWall
|
|
-- & wlColor .~ col
|
|
& wlRotateTo .~ False
|
|
& wlOpacity .~ SeeAbove
|
|
& wlMaterial .~ mat
|
|
& wlHeight .~ h
|
|
|
|
lowBlock :: Material -> Color -> Float -> [Point2] -> PSType
|
|
lowBlock = decoratedBlock BlShMempty
|