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

Simplify item placement during generation

Browse Source
This commit is contained in:
jgk
2021-04-25 13:21:24 +02:00
parent 30736997c3
commit 17986651c5
13 changed files with 95 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -16,7 +16,7 @@ import Picture
import qualified Data.IntMap.Strict as IM
import Control.Lens
defaultInanimate = defaultCreature & crIsAnimate .~ False
defaultInanimate = defaultCreature & crState . crIsAnimate .~ False
lamp :: Creature
lamp = defaultInanimate
@@ -72,7 +72,7 @@ explosiveBarrel = defaultInanimate
, _crState = defaultState {_goals = [[Wait]]
,_faction = ChaseCritters
,_crSpState = Barrel []
,_crApplyDamage = \_ c -> (id, c)
}
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
,_crApplyDamage = \_ c -> (id, c)
}
src/Dodge/Creature/State.hs
+6 -17
View File
@@ -56,13 +56,6 @@ stateUpdate u w (f,g) cr =
addCorpse = insertNewKey $ uncurry translate (_crOldPos cr)
$ rotate (_crDir cr)
(_crCorpse cr)
-- maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
-- insertIt = case maybeIt of
-- Just it -> createItemAt (offset +.+ _crOldPos cr)
-- (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-- Nothing -> id
-- offset = _crRad cr *.* unitVectorAtAngle rot
-- (rot,_) = randomR (-pi,pi) g
-- | Drop items accoring to the creature state.
dropByState :: Creature -> World -> World
@@ -93,17 +86,12 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = set itAmount 1 it
{_flIt = it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
createItemAt :: Point2 -> FloorItem -> World -> World
createItemAt p it w = over floorItems (IM.insert i (set flItPos p
$ set flItID i it)) w
where i = newKey (_floorItems w)
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
@@ -120,7 +108,7 @@ doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpL
damagedCr
where dams = _crDamage $ _crState cr
startHP = _crHP cr
damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr
damagedCr = snd $ (_crApplyDamage cr) dams cr
afterHP = _crHP damagedCr
hpLost = startHP - afterHP -- note this can be negative
@@ -269,9 +257,10 @@ updateExpBarrel w (f,g) cr
damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where (pierceDam,otherDam) = partition isPierce ds
isPierce (Piercing {}) = True
isPierce _ = False
where
(pierceDam,otherDam) = partition isPierce ds
isPierce (Piercing {}) = True
isPierce _ = False
damToExpBarrel' :: DamageType -> Creature -> Creature
damToExpBarrel' (Piercing amount sp int ep) cr
src/Dodge/Creature/State/Data.hs
+14 -1
View File
@@ -3,10 +3,22 @@
module Dodge.Creature.State.Data
where
import Geometry
import Dodge.Data.DamageType
import Control.Lens
data ItemDropType
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType
, _crIsAnimate :: Bool
}
data CreatureDropType
= DropAll
| DropAmount Int
| DropSpecific [Int]
@@ -89,6 +101,7 @@ data Faction
| NoFaction
deriving (Eq,Show)
makeLenses ''CreatureState
makeLenses ''CrSpState
makeLenses ''Goal
makeLenses ''Carriage
src/Dodge/Data.hs
+3 -33
View File
@@ -4,6 +4,7 @@
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Menu
, module Dodge.Data.DamageType
, module Dodge.Data.SoundOrigin
, module Dodge.Creature.Data
, module Dodge.Creature.State.Data
@@ -16,6 +17,7 @@ import Dodge.Creature.Data
import Dodge.Creature.State.Data
import Dodge.Data.Menu
import Dodge.Data.SoundOrigin
import Dodge.Data.DamageType
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Preload.Data
@@ -162,10 +164,9 @@ data Creature = Creature
, _crInvSel :: Int
, _crState :: CreatureState
, _crCorpse :: Picture
, _crIsAnimate :: Bool
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
}
data WorldState
= DoorNumOpen Int
| CrNumAlive Int
@@ -410,7 +411,6 @@ data Particle'
type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World
-> (World,Maybe Particle')
data Projectile
= Projectile
{ _pjPos :: Point2
@@ -430,24 +430,6 @@ data Projectile
, _pjPayload :: Point2-> World -> World
}
data DamageType
= Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
| Concussive
{ _dmAmount :: Int
, _dmFrom :: Point2
, _dmPush :: Float
, _dmPushExp :: Float
, _dmPushRadius :: Float
}
| TorqueDam {_dmAmount :: Int , _dmTorque :: Float }
| PushDam {_dmAmount :: Int , _dmPushBack :: Point2 }
| PoisonDam {_dmAmount :: Int}
deriving (Eq,Ord,Show)
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data Wall
@@ -500,21 +482,9 @@ data ForceField = FF
}
data FFState = FFDestroyable { _ffsHP :: Int }
data CreatureState = CrSt
{ _goals :: [[Goal]]
, _stance :: Stance
, _faction :: Faction
, _crDamage :: [DamageType]
, _crPastDamage :: Int
, _crSpState :: CrSpState
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crDropsOnDeath :: ItemDropType
}
makeLenses ''World
makeLenses ''Cloud
makeLenses ''Creature
makeLenses ''CreatureState
makeLenses ''LightSource
makeLenses ''TempLightSource
makeLenses ''Stance
src/Dodge/Default.hs
+2 -2
View File
@@ -79,7 +79,7 @@ defaultCreature = Creature
, _crInvSel = 0
, _crState = defaultState
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
, _crIsAnimate = True
, _crApplyDamage = defaultApplyDamage
}
defaultState = CrSt
{ _goals = []
@@ -88,8 +88,8 @@ defaultState = CrSt
, _crDamage = []
, _crPastDamage = 0
, _crSpState = GenCr
, _crApplyDamage = defaultApplyDamage
, _crDropsOnDeath = DropAmount 1
, _crIsAnimate = True
}
defaultEquipment = Equipment
{ _itIdentity = Generic
src/Dodge/Floor.hs
+2
View File
@@ -8,6 +8,8 @@ import Dodge.Room
import Dodge.Room.Procedural
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Branch
import Dodge.Base
import Dodge.Layout
import Dodge.Layout.Tree.Polymorphic
src/Dodge/Layout/Tree/Annotate.hs
+3
View File
@@ -8,6 +8,8 @@ import Dodge.RandomHelp
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Room.Procedural
import Dodge.Room.Branch
import Dodge.Room.Door
import Dodge.Room.Boss
import Dodge.Room.Link
import Dodge.Room.Data
@@ -32,6 +34,7 @@ data Annotation g
| OrAno [[Annotation g]]
| SpecificRoom (State g (Tree (Either Room Room)))
| BossAno Creature
| TreasureAno [Creature] Item
addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
addLock i t = do
src/Dodge/LevelGen.hs
+11 -4
View File
@@ -51,8 +51,8 @@ placeSpot :: PlacementSpot -> World -> World
placeSpot ps w = case ps of
PS {_psPos = p, _psRot = rot, _psType = PutButton bt}
-> placeBt bt p rot w
PS {_psPos = p, _psRot = rot, _psType = PutFlIt fi}
-> placeFlIt fi p rot w
PS {_psPos = p, _psRot = rot, _psType = PutFlIt itm}
-> placeFlIt itm p rot w
PS {_psPos = p, _psRot = rot, _psType = PutCrit cr}
-> placeCr cr p rot w
PS {_psPos = p, _psRot = rot, _psType = PutLS ls dec}
@@ -134,8 +134,15 @@ addPane c (p0,p1) wls = IM.insert (newKey wls) (Wall { _wlLine = [p0,p1]
placeBt bt p rot w = over buttons addBT w
where addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
placeFlIt fi p rot w = over floorItems addFI w
where addFI fis = IM.insert (newKey fis) (fi {_flItPos = p, _flItRot = rot, _flItID = newKey fis}) fis
placeFlIt itm p rot w = over floorItems addFI w
where addFI fis = IM.insert (newKey fis)
(FlIt
{_flItPos = p
, _flItRot = rot
, _flItID = newKey fis
, _flIt = itm
}
) fis
placePressPlate pp p rot w = over pressPlates addPP w
where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
src/Dodge/LevelGen/AutoDoor.hs
+1 -1
View File
@@ -71,7 +71,7 @@ autoDoorPane (trigx,trigy) n closedPos openPos = Door
where
a = closedPos !! 0
b = closedPos !! 1
dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate) $ _creatures w
dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate . _crState) $ _creatures w
-- crsNearLine 40 trigL w
= flip (foldr changeZonedWall) zoneps
$ over walls (IM.adjust openDoor n) w
src/Dodge/LevelGen/Data.hs
+3 -3
View File
@@ -12,7 +12,7 @@ import System.Random
data PSType = PutCrit Creature
| PutLS LightSource Picture
| PutButton Button
| PutFlIt FloorItem
| PutFlIt Item
| PutPressPlate PressPlate
| PutAutoDoor Point2 Point2
| PutBlock [Int] Color [Point2]
@@ -22,14 +22,14 @@ data PSType = PutCrit Creature
| PutSwitchDoor Color Point2 Float Point2 Point2
| RandPS (State StdGen PSType)
| PutNothing
| PutID Int
| CollectivePS
{ _collectiveID :: Int
, _collectiveNum :: Int
, _collectiveFunction :: [Int] -> State StdGen [PSType]
}
| LabelPS { _psLabel :: Int, _ps :: PSType}
| PutWindow { _pwPoly :: [Point2] , _pwColor :: Color
}
| PutWindow { _pwPoly :: [Point2] , _pwColor :: Color }
data PlacementSpot = PS
{ _psPos :: Point2
, _psRot :: Float
src/Dodge/Room.hs
+11 -31
View File
@@ -25,6 +25,8 @@ import Dodge.Room.Placement
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
import Dodge.Room.Branch
import Dodge.Room.Door
import Geometry
import Picture
@@ -112,18 +114,6 @@ roomPadCut ps p = Room
, _rmPS = []
, _rmBound = []
}
door :: Room
door = Room
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = lnks
, _rmPath = [((20,35),(20,5))]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
, _rmBound = []
}
where lnks = [((20,35),0)
,((20, 5),pi)
]
roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
where
@@ -313,16 +303,16 @@ randomCorridorFrom xs = do
randFirstWeapon :: State StdGen PSType
randFirstWeapon = do
r <- state $ randomR (-pi,pi)
-- r <- state $ randomR (-pi,pi)
takeOne $ map PutFlIt
[ defaultFlIt {_flItRot=r,_flIt = pistol}
, defaultFlIt {_flItRot=r,_flIt = ltAutoGun}
-- , defaultFlIt {_flItRot=r,_flIt = autoGun}
, defaultFlIt {_flItRot=r,_flIt = spreadGun}
, defaultFlIt {_flItRot=r,_flIt = multGun}
, defaultFlIt {_flItRot=r,_flIt = launcher}
-- , defaultFlIt {_flItRot=r,_flIt = lasGun}
-- , defaultFlIt {_flItRot=r,_flIt = flamer}
[ pistol
, ltAutoGun
-- , autoGun
, spreadGun
, multGun
, launcher
-- , lasGun
-- , flamer
]
--randC1 :: State StdGen PSType
@@ -457,16 +447,6 @@ roomCCrits = do
lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp]
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) -> State g (Tree (Either Room Room))
branchRectWith t = do
x <- state $ randomR (100,200)
y <- state $ randomR (100,200)
b <- t
root <- randomiseOutLinks $ roomRectAutoLinks x y
return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeTrunk [Left door] b]
where rToL :: Either a a -> Either a a
rToL (Right r) = Left r
rToL (Left r) = Left r
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
slowDoorRoom = do
src/Dodge/Room/Procedural.hs
+1 -1
View File
@@ -212,7 +212,7 @@ shufflePlacements r = do
return $ r & rmPS .~ newPSs
putDefaultFlIt :: Item -> PSType
putDefaultFlIt itm = PutFlIt $ defaultFlIt { _flItRot = 0, _flIt = itm }
putDefaultFlIt itm = PutFlIt itm
testRoom :: RandomGen g => State g Room
testRoom = do
src/Dodge/Room/Treasure.hs
+36
View File
@@ -1,6 +1,42 @@
{-
Rooms that contain valuable items, typically protected in some manner.
Typically dead ends.
-}
module Dodge.Room.Treasure
where
import Geometry
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Control.Monad.State
import System.Random
{-
A triangular room with loot at the top (with 'PutID' 2),
creatures in the bottom two corners (with 'PutID' 0),
and (single) entrance bottom middle.
-}
triLootRoom
:: Float -- Width
-> Float -- Height
-> State g Room
triLootRoom w h = pure $ Room
{ _rmPolys = [poly]
, _rmLinks = [((0,10),pi)]
, _rmPath = doublePair ((0,10),(0,h/2))
, _rmPS =
[PS (15-w,15) 0 $ PutID 0
,PS (w-15,15) 0 $ PutID 0
,PS (0,h-15) 0 $ PutID 2
]
, _rmBound = poly
}
where
poly =
[ ( -w,30)
, ( -w, 0)
, ( w, 0)
, ( w,30)
, ( 20, h)
, (-20, h)
]