Fix wall bug, refactor placements

src/Dodge/LevelGen.hs

@@ -123,18 +123,8 @@ placeProp
 placeProp pr p a w = (i, w & props %~ addProp)
   where 
     i = IM.newKey $ _props w
-    addProp prs = IM.insert (IM.newKey prs) (over pjRot (+a) pr {_pjPos = p, _pjID = IM.newKey prs}) prs
-
-placePropID 
-    :: Prop
-    -> Point2
-    -> Float -- ^ Rotation
-    -> World
-    -> (World,Int)
-placePropID pr p a w = (w & props %~ addProp , k)
-  where 
-    k = IM.newKey (_props w)
-    addProp prs = IM.insert (IM.newKey prs) (over pjRot (+a) pr {_pjPos = p, _pjID = IM.newKey prs}) prs
+    addProp prs = IM.insert i (f pr) prs
+    f = (pjRot +~ a) . (pjPos %~ ( (p +.+) . (rotateV a) )) . (pjID .~ i)
 
 placeBt 
     :: Button
@@ -142,10 +132,12 @@ placeBt
     -> Float -- ^ Rotation
     -> World
     -> (Int, World)
-placeBt bt p rot w = (i , over buttons addBT w)
+placeBt bt p a w = (i , over buttons addBT w)
   where 
     i = IM.newKey $ _buttons w
-    addBT bts = IM.insert (IM.newKey bts) (bt {_btPos = p, _btRot = rot, _btID = IM.newKey bts}) bts
+    addBT xs = IM.insert i (f bt) xs
+    f = (btRot +~ a) . (btPos %~ ( (p +.+) . (rotateV a) )) . (btID .~ i)
+    --addBT bts = IM.insert (IM.newKey bts) (bt {_btPos = p, _btRot = rot, _btID = IM.newKey bts}) bts
 {- Creates a floor item at a given point.
 Assigns an id correctly.  -}
 placeFlIt
@@ -197,7 +189,7 @@ placeLS :: LightSource -> Point3 -> Float -> World -> (Int,World)
 placeLS ls (V3 x y z) rot w = (i, over lightSources addLS w)
   where 
     i = IM.newKey $ _lightSources w
-    startPos = _lsPos ls
+    startPos = onXY (rotateV rot) $ _lsPos ls
     addLS lss = IM.insert 
         (IM.newKey lss) 
         (ls {_lsPos = V3 x y z +.+.+ startPos,_lsDir = rot,_lsID = IM.newKey lss})