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

Cleanup, merge modules

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