diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 5455951b3..8427df9f2 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -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) } diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 5d9bbb60a..99596ccac 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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 diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index e43ed0188..96fbdb205 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 137c4e7b1..16e3cad6c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 773138aa3..7d0eda8f4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 6a2d91013..40180b361 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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 diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index e147f410e..4de4eb1ad 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 81651f831..0dfa77519 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -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 diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index c74bfd545..02a1de0e3 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/src/Dodge/LevelGen/AutoDoor.hs @@ -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 diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index e48963f04..174e699fc 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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 diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 527838089..e094005a5 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index e2a07d5eb..b30ca64e0 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -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 diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index f274997d2..5d8c9edd9 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -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) + ]