Fix low block drawing bug
This commit is contained in:
@@ -12,13 +12,11 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
|
|||||||
where
|
where
|
||||||
bl =
|
bl =
|
||||||
defaultBlock
|
defaultBlock
|
||||||
& blDraw .~ BlockDraws [BlockDrawColHeightPoss col h (reverse ps), BlockDrawBlSh decf]
|
& blDraw .~ BlockDraws [BlockDrawColHeightPoss col h ps, BlockDrawBlSh decf]
|
||||||
--(\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl'))
|
|
||||||
& blHeight .~ h
|
& blHeight .~ h
|
||||||
& blMaterial .~ mat
|
& blMaterial .~ mat
|
||||||
wl =
|
wl =
|
||||||
defaultWall
|
defaultWall
|
||||||
-- & wlColor .~ col
|
|
||||||
& wlRotateTo .~ False
|
& wlRotateTo .~ False
|
||||||
& wlOpacity .~ SeeAbove
|
& wlOpacity .~ SeeAbove
|
||||||
& wlMaterial .~ mat
|
& wlMaterial .~ mat
|
||||||
|
|||||||
@@ -131,11 +131,9 @@ placeSpotID rid ps pt w = case pt of
|
|||||||
fsID
|
fsID
|
||||||
(mvFS p rot fs)
|
(mvFS p rot fs)
|
||||||
w
|
w
|
||||||
--PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
|
|
||||||
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
|
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
|
||||||
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
|
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
|
||||||
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
|
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
|
||||||
--PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
|
|
||||||
PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
|
PutDoor eo f l p1 p2 -> plDoor eo f l (pashift p1) (pashift p2) w
|
||||||
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
|
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
|
||||||
PutSlideDr wl dr eo off a b ->
|
PutSlideDr wl dr eo off a b ->
|
||||||
@@ -208,7 +206,6 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
|
|||||||
plMachine ::
|
plMachine ::
|
||||||
[Point2] ->
|
[Point2] ->
|
||||||
Machine ->
|
Machine ->
|
||||||
-- Wall ->
|
|
||||||
Maybe Item ->
|
Maybe Item ->
|
||||||
Point2 ->
|
Point2 ->
|
||||||
Float ->
|
Float ->
|
||||||
|
|||||||
@@ -44,6 +44,13 @@ tutAnoTree = do
|
|||||||
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
|
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
|
||||||
, corDoor
|
, corDoor
|
||||||
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
|
, tToBTree "lastun" . return . cleatOnward <$> cenLasTur
|
||||||
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
|
|
||||||
|
, return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
|
||||||
-- , return $ tToBTree "cor" $ return $ cleatOnward (twinSlowDoorRoom 80 200 40)
|
-- , return $ tToBTree "cor" $ return $ cleatOnward (twinSlowDoorRoom 80 200 40)
|
||||||
|
|||||||
Reference in New Issue
Block a user