justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2025-10-12 20:40:40 +01:00
parent 3206cdebf6
commit 5e5b24cad0
11 changed files with 157 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Gas.hs
+2 -2
View File
@@ -15,7 +15,7 @@ createGas gc = case gc of
aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
aGasCloud pressure pos dir cr =
makeGasCloud pos $
(cr ^. crPos . _xy -.- cr ^. crOldPos . _xy) +.+ pressure *.* unitVectorAtAngle dir
(cr ^. crPos . _xy - cr ^. crOldPos . _xy) + pressure *^ unitVectorAtAngle dir
aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
aFlame pressure pos dir cr = makeFlame pos vel
@@ -23,4 +23,4 @@ aFlame pressure pos dir cr = makeFlame pos vel
--w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)
-- (t,_) = randomR (99,101) (_randGen w)
vel = (cr ^. crPos . _xy -.- cr ^. crOldPos . _xy) +.+ pressure *.* unitVectorAtAngle dir
vel = (cr ^. crPos . _xy - cr ^. crOldPos . _xy) + pressure *^ unitVectorAtAngle dir
src/Dodge/HeldUse.hs
+21 -18
View File
@@ -205,15 +205,14 @@ heldItemMuzzles itm = \case
AUTORIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
MINIGUNX i ->
[ ( Muzzle
(V2 (30 + 40 * fromIntegral j / fromIntegral i) 0)
0
0.05
maguse1
NoFlare
MuzzleShootBullet
10
)
[ Muzzle
(V2 (30 + 40 * fromIntegral j / fromIntegral i) 0)
0
0.05
maguse1
NoFlare
MuzzleShootBullet
10
| j <- [0 .. i -1]
]
& ix 0 . mzFlareType .~ MiniGunFlare
@@ -742,8 +741,10 @@ useLoadedAmmo loc cr mz m w =
(getPJStabiliser itmtree)
cr
w
MuzzleNozzle{} -> useGasParams pq' mitid mz loc cr $ walkNozzle mz itm
$ w & randGen .~ g
MuzzleNozzle{} ->
useGasParams pq' mitid mz loc cr $
walkNozzle mz itm $
w & randGen .~ g
MuzzleShatter -> shootShatter itm cr w
MuzzleDetector ->
itemDetectorEffect
@@ -870,11 +871,11 @@ shootLaser so lt pv p dir col =
. soundContinue so p tone440sawtoothquietS (Just 2)
creatureShootPulseLaser :: Point3Q -> Creature -> World -> World
creatureShootPulseLaser (p,q) cr =
shootPulseLaser
(CrWeaponSound (_crID cr) 0)
(p ^. _xy)
(Q.qToAng q)
creatureShootPulseLaser (p, q) cr =
shootPulseLaser
(CrWeaponSound (_crID cr) 0)
(p ^. _xy)
(Q.qToAng q)
shootPulseLaser :: SoundOrigin -> Point2 -> Float -> World -> World
shootPulseLaser so p dir w =
@@ -1104,8 +1105,10 @@ useGasParams pq (NInt magitid) mz loc cr w =
(pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
gastype = fromMaybe (error "cannot find gas ammo") $ do
hit <- itm ^? itType . ibtHeld
fueltype <- w ^? cWorld . lWorld . items . ix magitid
>>= magAmmoParams >>= (^? ampCreateGas)
fueltype <-
w ^? cWorld . lWorld . items . ix magitid
>>= magAmmoParams
>>= (^? ampCreateGas)
gasType hit fueltype
dir = Q.qToAng (pq ^. _2) + _nzAngle (_itParams itm)
src/Dodge/Placement/PlaceSpot.hs
+38 -23
View File
@@ -6,7 +6,6 @@
-}
module Dodge.Placement.PlaceSpot (placeSpot) where
import Linear
import Color
import Control.Monad.State
import Data.Bifunctor
@@ -23,6 +22,7 @@ import Dodge.ShiftPoint
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Linear
import NewInt
--import System.Random
@@ -31,7 +31,6 @@ import NewInt
-- to the placement. This id should be associated with the type of placement and
-- match up with the created id for the object (creature id, flitid id, etc)
placeSpot :: Int -> GenWorld -> Placement -> GenWorld
--placeSpot :: (GenWorld, Room) -> Placement -> (GenWorld, Room)
placeSpot rid w plmnt = case plmnt of
Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rid i f plmnt w
Placement{_plSpot = PSPos extract eff fallback} ->
@@ -58,7 +57,11 @@ placePlainPSSpot w rid plmnt shift = case plmnt ^. plType of
f x gw = fromMaybe gw $ do
j <- x ^. plExternalID
return $ gw & genPmnt . at j ?~ x
recrPlace newplmnt w' pl = placeSpot rid (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) pl
recrPlace newplmnt w' pl =
placeSpot
rid
(w' & genRooms . ix rid . rmPmnts .:~ newplmnt)
pl
-- this should be tidied up
placeSpotUsingLink ::
@@ -69,15 +72,14 @@ placeSpotUsingLink ::
(RoomPos -> Room -> Room) ->
Maybe Placement ->
GenWorld
placeSpotUsingLink w rid plmnt extract eff fallback = case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
Just (ps, rmposs) ->
placeSpot
rid
(w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs))
(plmnt & plSpot .~ ps)
Nothing -> case fallback of
Nothing -> w
Just plmnt' -> placeSpot rid w plmnt'
placeSpotUsingLink w rid plmnt extract eff fallback =
case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
Just (ps, rmposs) ->
placeSpot
rid
(w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs))
(plmnt & plSpot .~ ps)
Nothing -> maybe w (placeSpot rid w) fallback
where
searchedPoss [] = Nothing
searchedPoss (pos : poss) = case extract pos (w ^?! genRooms . ix rid) of
@@ -92,7 +94,10 @@ placeSpotRoomRand ::
GenWorld ->
GenWorld
placeSpotRoomRand rid i f plmnt w =
let (ps, g) = runState (_rmRandPSs (w ^?! genRooms . ix rid) !! i) $ w ^. gwWorld . randGen
let (ps, g) =
runState
(_rmRandPSs (w ^?! genRooms . ix rid) !! i)
$ w ^. gwWorld . randGen
in placeSpot rid (w & gwWorld . randGen .~ g) (plmnt & plSpot .~ f ps)
-- the Int here is some id that is assigned when the placement is placed
@@ -127,8 +132,8 @@ placeSpotID rid ps pt w = case pt of
w
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp
-> plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
PutPPlate pp ->
plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) 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
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
@@ -145,8 +150,10 @@ placeSpotID rid ps pt w = case pt of
PutNothing -> (0, w)
PutID i -> (i, w)
PutWorldUpdate f -> (0, w & f rid ps)
PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps'
& genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps')
PutChasm ps' ->
( 0
, w & gwWorld . cWorld . chasms .:~ map doShift ps'
& genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps')
)
PutLabel{} -> (0, w)
where
@@ -182,19 +189,27 @@ mvButton :: Point2 -> Float -> Button -> Button
mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
mvPP :: Point2 -> Float -> PressPlate -> PressPlate
mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
mvPP p rot pp = pp & ppPos .~ p & ppRot .~ rot
mvCr :: Point2 -> Float -> Creature -> Creature
mvCr p rot cr = cr
& crPos . _xy .~ p
& crOldPos . _xy .~ p
& crDir .~ rot
mvCr p rot cr =
cr
& crPos . _xy .~ p
& crOldPos . _xy .~ p
& crDir .~ rot
mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
plMachine ::
[Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
[Point2] ->
Machine ->
Wall ->
Maybe Item ->
Point2 ->
Float ->
GenWorld ->
(Int, GenWorld)
plMachine wallpoly mc wl = \case
Nothing -> plMachine' wallpoly mc wl
Just itm -> plTurret wallpoly mc wl itm
src/Dodge/PlacementSpot.hs
+1 -1
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE LambdaCase #-}
--{-# LANGUAGE LambdaCase #-}
module Dodge.PlacementSpot (
atFstLnkOut,
atNthLnkOutShiftBy,
src/Dodge/Prop/Gib.hs
+4 -4
View File
@@ -20,10 +20,10 @@ addCrGibs cr = case damageDirection $ _crDamage cr of
addGibAt (_skinHead skin) (cpos & _z +~ 25)
. addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
. addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
. makeDustAt Flesh 50 (cpos)
. makeDustAt Flesh 50 (cpos)
. makeDustAt Flesh 50 (cpos)
. makeDustAt Flesh 50 (cpos)
. makeDustAt Flesh 50 cpos
. makeDustAt Flesh 50 cpos
. makeDustAt Flesh 50 cpos
. makeDustAt Flesh 50 cpos
Just d ->
addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos
. addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos
src/Dodge/Room/CheckConsistency.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Dodge.Graph
linksOnPath :: Room -> Bool
linksOnPath r = all pointOnPath linkPoints
where
linkPoints = map (_rlPos) $ _rmLinks r
linkPoints = map _rlPos $ _rmLinks r
pointOnPath p = elem p $ concatMap flat2 $ _rmPath r
flat2 (x,y) = [x,y]
src/Dodge/Room/Room.hs
+1 -1
View File
@@ -128,7 +128,7 @@ roomCenterPillar = do
l1 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
l2 <-
mntLightLnkCond $
(resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
resetPLUse (rprBool $ \rp _ -> isOutLnk rp)
& psFallback ?~ mntLightLnkCond' (resetPLUse useUnusedLnk)
let plmnts =
[ blockLine (V2 115 115) (V2 115 125)
src/Dodge/Room/Tutorial.hs
+1 -1
View File
@@ -213,7 +213,7 @@ tutLight = do
, cleatOnward corridor & rmPmnts .~ mempty
]
where
g = PSPos (\x _ -> f x) (\_ -> id) Nothing
g = PSPos (\x _ -> f x) (const id) Nothing
where
f x = case _rpType x of
NotLink{} | null (x ^. rpPlacementUse . at UsedPosFloor)
src/Dodge/Update.hs
+1 -1
View File
@@ -865,7 +865,7 @@ crCrSpring c1 c2
where
id1 = _crID c1
id2 = _crID c2
vec = c1 ^. crPos . _xy -.- c2 ^. crPos . _xy
vec = c1 ^. crPos . _xy - c2 ^. crPos . _xy
diff = magV vec
comRad = crRad (c1 ^. crType) + crRad (c2 ^. crType)
overlap1 = ((comRad - diff) * crMass (_crType c2) * 0.5 / massT) *.* errorNormalizeV 55 vec
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -215,7 +215,7 @@ rotateToOverlappingWall w =
w
where
cr = you w
p = (you w) ^. crPos . _xy
p = you w ^. crPos . _xy
doWallRotate :: Wall -> World -> World
doWallRotate wl w