From 8e3f03637d1294719c1ac77158a98be9d2069ae0 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Jun 2022 09:30:46 +0100 Subject: [PATCH] Commit before door refactor --- src/Dodge/Creature/State.hs | 9 +++++++-- src/Dodge/Data.hs | 7 +++++++ src/Dodge/Default/Door.hs | 1 + src/Dodge/Default/Weapon.hs | 4 ++++ src/Dodge/Floor.hs | 14 ++++++++++---- src/Dodge/Item/Display.hs | 9 +++++++++ src/Dodge/Item/Weapon/TriggerType.hs | 9 +++++---- src/Dodge/Placement/Instance/Door.hs | 7 +++++++ src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 16 ++++++++++++---- src/Dodge/Room/LongDoor.hs | 5 ++--- src/Dodge/Wall/Move.hs | 12 ++++++++++++ 11 files changed, 76 insertions(+), 17 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index ddf72c9c7..62cb44167 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -220,8 +220,13 @@ itemUpdate cr i | i == crSel cr = baseupdate True | otherwise = baseupdate False where - baseupdate bool = (itUse %~ useUpdate) . (itInvPos ?~ i) . (itIsHeld .~ bool) - + baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate) . (itInvPos ?~ i) . (itIsHeld .~ bool) +updateAutoRecharge :: Item -> Item +updateAutoRecharge it = case _itConsumption it of + AutoRecharging l m t p + | l < m && p <= 0 -> it & itConsumption .~ AutoRecharging (l+1) m t t + | l < m -> it & itConsumption . arProgress -~ 1 + _ -> it doItemTargeting :: Int -> Creature -> World -> World doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of Nothing -> w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 789b7b64c..fcaf6587e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -491,6 +491,12 @@ data ItemConsumption , _laCycle :: [LoadAction] , _laProgress :: Maybe [LoadAction] } + | AutoRecharging + { _arLoaded :: Int + , _arMax :: Int + , _arTime :: Int + , _arProgress :: Int + } | ChargeableAmmo { _wpMaxCharge :: Int , _wpCharge :: Int @@ -1011,6 +1017,7 @@ data Door = Door , _drClosePos :: (Point2,Point2) , _drHP :: Int , _drDeath :: Door -> World -> World + , _drSpeed :: Float } data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int deriving (Eq, Ord, Show) diff --git a/src/Dodge/Default/Door.hs b/src/Dodge/Default/Door.hs index 2a17eeb03..89a736f66 100644 --- a/src/Dodge/Default/Door.hs +++ b/src/Dodge/Default/Door.hs @@ -13,5 +13,6 @@ defaultDoor = Door , _drClosePos = (0,0) , _drHP = 10000 , _drDeath = const id + , _drSpeed = 1 } diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 2b685e125..650703f98 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -15,6 +15,9 @@ import Geometry import qualified Data.Map.Strict as M import Control.Lens +defaultLeftLoadable :: ItemConsumption +defaultLeftLoadable = AutoRecharging 10 10 100 100 + defaultLoadable :: ItemConsumption defaultLoadable = LoadableAmmo { _laAmmoType = GenericAmmo @@ -103,6 +106,7 @@ defaultAimParams = AimParams -- TODO change this defaultLeftItem :: Item defaultLeftItem = defaultWeapon + & itConsumption .~ defaultLeftLoadable defaultWeapon :: Item defaultWeapon = defaultItem diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 1fa0f4513..3177431e9 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -2,8 +2,9 @@ --{-# OPTIONS_GHC -Wno-unused-imports #-} {- | The tree of rooms that make up a level. -} module Dodge.Floor - ( initialRoomTree - ) where +-- ( initialRoomTree +-- ) + where import Dodge.Cleat --import Geometry.Data --import Dodge.Data @@ -40,9 +41,15 @@ initialAnoTree :: Annotation initialAnoTree = OnwardList $ intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom + , AnRoom slowDoorRoom , AnTree firstBreather + , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward + ] + +extraAnoList :: [Annotation] +extraAnoList = -- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) - , AnRoom $ roomCCrits 10 + [ AnRoom $ roomCCrits 10 , AnTree $ tToBTree "spawners" <$> spawnerRoom , AnRoom pistolerRoom , AnRoom doubleCorridorBarrels @@ -101,7 +108,6 @@ initialAnoTree = OnwardList -- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]] -- ,[Corridor] ,AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward - ,AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward ] {- | A test level tree. -} diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index fd25412b5..df3d0b570 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -40,10 +40,18 @@ itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it showSelectedConsumption :: Creature -> ItemConsumption -> String showSelectedConsumption cr ic = case ic of LoadableAmmo{} -> showReloadProgress cr ic + AutoRecharging {} -> showAutoRechargeProgress ic ChargeableAmmo{} -> show $ _wpCharge ic ItemItselfConsumable{} -> show (_icAmount ic) NoConsumption -> "" +showAutoRechargeProgress :: ItemConsumption -> String +showAutoRechargeProgress ic + | l < _arMax ic = show (_arProgress ic) ++ "C" ++ show l + | otherwise = show l + where + l = _arLoaded ic + showReloadProgress :: Creature -> ItemConsumption -> String showReloadProgress cr ic = case cr ^?! crInvSel . iselAction of ReloadAction i la _ -> show i ++ showLoadActionType la (_laLoaded ic) @@ -59,6 +67,7 @@ showLoadProgress x mlas = case mlas ^? _Just . ix 0 of showConsumption :: ItemConsumption -> String showConsumption ic = case ic of LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic) + AutoRecharging {} -> showAutoRechargeProgress ic ChargeableAmmo{} -> show $ _wpCharge ic ItemItselfConsumable{} -> show (_icAmount ic) NoConsumption -> "" diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index d80f11153..4a9686c9f 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -145,6 +145,8 @@ ammoHammerCheck eff it cr w setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse . useHammer . hammerPosition .~ HammerDown +itUseCharge :: Int -> Item -> Item +itUseCharge x = itConsumption . arLoaded %~ (max 0 . subtract x) itUseAmmo :: Int -> Item -> Item itUseAmmo x = itConsumption . laLoaded %~ (max 0 . subtract x) @@ -353,7 +355,7 @@ shootL -> World shootL f item cr w | fireCondition = f item cr w & pointerToItem %~ - ( itUseAmmo 1 + ( itUseCharge 1 . (itUse . useDelay . rateTime .~ _rateMax (_useDelay (_itUse item))) ) -- | reloadCondition = fromMaybe w $ startReloadingWeapon cr w | otherwise = w @@ -361,9 +363,8 @@ shootL f item cr w cid = _crID cr invid = fromJust $ _itInvPos item pointerToItem = creatures . ix cid . crInv . ix invid - fireCondition = crWeaponReady cr - && _rateTime (_useDelay (_itUse item)) == 0 - && _laLoaded (_itConsumption item) > 0 + fireCondition = _rateTime (_useDelay (_itUse item)) == 0 + && _arLoaded (_itConsumption item) > 0 -- reloadCondition = _laLoaded (_itConsumption item) == 0 withItem :: (Item -> ChainEffect) -> ChainEffect withItem g f it = g it f it diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index ec2dab0aa..0fad40027 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -30,6 +30,13 @@ putDoubleDoorThen pathing col cond soff a b speed cont doorbetween pa pb = pt0 $ PutSlideDr pathing col cond soff pa pb speed half = 0.5 *.* (a +.+ b) +--doorBetween pathing col cond soff pa pb speed g = case divideLine 80 pa pb of +-- [x,y] -> \_ -> Just (pt0 (PutSlideDr pathing col cond soff x y speed) g) +-- (x:y:zs) -> foldr f g (zip (x:y:zs) (y:zs)) +-- where +-- f :: (Point2,Point2) -> (Placement -> Maybe Placement) -> (Placement -> Maybe Placement) +-- f (a,b) h = \pl -> Just (pt0 (PutSlideDr pathing col cond (soff - dist y pb) a b speed) h) + putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor a b = PlacementUsingPos (addZ 0 a) $ \az -> PlacementUsingPos (addZ 0 b) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index bcd763750..5bec5cd73 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.TriggerDoor , plSlideDoor ) where import Dodge.Data +import Dodge.Base import Dodge.Default.Wall import Dodge.Default.Door import Dodge.Wall.Move @@ -74,14 +75,21 @@ doorMechanismStepwise nsteps drid wlids pss dr w newps = uncurry (rectanglePairs 9) (pss !! n) -- it is not at all clear that the zoning selects the correct walls -doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World -doorMechanism drid speed wlidOpCps dr w +doorMechanism :: [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World +doorMechanism wlidOpCps dr w | toOpen && dstatus /= DoorOpen = moveUpdate $ foldl' doOpen w wlidOpCps & doors . ix drid . drPos %~ mvPs speed (_drOpenPos dr) | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps & doors . ix drid . drPos %~ mvPs speed (_drClosePos dr) | otherwise = w where + toOpen = _drTrigger dr w + mvDir + | toOpen && dist dpos dop > 1 = Just $ mvPointTowardAtSpeed speed dop dpos + | dist dpos dcp > 1 = Just $ mvPointTowardAtSpeed speed dcp dpos + | otherwise = Nothing + speed = _drSpeed dr + drid = _drID dr moveUpdate = playSound . setStatus playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1) dpos = snd $ _drPos dr @@ -91,7 +99,6 @@ doorMechanism drid speed wlidOpCps dr w | dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed | otherwise = doors . ix drid . drStatus .~ DoorHalfway - toOpen = _drTrigger dr w dstatus = _drStatus dr doOpen w' (wlid,opp, _) = moveWallIDToward wlid speed opp w' doClose w' (wlid,_ ,clp) = moveWallIDToward wlid speed clp w' @@ -116,10 +123,11 @@ plSlideDoor isPathable col cond shiftOffset a b speed gw , _drWallIDs = IS.fromList wlids , _drStatus = DoorClosed , _drTrigger = cond - , _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs) + , _drMech = doorMechanism (zip3 wlids shiftedPairs pairs) , _drPos = (a,b) , _drOpenPos = (shiftLeft a,shiftLeft b) , _drClosePos = (a,b) + , _drSpeed = speed } addDoorWalls w' = foldl' (addDoorWall drid col isPathable) w' $ zip wlids pairs pairs = rectanglePairs 9 a b diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f146cc07c..bc02e6ba7 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -111,15 +111,14 @@ addButtonSlowDoor x h rm = do (rprBool (isUnusedLnkType InLink)) $ \btplmnt -> Just $ putDoubleDoorThen False col (cond' $ fromJust $ _plMID btplmnt) 30 (V2 0 h) (V2 x h) 2 - $ \dr1 dr2 -> amountedlight dr1 50 + $ \dr1 dr2 -> + amountedlight dr1 50 $ amountedlight dr1 (-50) $ amountedlight dr2 50 $ amountedlight dr2 (-50) Nothing getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos in (b, argV (a-.-b)) - --butPosCond = useRoomPosCond $ \rp _ -> isUnusedLnk' rp && yV2 (_rpPos rp) < 0.5 * h - --butPosCond _ = True -- y < h col = dim $ light red cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index 6ffc4d9c8..b727c809a 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -4,6 +4,7 @@ module Dodge.Wall.Move , moveWallIDUnsafe , moveWall , moveWallIDToward + , translateWallID , mvPs ) where import Dodge.Data @@ -11,6 +12,7 @@ import Dodge.Base import Geometry import Dodge.Wall.Zone +import Data.Maybe import Control.Lens import qualified Data.IntMap.Strict as IM @@ -29,6 +31,16 @@ moveWall wlid wl wlline w = w & walls . ix wlid .~ newwl & insertWallInZones newwl where newwl = wl {_wlLine = wlline} + +translateWallID :: Int -> Point2 -> World -> World +translateWallID wlid p w = fromMaybe w $ do + oldwl <- w ^? walls . ix wlid + let newwl = oldwl & wlLine . each +~ p + return $ w + & walls . ix wlid .~ newwl + & deleteWallFromZones oldwl + & insertWallInZones newwl + moveWallIDToward :: Int -> Float -> (Point2,Point2) -> World -> World moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w where