From be2f7160ba7af6ebefaa6dcf4fb0247631866f8e Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 24 Mar 2026 09:38:32 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Creature/State.hs | 4 ++-- src/Dodge/Euse.hs | 18 ++++++++--------- src/Dodge/Item/HeldOffset.hs | 3 ++- src/Dodge/LevelGen/PlacementHelper.hs | 4 ---- src/Dodge/Placement/Instance/Door.hs | 6 ++++-- src/Dodge/Placement/Instance/LightSource.hs | 2 ++ src/Dodge/Placement/PlaceSpot.hs | 11 ++++------- src/Dodge/Room/Pillar.hs | 5 +++-- src/Dodge/Room/Tutorial.hs | 6 +++--- src/Geometry/Vector3D.hs | 22 ++++++++++----------- src/Picture/Base.hs | 4 ++-- src/Polyhedra.hs | 2 +- src/Shape.hs | 2 +- 13 files changed, 43 insertions(+), 46 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index fc0a12014..80a69df53 100644 --- a/src/Dodge/Creature/State.hs +++ b/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? diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index e0dc4669e..1c6a5b9cd 100644 --- a/src/Dodge/Euse.hs +++ b/src/Dodge/Euse.hs @@ -41,8 +41,8 @@ useMagShield mt _ cr w = , _mgField = mt } ---setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World ---setWristShieldPos itm cr x = moveWallIDUnsafe i wlline +-- setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World +-- setWristShieldPos itm cr x = moveWallIDUnsafe i wlline -- where -- i = _itParamID $ _itParams itm -- wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) @@ -62,16 +62,13 @@ useMagShield mt _ cr w = -- _ -> w createHeadLamp :: Item -> Creature -> World -> World -createHeadLamp _ cr w = - w - & cWorld +createHeadLamp _ cr = + cWorld . lWorld . lights .:~ LSParam ( _crPos cr - +.+.+ rotate3 - (_crDir cr) - (translateToES cr OnHead (V3 5 0 3)) + + rotate3z (_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 diff --git a/src/Dodge/Item/HeldOffset.hs b/src/Dodge/Item/HeldOffset.hs index 4b08d726f..d21cecb06 100644 --- a/src/Dodge/Item/HeldOffset.hs +++ b/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 diff --git a/src/Dodge/LevelGen/PlacementHelper.hs b/src/Dodge/LevelGen/PlacementHelper.hs index f4bdc99f3..93a9087cb 100644 --- a/src/Dodge/LevelGen/PlacementHelper.hs +++ b/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) diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 2663cef4c..e063dfb31 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/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) - & drUpdate .~ DoorLerpWithTimer 0 3) + ( defaultDoor + & drTrigger .~ (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor) + & drUpdate .~ DoorLerpWithTimer 0 3 + ) diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index ee8f21823..12f1aa130 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index a94fd8ee5..ad636d7ed 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/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' = V3 px py 0 + p = _psPos ps 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 (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z + startPos - where - startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls) +mvLS :: Point2 -> Float -> LightSource -> LightSource +mvLS x rot = lsParam . lsPos . _xy %~ ((+x) . rotateV rot) diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs index 44d632c19..07155bc3e 100644 --- a/src/Dodge/Room/Pillar.hs +++ b/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 [] diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 026da54f1..6fd1f641c 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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)] - , [spanLightI (V2 0 128) (V2 300 128)] - , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300] +--j ,[spanLightI (V2 120 0) (V2 120 300)] +--j , [spanLightI (V2 0 128) (V2 300 128)] +--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] diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index 454dd5cfb..4895ed22e 100644 --- a/src/Geometry/Vector3D.hs +++ b/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 -{-# INLINE rotate3 #-} -rotate3 a (V3 x y z) = V3 x' y' z - where - (V2 x' y') = rotateV a (V2 x y) +--rotate3 :: Float -> Point3 -> Point3 +--{-# INLINE rotate3 #-} +--rotate3 a (V3 x y z) = V3 x' y' z +-- where +-- (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 = undefined +--projV3 :: Point3 -> Point3 -> Point3 +--projV3 = undefined -onXY :: (Point2 -> Point2) -> Point3 -> Point3 -onXY f (V3 x y z) = V3 x' y' z - where - V2 x' y' = f (V2 x y) +--onXY :: (Point2 -> Point2) -> Point3 -> Point3 +--onXY f (V3 x y z) = V3 x' y' z +-- where +-- V2 x' y' = f (V2 x y) diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 22d82d41e..59070c83f 100644 --- a/src/Picture/Base.hs +++ b/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 #-} diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index b6946525f..796d413bf 100644 --- a/src/Polyhedra.hs +++ b/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) diff --git a/src/Shape.hs b/src/Shape.hs index 5872bd77f..ac5fcbc70 100644 --- a/src/Shape.hs +++ b/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 #-}