Cleanup

src/Dodge/Creature/State.hs

@@ -228,7 +228,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     x = 1
     isammolink AmmoMagSF{} = True
     isammolink _ = False
-    pos = cr ^. crPos . _xy + xyV3 (rotate3 cdir p)
+    pos = cr ^. crPos . _xy + xyV3 (rotate3z cdir p)
     cdir = _crDir cr
     itm = itmtree ^. dtValue . _1
     pointittarg = cWorld . lWorld . items . ix itid . itTargeting
@@ -252,7 +252,7 @@ shineTorch cr loc = fromMaybe id $ do
     x = 10
     isammolink AmmoMagSF{} = True
     isammolink _ = False
-    pos = _crPos cr + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
+    pos = _crPos cr + rotate3z cdir (p + Q.rotate q (V3 5 0 1.5))
     cdir = _crDir cr
 
 -- this probably needs to be set to null when dropped as well?

src/Dodge/Euse.hs

@@ -62,16 +62,13 @@ useMagShield mt _ cr w =
 --    _ -> w
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr w =
+createHeadLamp _ cr =
-    w
+    cWorld
-        & cWorld
         . lWorld
         . lights
         .:~ LSParam
             ( _crPos cr
-                +.+.+ rotate3
+                + rotate3z (_crDir cr) (translateToES cr OnHead (V3 5 0 3))
-                    (_crDir cr)
-                    (translateToES cr OnHead (V3 5 0 3))
             )
             200
             0.7
@@ -105,7 +102,8 @@ onEquipWristShield itm cr w =
         & setWristShieldPos
             ( itm & itParams .~ ItemParamID{_itParamID = i}
             )
-            cr esite
+            cr
+            esite
   where
     i = IM.newKey (w ^. cWorld . lWorld . walls)
     esite = w ^?! cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itLocation . ilEquipSite . _Just
@@ -132,4 +130,4 @@ setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
     --    g
     --        | twists cr = (+.+.+ V3 (-5) 10 0)
     --        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans
+    f = (+ cr ^. crPos . _xy) . stripZ . rotate3z (_crDir cr) . handtrans

src/Dodge/Item/HeldOffset.hs

@@ -21,7 +21,8 @@ import qualified Quaternion as Q
 
 turretItemOffset :: Item -> Turret -> Machine -> Point3 -> Point3
 turretItemOffset it tu mc =
-    rotate3 (_tuDir tu + _mcDir mc) . (+.+.+ V3 0 0 shoulderHeight)
+    rotate3z (_tuDir tu + _mcDir mc) 
+        . (+ V3 0 0 shoulderHeight)
         . transToHandle it
 
 transToHandle :: Item -> Point3 -> Point3

src/Dodge/LevelGen/PlacementHelper.hs

@@ -61,10 +61,6 @@ contToIDCont f _ = f . fromJust . _plMID
 jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
 jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing Nothing . const
 
-jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
-jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
-    \_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
-
 ps0j :: PSType -> Placement -> Placement
 ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing Nothing (\_ -> const $ Just plmnt)
 

src/Dodge/Placement/Instance/Door.hs

@@ -73,5 +73,7 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
                         defaultAutoWall
                         a
                         b
-                        (defaultDoor & drTrigger .~(WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
+                        ( defaultDoor
-                            & drUpdate .~ DoorLerpWithTimer 0 3)
+                            & drTrigger .~ (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
+                            & drUpdate .~ DoorLerpWithTimer 0 3
+                        )

src/Dodge/Placement/Instance/LightSource.hs

@@ -45,6 +45,8 @@ mntLSOn ::
 mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) =
     ps0jPushPS (PutLabel "light") .
     ps0jPushPS (putShape . setCol $ shapeF wallp lsp)
+    --ps0j (PutLabel "light") .
+    --ps0j (putShape . setCol $ shapeF wallp lsp)
         . pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
   where
     lsp' = lsp -.-.- V3 x y 1

src/Dodge/Placement/PlaceSpot.hs

@@ -125,7 +125,7 @@ placeSpotID rid ps pt w = case pt of
     PutForeground fs ->
         (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
     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
     PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
@@ -144,8 +144,7 @@ placeSpotID rid ps pt w = case pt of
         (foldMap loopPairs (map (map doShift) qs)))
     PutLabel{} -> (0, w)
   where
-    p@(V2 px py) = _psPos ps
+    p = _psPos ps
-    p' = V3 px py 0
     rot = _psRot ps
     doShift = shiftPointBy (p, rot)
     pashift = compP2A (p, rot)
@@ -219,7 +218,5 @@ placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly
     baseWall = defaultMachineWall & wlStructure . wsMachine .~ mcid
         & wlMaterial .~ mat
 
-mvLS :: Point3 -> Float -> LightSource -> LightSource
+mvLS :: Point2 -> Float -> LightSource -> LightSource
-mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z + startPos
+mvLS x rot = lsParam . lsPos . _xy %~ ((+x) . rotateV rot)
-  where
-    startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)

src/Dodge/Room/Pillar.hs

@@ -5,6 +5,7 @@ module Dodge.Room.Pillar (
     roomPillarsPassage,
 ) where
 
+import Linear
 import qualified Data.Set as S
 import Dodge.Cleat
 import Dodge.Data.GenWorld
@@ -60,7 +61,7 @@ roomPillarsSquare = do
                     [ mntLS
                         vShape
                         (rotateVAround (V2 150 150) a (V2 30 30))
-                        (onXY (rotateVAround (V2 150 150) a) $ V3 60 60 95)
+                        (_xy %~ (rotateVAround (V2 150 150) a) $ V3 60 60 95)
                     | a <- [0, pi / 2, pi, 3 * pi / 2]
                     ]
             , return
@@ -69,7 +70,7 @@ roomPillarsSquare = do
                     [ mntLS
                         vShape
                         (rotateVAround (V2 150 150) a (V2 150 0))
-                        (onXY (rotateVAround (V2 150 150) a) $ V3 150 20 95)
+                        (_xy %~ (rotateVAround (V2 150 150) a) $ V3 150 20 95)
                     | a <- [0, pi / 2, pi, 3 * pi / 2]
                     ]
             , addGirderLights . set rmPmnts []

src/Dodge/Room/Tutorial.hs

@@ -304,9 +304,9 @@ chasmSpitTerminal = do
         l3 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East North 
         l4 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East South
     ls <- takeOne [[l1,l2],[l3,l4]
-          ,[spanLightI (V2 120 0) (V2 120 300)]
+--j          ,[spanLightI (V2 120 0) (V2 120 300)]
-         , [spanLightI (V2 0 128) (V2 300 128)]
+--j         , [spanLightI (V2 0 128) (V2 300 128)]
-         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
+--j         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
         ]
     gh <- takeOne [55,75,97]
     gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]

src/Geometry/Vector3D.hs

@@ -45,11 +45,11 @@ crossProd (V3 x y z) (V3 a b c) = V3
     ( z * a - x * c)
     ( x * b - y * a)
 
-rotate3 :: Float -> Point3 -> Point3
+--rotate3 :: Float -> Point3 -> Point3
-{-# INLINE rotate3 #-}
+--{-# INLINE rotate3 #-}
-rotate3 a (V3 x y z) = V3 x' y' z
+--rotate3 a (V3 x y z) = V3 x' y' z
-  where 
+--  where 
-    (V2 x' y') = rotateV a (V2 x y)
+--    (V2 x' y') = rotateV a (V2 x y)
 
 rotate3z :: Float -> Point3 -> Point3
 {-# INLINE rotate3z #-}
@@ -124,10 +124,10 @@ angleVV3 a b
     | a == b = 0
     | otherwise = acos $ dotV3 a b / (magV3 a * magV3 b)
 
-projV3 :: Point3 -> Point3 -> Point3
+--projV3 :: Point3 -> Point3 -> Point3
-projV3 = undefined
+--projV3 = undefined
 
-onXY :: (Point2 -> Point2) -> Point3 -> Point3
+--onXY :: (Point2 -> Point2) -> Point3 -> Point3
-onXY f (V3 x y z) = V3 x' y' z
+--onXY f (V3 x y z) = V3 x' y' z
-  where
+--  where
-    V2 x' y' = f (V2 x y)
+--    V2 x' y' = f (V2 x y)

src/Picture/Base.hs

@@ -115,7 +115,7 @@ translate3 = fmap . overPos . (+.+.+)
 
 tranRot :: V2 Float -> Float -> Picture -> Picture
 {-# INLINE tranRot #-}
-tranRot (V2 x y) r = fmap $ overPos (translateH x y . rotate3 r)
+tranRot (V2 x y) r = fmap $ overPos (translateH x y . rotate3z r)
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
@@ -144,7 +144,7 @@ scale x = fmap . overPos . scale3 x
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate = fmap . overPos . rotate3
+rotate = fmap . overPos . rotate3z
 
 makeArc :: Float -> Point2 -> [Point2]
 {-# INLINE makeArc #-}

src/Polyhedra.hs

@@ -26,7 +26,7 @@ translateXY x y = pyFaces %~ map (map $ first tran)
     tran (V3 a b c) = V3 (a+x) (b+y) c
 
 rotateXY :: Float -> Polyhedra -> Polyhedra
-rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
+rotateXY = over pyFaces . map . map . first . rotate3z
 
 constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
 constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face) 

src/Shape.hs

@@ -253,7 +253,7 @@ translateSHz !z = translateSH (V3 0 0 z)
 
 rotateSH :: Float -> Shape -> Shape
 {-# INLINE rotateSH #-}
-rotateSH = overPosSH . rotate3
+rotateSH = overPosSH . rotate3z
 
 overPosSH :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINEABLE overPosSH #-}