Rename ItemAttachments
This commit is contained in:
@@ -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
@@ -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
|
||||
|
||||
@@ -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,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user