Cleanup, merge modules

This commit is contained in:
2025-09-18 08:28:09 +01:00
parent f12ae3533c
commit 1564b1c721
23 changed files with 166 additions and 540 deletions
+21 -143
View File
@@ -2,162 +2,40 @@ Seed: 7114951007332849727
Room layout (compact):
0,1,2,3,4,5,6
|
+- 7,8,9,10,11,12,13,14,15,16,17,18,19,20,21
| |
| +- 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46
| | |
| | +- 47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64
| | |
| | 65,66
| |
| 67,68,69
+- 7,8
|
70,71,72
+- 9,10
|
11,12,13,14
Layout with room names:
rezBox-0
Corridor-0
|
autoDoor-1
6gon-1
|
rectPillars-2
defaultRoom-2
|
autoDoor-3
autoRect-3
|
Corridor-4
autoDoor-4
|
autoDoor-5
Corridor-5
|
ElecautoRect-6
doorToggle-6gon-6
|
+- triggerDoorRoom-7
| |
| autoDoor-8
| |
| autoDoor-9
| |
| Corridor-10
| |
| autoDoor-11
| |
| 8gon-12
| |
| triggerDoorRoom-13
| |
| autoDoor-14
| |
| autoDoor-15
| |
| Corridor-16
| |
| autoRect-17
| |
| autoDoor-18
| |
| Corridor-19
| |
| autoDoor-20
| |
| 6gon-21
| |
| +- triggerDoorRoom-22
| | |
| | autoDoor-23
| | |
| | autoDoor-24
| | |
| | Corridor-25
| | |
| | autoDoor-26
| | |
| | doorToggle-autoRect-27
| | |
| | triggerDoorRoom-28
| | |
| | autoDoor-29
| | |
| | autoDoor-30
| | |
| | Corridor-31
| | |
| | autoRect-32
| | |
| | autoDoor-33
| | |
| | Corridor-34
| | |
| | autoDoor-35
| | |
| | Corridor-36
| | |
| | 8gon-37
| | |
| | triggerDoorRoom-38
| | |
| | autoDoor-39
| | |
| | autoDoor-40
| | |
| | Corridor-41
| | |
| | tanksRoom-42
| | |
| | autoDoor-43
| | |
| | Corridor-44
| | |
| | autoDoor-45
| | |
| | 8gon-46
| | |
| | +- triggerDoorRoom-47
| | | |
| | | autoDoor-48
| | | |
| | | autoDoor-49
| | | |
| | | Corridor-50
| | | |
| | | autoRect-51
| | | |
| | | defaultRoom-52
| | | |
| | | autoRect-53
| | | |
| | | defaultRoom-54
| | | |
| | | autoRect-55
| | | |
| | | autoDoor-56
| | | |
| | | Corridor-57
| | | |
| | | autoDoor-58
| | | |
| | | 8gon-59
| | | |
| | | triggerDoorRoom-60
| | | |
| | | autoDoor-61
| | | |
| | | autoDoor-62
| | | |
| | | Corridor-63
| | | |
| | | defaultRoom-64
| | |
| | autoDoor-65
| | |
| | Corridor-66
| |
| autoDoor-67
| |
| Corridor-68
| |
| rect-69
| autoRect-8
|
autoDoor-70
+- triggerDoorRoom-9
| |
| autoRect-10
|
Corridor-71
Corridor-11
|
defaultRoom-72
6gon-12
|
defaultRoom-13
|
autoRect-14
+1 -1
View File
@@ -1,4 +1,4 @@
Generating level with seed 7114951007332849727
After 1 attempt(s), Successful generation of level with seed 7114951007332849727
73 rooms in total
15 rooms in total
+28 -248
View File
@@ -1,269 +1,49 @@
Seed: 7114951007332849727
0:startThenWeaponRoom
0:teststart
|
1:corDoor
1:TutDrop
|
2:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
2:corDoor
|
3:corDoor
3:DoorTest
|
4:lasSensorTurretTest
|
5:corDoor
|
6:anRoom
|
7:corDoor
|
8:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
|
9:corDoor
|
10:warningRooms
|
11:corDoor
|
12:chaseCrit+armourChaseCrit rectRoom
|
13:corDoor
|
14:healthTest
|
15:corDoor
|
16:empty tanksRoom
|
17:corDoor
|
18:PassthroughLockKeyLists-LASER
|
19:corDoor
|
20:shootingRange
|
21:corDoor
|
22:lasSensorTurretTest
|
23:corDoor
|
24:randomFourCornerRoom
4:TutDrop
0:0:startThenWeaponRoom
0:0:teststart
0:0:0:Corridor
1:0:TutDrop
1:0:0:6gon
|
0:1:weaponBetweenPillars_BANGSTICK4
0:0:0:rezBox'
0:0:0:0:rezBox
1:0:1:defaultRoom
|
0:0:0:1:autoDoor
1:0:2:autoRect
0:1:0:rectPillars
2:0:corDoor
1:0:corDoor
1:0:0:autoDoor
2:0:0:autoDoor
|
1:0:1:Corridor
2:0:1:Corridor
2:0:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
3:0:DoorTest
2:0:0:RassThroughLockKeyLists
3:0:0:doorToggle-6gon
|
2:0:1:roomsContaining chaseCritchaseCritchaseCritTRANSFORMERCANCAN
2:0:0:0:sensorRoomRunPast
2:0:0:0:0:autoDoor
|
2:0:0:0:1:ElecautoRect
|
+- 2:0:0:0:2:triggerDoorRoom
+- 3:0:1:triggerDoorRoom
| |
| 2:0:0:0:3:autoDoor
| 3:0:2:autoRect
|
2:0:0:0:4:autoDoor
|
2:0:0:0:5:Corridor
2:0:1:0:defaultRoom
3:0:corDoor
3:0:0:autoDoor
|
3:0:1:Corridor
4:0:lasSensorTurretTest
4:0:0:autoDoor
|
4:0:1:8gon
|
4:0:2:triggerDoorRoom
|
4:0:3:autoDoor
5:0:corDoor
5:0:0:autoDoor
|
5:0:1:Corridor
6:0:anRoom
6:0:0:autoRect
7:0:corDoor
7:0:0:autoDoor
|
7:0:1:Corridor
8:0:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
8:0:0:RassThroughLockKeyLists
|
8:0:1:roomsContaining chaseCritKEYCARD 0
8:0:0:0:keyCardRoomRunPast
8:0:0:0:0:autoDoor
|
8:0:0:0:1:6gon
|
+- 8:0:0:0:2:triggerDoorRoom
+- 3:0:3:triggerDoorRoom
| |
| 8:0:0:0:3:autoDoor
| 3:0:4:autoRect
|
8:0:0:0:4:autoDoor
3:0:5:Corridor
4:0:6gon
|
8:0:0:0:5:Corridor
8:0:1:0:rect
9:0:corDoor
9:0:0:autoDoor
4:1:defaultRoom
|
9:0:1:Corridor
10:0:warningRooms
10:0:0:autoDoor
|
10:0:1:doorToggle-autoRect
|
10:0:2:triggerDoorRoom
|
10:0:3:autoDoor
11:0:corDoor
11:0:0:autoDoor
|
11:0:1:Corridor
12:0:chaseCrit+armourChaseCrit rectRoom
12:0:0:autoRect
13:0:corDoor
13:0:0:autoDoor
|
13:0:1:Corridor
14:0:healthTest
14:0:0:autoDoor
|
14:0:1:Corridor
|
14:0:2:8gon
|
14:0:3:triggerDoorRoom
|
14:0:4:autoDoor
15:0:corDoor
15:0:0:autoDoor
|
15:0:1:Corridor
16:0:empty tanksRoom
16:0:0:tanksRoom
17:0:corDoor
17:0:0:autoDoor
|
17:0:1:Corridor
18:0:PassthroughLockKeyLists-LASER
18:0:0:RassThroughLockKeyLists
|
18:0:1:roomsContaining chaseCritPRISMTRANSFORMERPIPE
18:0:0:0:lasCenSensEdge
18:0:0:0:0:autoDoor
|
18:0:0:0:1:8gon
|
+- 18:0:0:0:2:triggerDoorRoom
| |
| 18:0:0:0:3:autoDoor
|
18:0:0:0:4:autoDoor
|
18:0:0:0:5:Corridor
18:0:1:0:autoRect
19:0:corDoor
19:0:0:autoDoor
|
19:0:1:Corridor
20:0:shootingRange
20:0:0:autoRect
|
20:0:1:defaultRoom
|
20:0:2:autoRect
|
20:0:3:defaultRoom
|
20:0:4:autoRect
21:0:corDoor
21:0:0:autoDoor
|
21:0:1:Corridor
22:0:lasSensorTurretTest
22:0:0:autoDoor
|
22:0:1:8gon
|
22:0:2:triggerDoorRoom
|
22:0:3:autoDoor
23:0:corDoor
23:0:0:autoDoor
|
23:0:1:Corridor
24:0:defaultRoom
4:2:autoRect
+1 -1
View File
File diff suppressed because one or more lines are too long
+11 -11
View File
@@ -1,17 +1,17 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Cleat
( toLabel
, cleatOnward
, cleatSide
, rToOnward
, cleatLabel
) where
import Dodge.Data.GenWorld
import Dodge.Tree.Compose
module Dodge.Cleat (
toLabel,
cleatOnward,
cleatSide,
rToOnward,
cleatLabel,
) where
import Data.Tree
import Control.Lens
import qualified Data.Set as S
import Data.Tree
import Dodge.Data.GenWorld
import Dodge.Tree.Compose
toLabel :: Int -> Room -> Maybe Room
toLabel i rm
@@ -19,7 +19,7 @@ toLabel i rm
| otherwise = Nothing
rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room String)
rToOnward s t = return $ tToBTree s t
rToOnward s = return . tToBTree s
cleatOnward :: Room -> Room
cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
+1 -1
View File
@@ -5,7 +5,7 @@
module Dodge.Data.GenParams where
import Dodge.Data.Machine.Sensor.Type
import Dodge.Data.Machine.Sensor
import Color
import Control.Lens
import Data.Aeson
+9 -14
View File
@@ -76,15 +76,12 @@ data PlacementSpot
}
-- TODO attempt to unify/simplify this union type
data Placement
= Placement
{ _plOrder :: Int
, _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
}
-- | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
data Placement = Placement
{ _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
}
{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
@@ -107,9 +104,9 @@ data Room = Room
, _rmPos :: [RoomPos]
, _rmPath :: S.Set (Point2, Point2)
, _rmPmnts :: [Placement]
, _rmInPmnt :: [InPlacement]
-- note that in placements form a list: multiple InPlacements can use the same id
, _rmOutPmnt :: IM.IntMap Placement
, _rmInPmnt :: [InPlacement]
, -- note that in placements form a list: multiple InPlacements can use the same id
_rmOutPmnt :: IM.IntMap Placement
, _rmBound :: [[Point2]]
, _rmFloor :: Floor
, _rmName :: String
@@ -126,8 +123,6 @@ data Room = Room
, _rmClusterStatus :: ClusterStatus
}
--data OutPlacement = OutPlacement { _opPlacement :: Placement }
data InPlacement = InPlacement
{ _ipPlacement :: World -> [Placement] -> Placement
, _ipPlacementID :: Int
+22 -8
View File
@@ -3,18 +3,22 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine.Sensor (
module Dodge.Data.Machine.Sensor,
module Dodge.Data.Machine.Sensor.Type,
) where
module Dodge.Data.Machine.Sensor (module Dodge.Data.Machine.Sensor) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Combine
import Dodge.Data.Machine.Sensor.Type
import Geometry.Data
data SensorType
= LaserSensor
| ElectricSensor
| ThermalSensor
| PhysicalSensor
deriving (Eq, Ord, Show, Read, Bounded, Enum)
data DamageSensor = DamSensor
{ _sensAmount :: Int
, _sensType :: SensorType
@@ -22,19 +26,29 @@ data DamageSensor = DamSensor
}
data ProximitySensor = ProxSensor
{ _proxRequirement :: ProximityRequirement
{ _proxSensorType :: ProximitySensorType
, _proxToggle :: Bool
}
data ProximitySensorType
= SensorWithRequirement ProximityRequirement
| NoItemZone [Point2]
data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemType}
| RequireNoItems {_proxNoItems :: [Point2]}
deriving (Show)
makeLenses ''DamageSensor
makeLenses ''ProximitySensor
makeLenses ''ProximityRequirement
makeLenses ''ProximitySensorType
makePrisms ''ProximityRequirement
deriveJSON defaultOptions ''SensorType
deriveJSON defaultOptions ''ProximityRequirement
deriveJSON defaultOptions ''ProximitySensorType
deriveJSON defaultOptions ''ProximitySensor
deriveJSON defaultOptions ''DamageSensor
instance ToJSONKey SensorType
instance FromJSONKey SensorType
-22
View File
@@ -1,22 +0,0 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine.Sensor.Type where
import Data.Aeson
import Data.Aeson.TH
data SensorType
= LaserSensor
| ElectricSensor
| ThermalSensor
| PhysicalSensor
deriving (Eq, Ord, Show, Read, Bounded, Enum)
deriveJSON defaultOptions ''SensorType
instance ToJSONKey SensorType
instance FromJSONKey SensorType
+1 -1
View File
@@ -65,6 +65,6 @@ defaultPP =
defaultProximitySensor :: ProximitySensor
defaultProximitySensor =
ProxSensor
{ _proxRequirement = RequireHealth 0
{ _proxSensorType = SensorWithRequirement $ RequireHealth 0
, _proxToggle = False
}
+20 -20
View File
@@ -7,34 +7,34 @@ import Geometry
--spNoID
psPtPl :: PlacementSpot -> PSType -> Placement
psPtPl ps pst = Placement 10 ps pst Nothing (const . const Nothing)
psPtPl ps pst = Placement ps pst Nothing (const . const Nothing)
psPtJpl :: PlacementSpot -> PSType -> Maybe Placement
psPtJpl ps = Just . psPtPl ps
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement 10 ps pt Nothing . contToIDCont
pContID ps pt = Placement ps pt Nothing . contToIDCont
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement 10 ps pt Nothing . const
psPtCont ps pt = Placement ps pt Nothing . const
ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement
ptCont = psPtCont (PS 0 0)
psPt :: PlacementSpot -> PSType -> Placement
psPt ps pt = Placement 10 ps pt Nothing (const . const Nothing)
psPt ps pt = Placement ps pt Nothing (const . const Nothing)
sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement 10 (PS p a) pt Nothing (const . const Nothing)
sPS p a pt = Placement (PS p a) pt Nothing (const . const Nothing)
sps :: PlacementSpot -> PSType -> Placement
sps ps pt = Placement 10 ps pt Nothing (const . const Nothing)
sps ps pt = Placement ps pt Nothing (const . const Nothing)
plRRpt :: Int -> PSType -> Placement
plRRpt i pt = Placement 10 (PSRoomRand i (uncurry PS)) pt Nothing (const . const Nothing)
plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const . const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement 10 (PS p a) pst Nothing $ const . const Nothing
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const . const Nothing
jsps0 :: PSType -> Maybe Placement
jsps0 = Just . sPS (V2 0 0) 0
@@ -43,51 +43,51 @@ sps0 :: PSType -> Placement
sps0 = sPS (V2 0 0) 0
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
jspsJ p a pst plm = Just $ Placement 10 (PS p a) pst Nothing $ \_ _ -> Just plm
jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ _ -> Just plm
jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement 10 (PS (V2 0 0) 0) pst Nothing $ \_ _ -> Just plm
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ _ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement 10 (PS (V2 0 0) 0) pst Nothing . contToIDCont
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
pt0 pst = Placement 10 (PS (V2 0 0) 0) pst Nothing . const
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing . const
contToIDCont :: (Int -> Maybe Placement) -> World -> Placement -> Maybe Placement
contToIDCont f _ = f . fromJust . _plMID
jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
jps0' pst = Just . Placement 10 (PS (V2 0 0) 0) pst Nothing . const
jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . const
jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0PushPS pst f = Just . Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement 10 (PS (V2 0 0) 0) pst Nothing (\_ -> const $ Just plmnt)
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\_ -> const $ Just plmnt)
psj :: PlacementSpot -> PSType -> Placement -> Placement
psj ps pst plmnt = Placement 10 ps pst Nothing (\_ -> const $ Just plmnt)
psj ps pst plmnt = Placement ps pst Nothing (\_ -> const $ Just plmnt)
-- the NoShiftCont is necessary when shifting then combining rooms
ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\_ p -> Just $ plmnt & plSpot .~ _plSpot p
-- the NoShiftCont is necessary when shifting then combining rooms
ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement
ps0PushPS pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
ps0PushPSw :: PSType -> (World -> Placement -> Maybe Placement) -> Placement
ps0PushPSw pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
\w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl)
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of
-- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f)
(Placement ps pt mi f) -> Placement ps pt mi (fmap (fmap g) f)
where
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'
+21 -21
View File
@@ -1,17 +1,17 @@
module Dodge.Machine.Draw (drawMachine) where
import Dodge.Data.CWorld
import Dodge.Terminal.Color
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Data.CWorld
import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import Dodge.Placement.TopDecoration
import Dodge.Terminal.Color
import Geometry
import Picture
import Shape
import ShapePicture
import qualified Data.Map.Strict as M
drawMachine :: CWorld -> Machine -> SPic
drawMachine cw mc = case _mcType mc of
@@ -24,18 +24,18 @@ drawMachine cw mc = case _mcType mc of
lw = cw ^. lWorld
gp = cw ^. cwGen . cwgParams . sensorCoding
drawDamSensor :: M.Map SensorType (PaletteColor, DecorationShape)
-> DamageSensor -> Machine -> SPic
drawDamSensor gp sens mc = --case sens of
--DamSensor{_sensDraw = pcds} -> sensorSPic pcds
fold $ do
let st = sens ^. sensType
x <- gp ^? ix st
return $ sensorSPic x mc
drawDamSensor ::
M.Map SensorType (PaletteColor, DecorationShape) ->
DamageSensor ->
Machine ->
SPic
drawDamSensor gp sens mc = fold $ do
let st = sens ^. sensType
x <- gp ^? ix st
return $ sensorSPic x mc
drawProxSensor :: ProximitySensor -> Machine -> SPic
drawProxSensor sens = case sens of
ProxSensor{} -> const mempty
drawProxSensor _ = const mempty
terminalSPic :: LWorld -> Machine -> SPic
terminalSPic lw = noPic . terminalShape lw
@@ -56,14 +56,14 @@ terminalShape lw mc = fromMaybe mempty $ do
<> screenbackground (getcol term)
where
getcol term = fromMaybe black $ termScreenColor term
screenbackground col = colorSH
col
( prismBox
Small
Typical
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
)
screenbackground col =
colorSH
col
$ prismBox
Small
Typical
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
drawBaseMachine :: Float -> Machine -> SPic
drawBaseMachine h mc =
+10 -17
View File
@@ -136,9 +136,9 @@ mcDamSensorUpdate :: DamageSensor -> Machine -> World -> World
mcDamSensorUpdate se = senseDamage (_sensThreshold se) (_sensType se)
mcProxSensorUpdate :: ProximitySensor -> Machine -> World -> World
mcProxSensorUpdate se mc = case se ^. proxRequirement of
RequireNoItems xs -> mcNoItemsTest mc xs
_ -> mcProximitySensorUpdate mc se
mcProxSensorUpdate se mc = case se ^. proxSensorType of
NoItemZone xs -> mcNoItemsTest mc xs
SensorWithRequirement pr -> mcProximitySensorUpdate mc se pr
mcNoItemsTest :: Machine -> [Point2] -> World -> World
mcNoItemsTest mc ps w
@@ -158,10 +158,11 @@ mcNoItemsTest mc ps w
qs = f ps
f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
mcProximitySensorUpdate :: Machine -> ProximitySensor -> World -> World
mcProximitySensorUpdate mc sens w
mcProximitySensorUpdate
:: Machine -> ProximitySensor -> ProximityRequirement -> World -> World
mcProximitySensorUpdate mc sens pr w
| sens ^. proxToggle || dist (_crPos ycr) (_mcPos mc) > 40 = w
| mcProxTest mc w (sens ^. proxRequirement) =
| mcProxTest w pr =
w
& mcsenslens . proxToggle .~ True
& playsound dedaS
@@ -169,10 +170,7 @@ mcProximitySensorUpdate mc sens w
| otherwise =
w & playsound dedumS
& mctermlens . tmFutureLines
.:~ makeTermLine
( "SENSOR FAIL: REQUIRES "
++ sensorReqToString (mc ^?! mcType . _McProxSensor . proxRequirement)
)
.:~ makeTermLine ( "SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
where
mctermlens = cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal)
mcsenslens = cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McProxSensor
@@ -183,21 +181,16 @@ sensorReqToString :: ProximityRequirement -> String
sensorReqToString = \case
RequireHealth x -> "HEALTH ABOVE " ++ show x
RequireEquipment x -> itemBaseName x
RequireNoItems _ -> "NO NEARBY ITEMS"
mcProxTest :: Machine -> World -> ProximityRequirement -> Bool
mcProxTest mc w = \case
mcProxTest :: World -> ProximityRequirement -> Bool
mcProxTest w = \case
RequireHealth x -> _crHP cr >= x
RequireEquipment ct ->
any
(\itm -> _itType itm == ct)
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
RequireNoItems ps ->
(w ^?! cWorld . lWorld . creatures . ix 0 . crInv == mempty)
&& not (any ((`pointInPoly` f ps) . _flItPos) (w ^. cWorld . lWorld . floorItems))
where
cr = you w
f = fmap ((+ _mcPos mc) . rotateV (_mcDir mc))
senseDamage :: Int -> SensorType -> Machine -> World -> World
senseDamage threshold dt mc =
+3 -3
View File
@@ -7,8 +7,8 @@ import Dodge.Placement.Instance
--import Dodge.Terminal
import LensHelp
analyser :: ProximityRequirement -> PlacementSpot -> PlacementSpot -> Placement
analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
analyser :: ProximitySensorType -> PlacementSpot -> PlacementSpot -> Placement
analyser pst pslight psmc = extTrigLitPos pslight $ \tp ->
Just $
plSpot .~ psmc $
putTerminal (dark magenta)
@@ -20,4 +20,4 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
defaultMachine & mcColor .~ aquamarine
& mcType .~ McTerminal
& mcHP .~ 100
& mcType .~ McProxSensor (defaultProximitySensor{_proxRequirement = proxreq})
& mcType .~ McProxSensor (ProxSensor pst False)
+2 -2
View File
@@ -76,8 +76,8 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
& drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = Placement 0 (PS 0 0) (PutCoord a) Nothing $ \_ apl ->
Just $ Placement 0 (PS 0 0) (PutCoord b) Nothing $ \w bpl ->
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing $ \_ apl ->
Just $ Placement (PS 0 0) (PutCoord b) Nothing $ \w bpl ->
let x = w ^?! coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! coordinates . ix (bpl ^?! plMID . _Just)
in Just $ putDoubleDoor
+1 -1
View File
@@ -174,7 +174,7 @@ spanLSLightI ls h a b =
spanLS :: LightSource -> Point2 -> Point2 -> Placement
spanLS ls a b =
Placement 10 (PS (V2 x y) 0) (PutLS ls) Nothing $
Placement (PS (V2 x y) 0) (PutLS ls) Nothing $
const $ const $ Just $ sps0 $ putShape $ thinHighBar h a b
where
V3 _ _ h = _lsPos (_lsParam ls) + 5
@@ -1,4 +1,4 @@
module Dodge.Placement.Instance.LightSource.Flicker where
module Dodge.Placement.Instance.LightSource.Flicker (flickerMod, flickerUpdate) where
import Control.Lens
import Data.Maybe
@@ -30,7 +30,7 @@ flickerUpdate md w
%~ ((mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not))
where
mdcol = _mdPoint3 md
lscol = w ^?! cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
lscol = w ^?! cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol
lsid = _mdExternalID md
mdid = _mdID md
timerange
+7 -17
View File
@@ -36,12 +36,8 @@ placeSpot (w, rm) plmnt = case plmnt of
where
shift = _rmShift rm
placePlainPSSpot ::
GenWorld ->
Room ->
Placement ->
DPoint2 ->
((GenWorld, Room), [Placement])
placePlainPSSpot
:: GenWorld -> Room -> Placement -> DPoint2 -> ((GenWorld, Room), [Placement])
placePlainPSSpot w rm plmnt shift =
let (i, w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
newplmnt = plmnt & plMID ?~ i
@@ -106,7 +102,8 @@ placeSpotID' ps pt w = case pt of
)
)
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID
(mvFS p rot fs) w
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
@@ -138,12 +135,6 @@ evaluateRandPS rgen ps w = placeSpotID' ps evaluatedType (set randGen g w)
where
(evaluatedType, g) = runState rgen (_randGen w)
--placeWallPoly :: [Point2] -> Wall -> World -> World
--placeWallPoly ps wl = -- rmCrossPaths .
-- over walls (placeWalls ps wl)
---- where
---- rmCrossPaths w = foldr (uncurry obstructPathsCrossing) w $ loopPairs ps
-- this function is the reason for the warning suppression
-- remove the warning suppression if it changes
placeWallPoly :: [Point2] -> Wall -> World -> World
@@ -212,11 +203,11 @@ plMachine' wallpoly mc wl p rot gw =
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls
:: Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopPairs poly
where
f (wid, l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
@@ -227,7 +218,6 @@ placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid ..] $ loopP
& wlTouchThrough .~ True
mvLS :: Point3 -> Float -> LightSource -> LightSource
mvLS (V3 x y z) rot ls =
ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
where
startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)
-1
View File
@@ -25,4 +25,3 @@ shiftPlacement shift plmnt = case plmnt of
Placement{} ->
plmnt & plSpot %~ shiftPSBy shift
& plIDCont %~ fmap (fmap (fmap $ shiftPlacement shift))
-- RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
+2 -3
View File
@@ -136,7 +136,6 @@ setFallback fallback =
)
unusedOffPathAwayFromLink :: Float -> PlacementSpot
--unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
unusedOffPathAwayFromLink x = rprBool $ \rp r ->
_rpPlacementUse rp == 0
&& all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
@@ -156,9 +155,9 @@ twoRoomPoss ::
(RoomPos -> Room -> Bool) ->
(PlacementSpot -> PlacementSpot -> Placement) ->
Placement
twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing $
twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing $
\_ pl1 -> Just $
Placement 10 (rprBool cond2) PutNothing Nothing $
Placement (rprBool cond2) PutNothing Nothing $
\_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
--isUnusedLnk :: RoomPos -> Bool
+1 -1
View File
@@ -40,7 +40,7 @@ decontamRoom = do
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, analyser (RequireNoItems $ ps) (PS 50 0) (PS mcpos 0)
, analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
+1 -1
View File
@@ -84,7 +84,7 @@ analyserByNthLink n proxreq i rm =
]
& rmOutPmnt . at i ?~
analyser
proxreq
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
where
+1 -1
View File
@@ -126,5 +126,5 @@ roomPillars pillarsize w h wn hn = do
where
pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize
pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize
testchasm = Placement 0 (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing
testchasm = Placement (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing
(\_ _ -> Nothing)