Fix wall bug, refactor placements
This commit is contained in:
@@ -3,6 +3,7 @@ module Dodge.LightSources.Fitting
|
||||
import Dodge.LightSources.Lamp
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Placement
|
||||
import Geometry
|
||||
|
||||
wallMount :: Point2 -> Point3 -> Placement
|
||||
@@ -66,9 +67,3 @@ wallMountV wallpos lamppos@(V3 x y z)
|
||||
|
||||
extendAway :: Point2 -> Point2 -> Point2
|
||||
extendAway p x = p +.+ safeNormalizeV (p -.- x)
|
||||
|
||||
jsps0 :: PSType -> Maybe Placement
|
||||
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
|
||||
|
||||
place0 :: PSType -> (Int -> Maybe Placement) -> Placement
|
||||
place0 pst = Placement (PS (V2 0 0) 0 pst)
|
||||
|
||||
@@ -86,9 +86,9 @@ lampCover h = ShapeProp
|
||||
, _prDraw = drawLampCover h
|
||||
, _prToggle = True
|
||||
}
|
||||
lampCoverWhen :: (World -> Bool) -> Float -> Prop
|
||||
lampCoverWhen cond h = ShapeProp
|
||||
{ _pjPos = V2 0 0
|
||||
lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
|
||||
lampCoverWhen cond pos h = ShapeProp
|
||||
{ _pjPos = pos
|
||||
, _pjID = 0
|
||||
, _pjRot = 0
|
||||
, _pjUpdate = setToggle cond `chain` rotateProp 0.15
|
||||
@@ -138,7 +138,6 @@ drawLampCover h pr | not (_prToggle pr) = mempty
|
||||
, translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
|
||||
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
|
||||
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
|
||||
--, translateSHz 2.5 . upperPrismPoly 1 $ [V2 5 5,V2 (-4) 5,V2 5 (-4)]
|
||||
, upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
|
||||
]
|
||||
, mempty
|
||||
|
||||
Reference in New Issue
Block a user