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

Commit before door refactor

Browse Source
This commit is contained in:
justin
2022-06-23 09:30:46 +01:00
parent ee47ee8e95
commit 8e3f03637d
11 changed files with 76 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+7 -2
View File
@@ -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
+7
View File
@@ -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
+1
View File
@@ -13,5 +13,6 @@ defaultDoor = Door
, _drClosePos = (0,0)
, _drHP = 10000
, _drDeath = const id
, _drSpeed = 1
}
src/Dodge/Default/Weapon.hs
+4
View File
@@ -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
+10 -4
View File
@@ -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. -}
src/Dodge/Item/Display.hs
+9
View File
@@ -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
+5 -4
View File
@@ -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
src/Dodge/Placement/Instance/Door.hs
+7
View File
@@ -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
+12 -4
View File
@@ -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
src/Dodge/Room/LongDoor.hs
+2 -3
View File
@@ -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
+12
View File
@@ -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