Commit before door refactor

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

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)

src/Dodge/Default/Door.hs

@@ -13,5 +13,6 @@ defaultDoor = Door
     , _drClosePos = (0,0)
     , _drHP     = 10000
     , _drDeath  = const id
+    , _drSpeed  = 1
     }
 

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 

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
+--    ( initialRoomTree
-    ) where
+--    ) 
+    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. -}

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 -> ""

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
+    fireCondition = _rateTime (_useDelay (_itUse item)) == 0
-        && _rateTime (_useDelay (_itUse item)) == 0
+        && _arLoaded (_itConsumption item) > 0
-        && _laLoaded (_itConsumption item) > 0
 --    reloadCondition = _laLoaded (_itConsumption item) == 0
 withItem :: (Item -> ChainEffect) -> ChainEffect
 withItem g f it = g it f it

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)

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 :: [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World
-doorMechanism drid speed wlidOpCps dr w 
+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

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
 

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