Rename ItemAttachments

This commit is contained in:
2022-06-15 08:21:53 +01:00
parent 485c42eb24
commit bf1bfa5453
15 changed files with 98 additions and 80 deletions
+2 -2
View File
@@ -67,8 +67,8 @@ basicItemDisplay it = Prelude.take (itSlotsTaken it) $
maybeModeStatus :: Item -> Maybe String
maybeModeStatus it = case it ^? itAttachment of
Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c]
Just ItMode {_itMode = i} -> Just $ show i
Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
Just AttachMode {_atMode = i} -> Just $ show i
_ -> Nothing
maybeRateStatus :: Item -> Maybe String
+2 -1
View File
@@ -38,8 +38,9 @@ import Data.List (intersperse)
initialAnoTree :: Annotation
initialAnoTree = OnwardList
$ intersperse (AnTree $ tToBTree "door" . pure <$> shuffleLinks (cleatOnward door))
$ intersperse (AnTree corDoor)
[ IntAnno $ AnTree . startRoom
, AnTree firstBreather
-- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
, AnRoom $ roomCCrits 10
, AnTree $ tToBTree "spawners" <$> spawnerRoom
+5 -5
View File
@@ -26,7 +26,7 @@ scrollCharMode x _
incCharMode
:: Item
-> Item
incCharMode = itAttachment . itCharMode %~ cycleL
incCharMode = itAttachment . atCharMode %~ cycleL
where
cycleL (x :<| xs) = xs |> x
cycleL xs = xs
@@ -34,7 +34,7 @@ incCharMode = itAttachment . itCharMode %~ cycleL
decCharMode
:: Item
-> Item
decCharMode = itAttachment . itCharMode %~ cycleR
decCharMode = itAttachment . atCharMode %~ cycleR
where
cycleR (xs :|> x) = x <| xs
cycleR xs = xs
@@ -43,7 +43,7 @@ charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv
. ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . itCharMode of
. ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . atCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
@@ -55,10 +55,10 @@ changeFuse
-> Item
-> Item
changeFuse scrollAmount _ it = it
& ( itAttachment .~ ItFuse newTime )
& ( itAttachment .~ AttachFuse newTime )
& ( itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
where
oldTime = _itFuseTime $ _itAttachment it
oldTime = _atFuseTime $ _itAttachment it
newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount)
zm = 50 / fromIntegral newTime
+8 -8
View File
@@ -8,14 +8,14 @@ import Control.Lens
import qualified Data.Sequence as Seq
data ItAttachment
= ItFuse {_itFuseTime :: Int}
| ItMode {_itMode :: Int}
| ItCharMode {_itCharMode :: Seq.Seq Char }
| ItTargetPos { _itTargetPos :: Point2 }
| ItInt { _itInt :: Int }
| ItMInt { _itMInt :: Maybe Int }
| ItFloat { _itFloat :: Float }
| ItBool { _itBool :: Bool }
= AttachFuse {_atFuseTime :: Int}
| AttachMode {_atMode :: Int}
| AttachCharMode {_atCharMode :: Seq.Seq Char }
| AttachTargetPos { _atTargetPos :: Point2 }
| AttachInt { _atInt :: Int }
| AttachMInt { _atMInt :: Maybe Int }
| AttachFloat { _atFloat :: Float }
| AttachBool { _atBool :: Bool }
| NoItAttachment
data Scope = NoScope
+2 -2
View File
@@ -39,7 +39,7 @@ magShield :: Item
magShield = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itAttachment = ItMInt Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ useMagShield
& itUse . eqEq . eqSite .~ GoesOnWrist
@@ -53,7 +53,7 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet
,_mgPos = _crPos cr
,_mgField = curveAroundField 50 200
}
mgid = case it ^? itAttachment . itMInt . _Just of
mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets w
-- it = _crInv cr IM.! invid
+2 -2
View File
@@ -43,14 +43,14 @@ boostSelfL x itm cr w = case boostPoint x cr w of
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (IM.newKey $ _props w)
(cr ^? crInv . ix invid . itAttachment . itInt)
(cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& creatures . ix cid %~
(crPos .~ p)
. (crInv . ix invid %~
ammoEff
. (itEffect . ieCounter .~ 1)
. (itAttachment .~ ItInt pid)
. (itAttachment .~ AttachInt pid)
)
addBoostShockwave
+1 -1
View File
@@ -73,7 +73,7 @@ autoGun = defaultAutoGun
-- , _itFloorPict = autoGunPic
-- , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim
, _itAttachment = ItCharMode $ Seq.fromList "MS"
, _itAttachment = AttachCharMode $ Seq.fromList "MS"
, _itParams = BulletShooter
{ _muzVel = 1
, _rifling = 0.9
+1 -1
View File
@@ -111,7 +111,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
dir = argV v
setWp :: World -> World
setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
fuseTime = _itFuseTime $ _itAttachment $ _crInv cr IM.! j
fuseTime = _atFuseTime $ _itAttachment $ _crInv cr IM.! j
throwArmReset :: Int -> ItEffect
throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x }
+3 -3
View File
@@ -68,7 +68,7 @@ shrinkGun = defaultGun
, _itUse = defaultlUse {_lUse = hammerCheckL useShrinkGun}
& useHammer .~ upHammer
-- , _itFloorPict = shrinkGunPic
, _itAttachment = ItBool True
, _itAttachment = AttachBool True
}
& itType . iyBase .~ SHRINKER
@@ -79,14 +79,14 @@ shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5
-- creature but using the old crInvSel value
-- 22.05.23 this has been changed from using invids to items
useShrinkGun :: Item -> Creature -> World -> World
useShrinkGun it cr w = if _itBool $ _itAttachment it
useShrinkGun it cr w = if _atBool $ _itAttachment it
then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr
where
invid = fromJust $ _itInvPos it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~
( (itAttachment . itBool .~ isInUse) . (itCurseStatus .~ cstatus) )
( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
blinkGun :: Item
blinkGun = defaultGun
+2
View File
@@ -1,6 +1,7 @@
{- Specification of individual rooms. -}
module Dodge.Room
( module Dodge.Room.Room
, module Dodge.Room.Breather
, module Dodge.Room.RoadBlock
, module Dodge.Room.LasTurret
, module Dodge.Room.Foreground
@@ -26,6 +27,7 @@ module Dodge.Room
, module Dodge.Room.Pillar
) where
import Dodge.Room.Room
import Dodge.Room.Breather
import Dodge.Room.RoadBlock
import Dodge.Room.LasTurret
import Dodge.Room.Treasure
+10 -1
View File
@@ -30,5 +30,14 @@ import Dodge.Room.Containing
firstBreather :: State StdGen (MetaTree Room String)
firstBreather = do
itms <- takeOne [[],[itemFromBase $ CRAFT TUBE]]
itms <- takeOne
[[]
,[itemFromBase $ CRAFT TUBE]
,[itemFromBase $ CRAFT PIPE]
,[itemFromBase $ CRAFT HARDWARE]
,[itemFromBase $ CRAFT CAN]
,[itemFromBase $ CRAFT TIN]
,[itemFromBase $ CRAFT PLANK]
,[itemFromBase $ CRAFT DRUM]
]
roomsContaining [] itms
+15 -10
View File
@@ -3,8 +3,10 @@ module Dodge.Room.Containing where
import Dodge.Data
import Dodge.Tree
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
import RandomHelp
import Dodge.Room.Procedural
import Dodge.Room.Pillar
import Dodge.Room.Tanks
import Dodge.Room.Link
import Dodge.Room.Ngon
@@ -13,25 +15,28 @@ import LensHelp
import Geometry
--import Dodge.Item.Equipment
import Data.List
roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String)
roomsContaining crs its = do
endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
]
rToOnward ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs)
++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its))
$ pure $ cleatOnward endroom
roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs its
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do
endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
, roomPillarsContaining crs its
]
return (pure $ cleatOnward endroom)
roomPillarsContaining :: RandomGen g => [Creature] -> [Item] -> State g Room
roomPillarsContaining crs itms = do
(w,wn) <- takeOne [(240,2),(340,3)]
(h,hn) <- takeOne [(240,2),(340,3)]
let plmnts =
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
roomPillars 30 w h wn hn <&> rmPmnts .++~ plmnts
pedestalRoom :: RandomGen g => Item -> State g Room
pedestalRoom it = do
let flit = PutFlIt it
+2
View File
@@ -36,6 +36,8 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
h = h' - 9
aline = PutLineBlock baseBlockPane StoneBlock 9 9
--longPillars :: Float -> Float
roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
roomPillars pillarsize w h wn hn = do
let rm = roomRect w h wn hn
+37 -44
View File
@@ -91,40 +91,34 @@ roomRect x y xn yn = defaultRoom
zipCountDown :: [a] -> [(Int,a)]
zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType)
-> (Int -> RoomLinkType)
lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) -> (Int -> RoomLinkType)
-> Int -> (Int,(Point2,Float)) -> RoomLink
lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
{_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
,_rlPos = p
{ _rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
, _rlPos = p
, _rlDir = a
}
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
-- it is not clear to me that this works for very small rooms (but it does seem
-- to do so)
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y (f x) (f y))
{_rmPmnts = plmnts
,_rmName = "autoRect"
}
roomRectAutoLinks x y = roomRect x y (f x) (f y)
& rmName .~ "autoRect"
& rmPmnts .~ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
where
f z = max 1 $ (ceiling z - 40) `div` 60
plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
{- Combines two rooms into one room.
- will have to work out exactly what to do with combining links
Mostly involves concatenation. -}
combineRooms :: Room -> Room -> Room
combineRooms r r' = defaultRoom
{ _rmPolys = _rmPolys r ++ _rmPolys r'
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = map clampPath $ _rmPath r
++ _rmPath r'
, _rmPmnts = _rmPmnts r ++ _rmPmnts r'
--, _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r)
-- ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
, _rmBound = _rmBound r ++ _rmBound r'
, _rmPos = _rmPos r ++ _rmPos r'
, _rmFloor = combineFloors (_rmFloor r) (_rmFloor r')
{ _rmPolys = _rmPolys r ++ _rmPolys r'
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = map clampPath $ _rmPath r ++ _rmPath r'
, _rmPmnts = _rmPmnts r ++ _rmPmnts r'
, _rmBound = _rmBound r ++ _rmBound r'
, _rmPos = _rmPos r ++ _rmPos r'
, _rmFloor = combineFloors (_rmFloor r) (_rmFloor r')
, _rmShift = (V2 0 0 , 0)
}
-- not that this assumes that any link paths are integral
@@ -135,7 +129,7 @@ clampPath = bimap f f
g = (fromIntegral :: Int -> Float) . floor
combineFloors :: Floor -> Floor -> Floor
combineFloors f _ = f
combineFloors = const
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement. -}
quarterRoomTri :: RandomGen g => Float -> State g Room
@@ -210,8 +204,8 @@ quarterRoomSquare w = do
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
randomFourCornerRoom its = do
nCrits <- state $ randomR (1,3)
crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
nCrits <- state $ randomR (1,3)
crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
++ replicate 20 chaseCrit
randomFourCornerRoomCrsIts crits its
{- | A randomly generate room based on four randomly generated corners.
@@ -231,28 +225,27 @@ centerVaultRoom
-> Float -- ^ Height
-> Float -- ^ Vault dimensions
-> State g Room
centerVaultRoom w h d = do
return $ defaultRoom
{ _rmPolys = [rectNSWE h (-h) (-w) w]
, _rmLinks =
[outLink (V2 0 h) 0
,outLink (V2 w 0) (-pi/2)
,outLink (V2 (-w) 0) (pi/2)
, inLink (V2 0 (-h)) pi ]
, _rmPath = []
, _rmPmnts =
[sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
]
++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
[0,pi/2,pi,3*pi/2]
, _rmBound = [rectNSWE h (-h) (-w) w]
, _rmName = "cenVault"
}
centerVaultRoom w h d = return $ defaultRoom
{ _rmPolys = [rectNSWE h (-h) (-w) w]
, _rmLinks =
[outLink (V2 0 h) 0
,outLink (V2 w 0) (-pi/2)
,outLink (V2 (-w) 0) (pi/2)
, inLink (V2 0 (-h)) pi ]
, _rmPath = []
, _rmPmnts =
[sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
]
++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
[0,pi/2,pi,3*pi/2]
, _rmBound = [rectNSWE h (-h) (-w) w]
, _rmName = "cenVault"
}
where
col = dim $ dim $ bright red
theDoor =
+6
View File
@@ -7,6 +7,7 @@ module Dodge.Room.Room
, doubleCorridorBarrels
, pistolerRoom
, spawnerRoom
, corDoor
) where
import Dodge.Cleat
import Dodge.Data
@@ -332,3 +333,8 @@ spawnerRoom = do
(PutCrit spawnerCrit)
aRoom <- airlock
return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner
corDoor :: State StdGen (MetaTree Room String)
corDoor = do
cor <- shuffleLinks $ cleatOnward corridor
return $ tToBTree "corDoor" $ treePost [door,cor]