diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index e6f828fd4..b134a8f90 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -280,6 +280,16 @@ collideCircWalls p1 p2 rad ws -- . _wlLine') ws -- where -- f (a,_) = magV (p1 -.- a) +-- +-- | Looks for first collision of a point with walls. +-- If found, gives point and wall. +collidePointWallsWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Wall) +collidePointWallsWall p1 p2 ws + = safeMinimumOn f + $ IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) ) + ws + where + f (a,_) = magV (p1 -.- a) -- | Looks for first collision of a point with walls. -- If found, gives point and normal of wall. diff --git a/src/Dodge/Clock.hs b/src/Dodge/Clock.hs index 6842f305a..b98e68e56 100644 --- a/src/Dodge/Clock.hs +++ b/src/Dodge/Clock.hs @@ -1,7 +1,6 @@ module Dodge.Clock ( clockCycle - ) - where + ) where import Dodge.Data import qualified Data.Vector as V diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 1a6b95965..6f17a7c77 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -31,15 +31,15 @@ combinationsTrie = foldr (uncurry insertInTrie . first (sortOn snd)) -- trie going through each combine type in your inventory in order, rather than -- creating all multisets of combine types. -lookupItems' :: [(CombineType,Int,Int)] -> [ ([Int],Item) ] -lookupItems' xs = lookupItems (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie +lookupItems :: [(CombineType,Int,Int)] -> [ ([Int],Item) ] +lookupItems xs = lookupItemsUsingTrie (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie -lookupItems :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ] -lookupItems [] t = maybeToList $ ([],) <$> _trieMVal t -lookupItems ((ct,i,n):xs) t = do +lookupItemsUsingTrie :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ] +lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t +lookupItemsUsingTrie ((ct,i,n):xs) t = do n' <- [1..min n 4] let is = replicate n' i - concatMap (map (first (is ++)) . lookupItems xs) $ maybeToList (_trieChildren t M.!? (n',ct)) + concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct)) invertListInvMult :: IM.IntMap Item -> [[(CombineType,Int,Int)]] invertListInvMult = powlistUpToN 4 . invertListInv @@ -50,7 +50,7 @@ invertListInv = IM.foldrWithKey [] combineItemListYou :: World -> [([Int],Item)] -combineItemListYou = concatMap lookupItems' . invertListInvMult . yourInv +combineItemListYou = concatMap lookupItems . invertListInvMult . yourInv toggleCombineInv :: World -> World toggleCombineInv w = case _inventoryMode w of diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 0f9c5ddf8..c16262d4d 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -2,6 +2,7 @@ module Dodge.Combine.Combinations where import Dodge.Data import Dodge.Item.Equipment +import Dodge.Item.Craftable import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Launcher import Dodge.Item.Weapon.SprayGuns @@ -44,6 +45,10 @@ itemCombinations = , po [FLAMESTICK,DRUM,DRUM] flameWall , po [MAGNET,TIN] magShield + + , p [p 4 CAN] plateCraft + + , p [p 2 PLATE] flatShield ] ++ map (\i -> po [PIPE,BANGSTICK i] $ bangStick (i+1)) [1..8] ++ map (\i -> po [REVOLVERX i,CAN] $ revolverX (i+1)) [1..5] diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 8e86dc2d9..0092d76ce 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -40,6 +40,7 @@ data CombineType | LONGGUN | TESLAGUN | LASGUN + | SONICGUN | TRACTORGUN | LAUNCHER | SPRAYER diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 16f2863b1..60b38bffb 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -171,14 +171,15 @@ testInventory = IM.fromList $ zip [0..] , makeTypeCraftNum 1 MAGNET , makeTypeCraftNum 5 HARDWARE , makeTypeCraftNum 3 SPRING - , makeTypeCraftNum 3 CAN + , makeTypeCraftNum 10 CAN , makeTypeCraftNum 3 TIN , makeTypeCraftNum 3 PLANK , makeTypeCraftNum 1 MOTOR ] stackedInventory :: IM.IntMap Item stackedInventory = IM.fromList $ zip [0..] - [spreadGun + [sonicGun + ,spreadGun , pipe ,rewindGun ,tractorGun diff --git a/src/Dodge/Creature/Impulse/Movement.hs b/src/Dodge/Creature/Impulse/Movement.hs index d15960208..8da8d4bf7 100644 --- a/src/Dodge/Creature/Impulse/Movement.hs +++ b/src/Dodge/Creature/Impulse/Movement.hs @@ -34,18 +34,15 @@ crMvAbsolute p' cr = advanceStepCounter (magV p) cr & crPos %~ (+.+ p) & crMvDir .~ argV p where - p = (*.*) (equipFactor * aimingFactor) p' - equipFactor - | _posture (_crStance cr) == Aiming - = product $ map equipAimSpeed $ IM.elems $ _crInv cr - | _posture (_crStance cr) == Reloading - = product $ map equipAimSpeed $ IM.elems $ _crInv cr - | otherwise = product $ map equipSpeed $ IM.elems $ _crInv cr + p = (equipFactor * aimingFactor) *.* p' + isAiming = _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading + invItSpeed + | isAiming = equipAimSpeed + | otherwise = equipSpeed + equipFactor = product $ invItSpeed <$> _crInv cr aimingFactor - | _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading - = fromMaybe 1 $ it ^? itUse . useAim . aimSpeed + | isAiming = fromMaybe 1 $ cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimSpeed | otherwise = 1 - it = _crInv cr IM.! _crInvSel cr crMvForward :: Float -- ^ Speed diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index b1021b889..7592b8453 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -11,10 +11,10 @@ import Control.Lens import Data.Maybe useItem :: Int -> World -> World -useItem cid w = itemEffect cr it w +useItem cid w = tryUseItem cr w -- itemEffect cr it w where cr = _creatures w IM.! cid - it = _crInv cr IM.! _crInvSel cr + --it = _crInv cr IM.! _crInvSel cr tryUseItem :: Creature -> World -> World tryUseItem cr' w = fromMaybe w $ do diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 8a6aa308f..e57f6552d 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -101,13 +101,13 @@ movementSideEff cr w | hasJetPack = case cr ^? crStance . carriage of Just (Boosting v) -> w & randGen .~ g - & makeFlameletTimed - (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi)) - 20 - (momentum +.+ 1 *.* rotateV randDir (vInverse v)) - Nothing - 1 - 20 + & makeFlamelet + (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi)) + 20 + (momentum +.+ 1 *.* rotateV randDir (vInverse v)) + Nothing + 1 + 20 _ -> w | otherwise = footstepSideEffect cr w where @@ -122,9 +122,9 @@ movementSideEff cr w heldItemUpdate :: Item -> Item heldItemUpdate = invItemUpdate - . (itUse %~ useupdate) - where - useupdate = id +-- . (itUse %~ useupdate) +-- where +-- useupdate = id invItemUpdate :: Item -> Item invItemUpdate = itUse %~ useupdate diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0782c5e74..2d9f9f27c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -77,6 +77,8 @@ data World = World , _itemPositions :: IM.IntMap ItemPos , _clouds :: [Cloud] , _cloudsZone :: Zone [Cloud] + , _gusts :: IM.IntMap Gust + , _gustsZone :: Zone (IM.IntMap Gust) , _props :: IM.IntMap Prop , _instantParticles :: [Particle] , _particles :: [Particle] @@ -191,6 +193,12 @@ data Corpse = Corpse , _cpPict :: Picture , _cpRes :: Creature } +data Gust = Gust + { _guID :: Int + , _guPos :: Point2 + , _guVel :: Point2 + , _guTime :: Int + } data Cloud = Cloud { _clPos :: Point3 , _clVel :: Point3 @@ -361,44 +369,6 @@ data Item , _itParams :: ItemParams , _itTweaks :: ItemTweaks } --- | Equipment --- { _itName :: String --- , _itFloorPict :: Item -> SPic --- , _itEquipPict :: Creature -> Int -> SPic ----- , _itIdentity :: ItemIdentity --- , _itEffect :: ItEffect --- , _itID :: Maybe Int --- , _itType :: CombineType --- , _itZoom :: ItZoom --- , _itInvSize :: Float --- , _itInvDisplay :: Item -> [String] --- , _itInvColor :: Color --- , _itCurseStatus :: CurseStatus --- , _itDimension :: ItemDimension --- } --- | Throwable --- { _itName :: String --- , _itMaxStack :: Int ----- , _itAmount :: Int --- , _itFloorPict :: Item -> SPic --- , _twMaxRange :: Float --- , _twAccuracy :: Float --- , _itUse :: ItemUse ----- , _itZoom :: ItZoom --- , _itEquipPict :: Creature -> Int -> SPic --- --, _itIdentity :: ItemIdentity --- , _itID :: Maybe Int --- , _itAttachment :: ItAttachment --- , _itType :: CombineType --- , _itInvSize :: Float --- , _itInvDisplay :: Item -> [String] --- , _itInvColor :: Color --- , _itEffect :: ItEffect --- , _itScroll :: Float -> Creature -> Item -> Item --- , _itCurseStatus :: CurseStatus --- , _itDimension :: ItemDimension --- } --- | NoItem data ItemDimension = ItemDimension { _dimRad :: Float @@ -467,33 +437,41 @@ data Particle , _btDrag :: Float , _ptColor :: Color , _ptTrail :: [Point2] - , _btPassThrough' :: Maybe Int - , _btWidth' :: Float - , _btTimer' :: Int - , _btHitEffect' :: HitEffect + , _ptCrIgnore :: Maybe Int + , _ptWidth :: Float + , _ptTimer :: Int + , _ptHitEff :: HitEffect } | PtZ { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptVel :: Point2 , _ptColor :: Color - , _btPos' :: Point2 - , _btPassThrough' :: Maybe Int - , _btWidth' :: Float - , _btTimer' :: Int - , _btHitEffect' :: HitEffect + , _ptPos :: Point2 + , _ptCrIgnore :: Maybe Int + , _ptWidth :: Float + , _ptTimer :: Int + , _ptHitEff :: HitEffect , _ptZ :: Float } | Shockwave { _ptDraw :: Particle -> Picture - , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptColor :: Color - , _btPos' :: Point2 - , _btRad' :: Float - , _btDam' :: Int - , _btPush' :: Float - , _btMaxTime' :: Int - , _btTimer' :: Int + , _ptPos :: Point2 + , _ptRad :: Float + , _ptDam :: Int + , _ptPush :: Float + , _ptMaxTime :: Int + , _ptTimer :: Int + } + | ShockLine + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptPointDirs :: [[(Point2,Float)]] + , _ptTimer :: Int + , _ptColor :: Color + , _ptCenter :: Point2 } type HitEffect = Particle -> [(Point2, Either Creature Wall)] @@ -645,7 +623,7 @@ data Prop , _pjPayload :: Point2 -> World -> World , _pjTimer :: Int } - | LinearShockwave + | LinearShockwave { _prDraw :: Prop -> SPic , _pjPos :: Point2 , _pjID :: Int @@ -930,3 +908,4 @@ makeLenses ''Maybe' makeLenses ''InventoryMode makeLenses ''ItemPortage makeLenses ''Magnet +makeLenses ''Gust diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index c5df92a74..35ae0572d 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -31,6 +31,8 @@ defaultWorld = World , _creatureGroups = IM.empty , _clouds = [] , _cloudsZone = Zone IM.empty + , _gusts = IM.empty + , _gustsZone = Zone IM.empty , _itemPositions = IM.empty , _props = IM.empty , _instantParticles = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 2b0684092..19ed326ea 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -104,13 +104,15 @@ handlePressedMouseButton but w _ -> Just w | otherwise = Just w +-- note "reverse" on the inventory indices; otherwise +-- lower items may be shifted up and items below these removed instead doCombine :: Int -> World -> World doCombine i w = case combineItemListYou w !? i of Nothing -> w Just (is,it) -> enterCombineInv . uncurry (putItemInInvID yid) . copyItemToFloorID (_crPos $ you w) it - $ foldr (rmInvItem yid) w is & enterCombineInv + $ foldr (rmInvItem yid) w (reverse is) & enterCombineInv where yid = _yourID w diff --git a/src/Dodge/Item/Craftable.hs b/src/Dodge/Item/Craftable.hs index c42839c6d..c315ea2b1 100644 --- a/src/Dodge/Item/Craftable.hs +++ b/src/Dodge/Item/Craftable.hs @@ -18,3 +18,6 @@ makeTypeCraft :: CombineType -> Item makeTypeCraft = makeTypeCraftNum 1 pipe :: Item pipe = makeTypeCraft PIPE + +plateCraft :: Item +plateCraft = makeTypeCraft PLATE diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 663360b5a..bb8c9d947 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -20,15 +20,6 @@ pictureWeaponOnAim cr i = pictureWeaponOnAimItem (itSPic it) cr i itSPic :: Item -> SPic itSPic it = _dimSPic (_itDimension it) it -pictureWeaponOnAim' - :: (Item -> SPic) - -> Creature - -> Int -- ^ Position of item in inventory - -> SPic -pictureWeaponOnAim' f cr i = pictureWeaponOnAimItem pic cr i - where - pic = f (_crInv cr IM.! i) - pictureWeaponAim :: (Item -> SPic) -> Creature diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 709958ca2..f9b63906f 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -1,6 +1,7 @@ module Dodge.Item.Equipment where import Dodge.Data import Dodge.Item.Draw +import Dodge.Item.Weapon.InventoryDisplay import Dodge.Default import Dodge.Default.Wall import Dodge.Picture.Layer @@ -14,8 +15,7 @@ import Geometry import ShapePicture import Shape import qualified IntMapHelp as IM - -import Control.Lens +import LensHelp magShield :: Item magShield = defaultEquipment @@ -66,10 +66,29 @@ frontArmour = defaultEquipment } flatShield :: Item flatShield = defaultEquipment - { _itEquipPict = pictureWeaponOnAim' flatShieldEquipSPic -- this will not work any more because the shield has no aim stance + { _itEquipPict = pictureWeaponAim flatShieldEquipSPic , _itEffect = effectOnOffEquip createShieldWall removeShieldWall - , _itName = "SHIELD" + -- the above seems to work, but I am not sure why: it may break on edge + -- cases + , _itName = "FLATSHIELD" , _itType = FLATSHIELD + , _itUse = RightUse + { _rUse = \_ _ -> id + , _useDelay = NoDelay + , _useMods = [] + , _useHammer = NoHammer + , _useAim = AimParams + { _aimSpeed = 0.5 + , _aimRange = 0 + , _aimZoom = ItZoom 20 0.2 1 + , _aimStance = TwoHandFlat + } + } + , _itInvSize = 3 + , _itInvDisplay = \it -> head (basicItemDisplay it) : + ["*" ++ replicate 13 ' ' ++ "*" + ,"*" ++ replicate 13 ' ' ++ "*" + ] } flatShieldEquipSPic :: Item -> SPic flatShieldEquipSPic _ = @@ -102,8 +121,8 @@ shieldWall crid = defaultWall shieldWallDamage :: DamageType -> Wall -> Int -> World -> World shieldWallDamage dt wl crid w = case dt of Lasering {_dmFrom=df,_dmAt=da} -> - w & instantParticles %~ (makeLaserAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl) :) - d | isMovementDam d -> w & creatures . ix crid . crState . crDamage %~ (d :) + w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl) + d | isMovementDam d -> w & creatures . ix crid . crState . crDamage .:~ d _ -> w createShieldWall :: Creature -> Int -> World -> World diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 3111c7d97..ab9f0d6d4 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1,6 +1,7 @@ {- | Rexport all weapons -} module Dodge.Item.Weapon ( module Dodge.Item.Weapon.BulletGuns + , module Dodge.Item.Weapon.SonicGuns , module Dodge.Item.Weapon.TriggerType , module Dodge.Item.Weapon.ExtraEffect , module Dodge.Item.Weapon.UseEffect @@ -16,6 +17,7 @@ module Dodge.Item.Weapon ) where import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.TriggerType +import Dodge.Item.Weapon.SonicGuns import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect import Dodge.Item.Weapon.Remote diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 2eac243ec..9754f0068 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -2,7 +2,7 @@ module Dodge.Item.Weapon.BatteryGuns ( lasGun , teslaGun , tractorGun - , makeLaserAt + , lasRayAt ) where import Dodge.Data import Dodge.Creature.HandPos @@ -67,7 +67,7 @@ teslaGunPic _ = noPic $ colorSH blue $ xb = 9 lasGun :: Item lasGun = defaultAutoGun - { _itName = "LASGUN ////" + { _itName = "LASGUN" , _itType = LASGUN , _itConsumption = defaultAmmo { _ammoMax = 200 @@ -156,15 +156,14 @@ aTeslaArc cr w = set randGen g w chooseColor _ = cyan aLaser :: Item -> Creature -> World -> World -aLaser it cr = particles .:~ makeLaserAt phasev pos dir +aLaser it cr = particles .:~ lasRayAt phasev pos dir where pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir dir = _crDir cr - phasev = _phaseV . _itParams $ _crInv cr IM.! j - j = _crInvSel cr + phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr -makeLaserAt :: Float -> Point2 -> Float -> Particle -makeLaserAt phasev pos dir = Particle +lasRayAt :: Float -> Point2 -> Float -> Particle +lasRayAt phasev pos dir = Particle { _ptDraw = const blank , _ptUpdate = mvLaser phasev pos dir } diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index e1d20fdcd..111963067 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -44,7 +44,9 @@ bangCane = defaultGun { _muzVel = 0.8 , _rifling = 0.9 , _bore = 2 - , _gunBarrels = SingleBarrel 0.1 + , _gunBarrels = SingleBarrel + { _brlInaccuracy = 0.01 + } } , _itConsumption = defaultAmmo { _aoType = basicBullet diff --git a/src/Dodge/Item/Weapon/BulletGun/Stick.hs b/src/Dodge/Item/Weapon/BulletGun/Stick.hs index 25a0c98e8..ff8565874 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Stick.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Stick.hs @@ -60,7 +60,7 @@ bangStick i = defaultGun , withMuzFlareI , torqueAfterI (0.18 + 0.02 * fromIntegral i) , spreadLoaded - , applyInaccuracy +-- , applyInaccuracy , withRecoilI 25 ] , _itID = Nothing @@ -73,7 +73,7 @@ bangStick i = defaultGun , _gunBarrels = MultiBarrel {_brlNum = i ,_brlSpread = SpreadBarrels baseStickSpread - ,_brlInaccuracy = 0.05 + ,_brlInaccuracy = 0.01 } } , _itTweaks = defaultBulletSelTweak diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 55b3a18e9..f6f67569a 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -127,7 +127,7 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itUse . useHammer . hammerPosition .~ HammerUp - & itEquipPict .~ pictureWeaponOnAim' (\_ -> grenadePic 50) + & itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50) | otherwise = it & itEffect . itEffectCounter -~ 1 --flameGrenade :: Item @@ -277,7 +277,7 @@ explodeRemoteBomb itid pjid cr w cid = _crID cr resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) - (pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic) + (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic) -- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! cid remoteBombPic diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 136e15f41..3b17dbe35 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -26,7 +26,7 @@ basicItemDisplay it = Prelude.take (itSlotsTaken it) $ Just' x -> show x ++ "R" ++ show (_ammoLoaded am) Just am@ChargeableAmmo{} -> show $ _wpCharge am Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x) - Just NoConsumption -> "NOCONSUMPTION" + Just NoConsumption -> "" Nothing -> "" theparam = fromMaybe [] . listToMaybe diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 08b286121..0497ba1a1 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -138,7 +138,7 @@ doThrust pj w = w & randGen .~ g & props . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) - & makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 & smokeGen where accel = _pjAcc pj @@ -344,7 +344,7 @@ moveRemoteShell cid itid pj w ) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) & smokeGen - & makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 | time > -200 = case thingHit of Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> w diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index 87469d31f..6fd17cd8e 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -32,7 +32,7 @@ radar = defaultGun & useAim . aimRange .~ 1 & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1} -- , _itZoom = defaultItZoom { _itZoomMax = 1} - , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Sends out pulses that display creatures. -} @@ -50,7 +50,7 @@ sonar = defaultGun ] & useAim . aimRange .~ 1 & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1} - , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Automatically sends out pulses that display creatures. -} diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index d64c25f00..b1450cdf3 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -431,13 +431,14 @@ torqueAfterI :: Float -- ^ Max possible rotation -> ChainEffect torqueAfterI torque feff item cr w - | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w +-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w + | cid == 0 = set randGen g $ over cameraRot (+rot) $ feff item cr w | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w where cid = _crID cr (rot, g) = randomR (-torque,torque) $ _randGen w - rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopePos %~ rotateV rot +-- rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) +-- . itAttachment . scopePos %~ rotateV rot spreadNumI :: ChainEffect spreadNumI eff item cr w = foldr f w dirs diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Particle/Bullet/Draw.hs index 9e32e6616..1ff84d636 100644 --- a/src/Dodge/Particle/Bullet/Draw.hs +++ b/src/Dodge/Particle/Bullet/Draw.hs @@ -8,4 +8,4 @@ drawBul :: Particle -> Picture drawBul pt = setLayer 1 . setDepth 20 . color (_ptColor pt) - $ thickLine (take 3 $ _ptTrail pt) (_btWidth' pt) + $ thickLine (take 3 $ _ptTrail pt) (_ptWidth pt) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 03cd8b538..5aaa42bcb 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -52,8 +52,8 @@ bulBounceArmCr' bt p cr w reflectVel = magV bulVel *.* newDir addBouncer = instantParticles .:~ bouncer bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) - (_btHitEffect' bt) (_btWidth' bt) - ) {_btTimer' = _btTimer' bt - 1} + (_ptHitEff bt) (_ptWidth bt) + ) {_ptTimer = _ptTimer bt - 1} {- | Bullet pass through creatures. -} bulPenCr' :: Particle -> Point2 -> Creature -> World -> World bulPenCr' bt p cr w = w @@ -71,8 +71,8 @@ bulPenCr' bt p cr w = w sp = head $ _ptTrail bt ep = sp +.+ _ptVel bt piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt) - (_btHitEffect' bt) (_btWidth' bt) - ) {_btTimer' = _btTimer' bt - 1} + (_ptHitEff bt) (_ptWidth bt) + ) {_ptTimer = _ptTimer bt - 1} {- | Heavy bullet effects when hitting creature: piercing, blunt, twisting and pushback damage all applied. -} hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World @@ -92,7 +92,7 @@ hvBulHitCr bt p cr w = w {- | Create a flamelet when hitting a creature. -} bulIncCr :: Particle -> Point2 -> Creature -> World -> World bulIncCr bt p cr w = w - & makeFlameletTimed p 20 v Nothing 3 20 + & makeFlamelet p 20 v Nothing 3 20 & bulletHitSound p & creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep where @@ -123,8 +123,8 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl ep = sp +.+ _ptVel bt sp = head $ _ptTrail bt pOut = p +.+ squashNormalizeV (sp -.- p) - bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_btHitEffect' bt) (_btWidth' bt) - ) {_btTimer' = _btTimer' bt - 1} + bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) + ) {_ptTimer = _ptTimer bt - 1} reflectVel = reflVelWall wl (_ptVel bt) -- the hack is to get around the fact that the particles list gets reset after -- all projectiles in it are checked, so we cannot add to it as we accumulate over @@ -138,7 +138,7 @@ bulIncWall -> World -> World bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl - . makeFlameletTimed pOut 20 reflectVel Nothing 3 20 + . makeFlamelet pOut 20 reflectVel Nothing 3 20 where ep = sp +.+ _ptVel bt sp = head $ _ptTrail bt diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index e33d6eee5..ab46af558 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -27,10 +27,10 @@ aGenBulAt maycid pos vel drag hiteff width = BulletPt , _btDrag = drag , _ptColor = V4 2 2 2 2 , _ptTrail = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 100 - , _btHitEffect' = hiteff + , _ptCrIgnore = maycid + , _ptWidth = width + , _ptTimer = 100 + , _ptHitEff = hiteff } aDelayedBulAt :: Float -- ^ Start velocity step factor @@ -48,10 +48,10 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt , _btDrag = drag , _ptColor = V4 2 2 2 2 , _ptTrail = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 100 - , _btHitEffect' = hiteff + , _ptCrIgnore = maycid + , _ptWidth = width + , _ptTimer = 100 + , _ptHitEff = hiteff } where resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (ptVel .~ vel) @@ -72,11 +72,11 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt , _btDrag = 1 , _ptColor = col , _ptTrail = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 100 - , _btHitEffect' = hiteff + , _ptCrIgnore = maycid + , _ptWidth = width + , _ptTimer = 100 + , _ptHitEff = hiteff } where - setVel pt = pt & ptVel .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt) + setVel pt = pt & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt) bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05 diff --git a/src/Dodge/Particle/Bullet/Update.hs b/src/Dodge/Particle/Bullet/Update.hs index 9f13abd25..5aa476c9e 100644 --- a/src/Dodge/Particle/Bullet/Update.hs +++ b/src/Dodge/Particle/Bullet/Update.hs @@ -8,10 +8,9 @@ import Dodge.Data import Dodge.WorldEvent.ThingsHit --import Picture import Geometry ---import Geometry.Vector3D +import LensHelp import Data.Bifunctor -import Control.Lens {- Update for a generic bullet. -} mvBullet :: World -> Particle -> (World, Maybe Particle) mvBullet w bt' @@ -20,10 +19,10 @@ mvBullet w bt' hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w where bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w - dodrag = ptVel %~ (drag *.*) + dodrag = ptVel .*.*~ drag drag = _btDrag bt - mcr = _btPassThrough' bt + mcr = _ptCrIgnore bt (p:_) = _ptTrail bt vel = _ptVel bt - hiteff = _btHitEffect' bt - t = _btTimer' bt + hiteff = _ptHitEff bt + t = _ptTimer bt diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index c87cf2c2a..74788edd4 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -23,10 +23,10 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt , _btDrag = 0.9 , _ptColor = numColor colid , _ptTrail = [pos] - , _btPassThrough' = maycid - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff + , _ptCrIgnore = maycid + , _ptWidth = 1 + , _ptTimer = time + , _ptHitEff = destroyOnImpact sparkEff noEff } where sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep @@ -49,10 +49,10 @@ colSparkRandDir randDir time col pos baseDir w = w , _ptVel = rotateV dir (V2 5 0) , _ptColor = col , _ptTrail = [pos] - , _btPassThrough' = Nothing - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff + , _ptCrIgnore = Nothing + , _ptWidth = 1 + , _ptTimer = time + , _ptHitEff = destroyOnImpact sparkEff noEff } sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep where diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d2173659c..4dc62c446 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -17,14 +17,14 @@ import Dodge.Update.Camera import Dodge.Inventory import Sound.Data import Geometry +import LensHelp import Data.List import Data.Maybe -import Data.Function +--import Data.Function import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M --import qualified Data.Set as S -import Control.Lens --import Data.Monoid --import System.Random @@ -62,6 +62,7 @@ functionalUpdate cfig w = checkEndGame . updateIMl _props _pjUpdate . updateLightSources . updateClouds + . updateGusts . zoneClouds . updateMIM magnets _mgUpdate . updateIMl _machines _mcUpdate @@ -176,6 +177,16 @@ checkEndGame w | _crHP (you w) < 1 = w & sideEffects %~ ( . (menuLayers .~ [gameOverMenu])) | otherwise = w +updateGusts :: World -> World +updateGusts w = w + & gusts %~ IM.mapMaybe (mvGust w) + +mvGust :: World -> Gust -> Maybe Gust +mvGust _ gu + | _guTime gu < 0 = Nothing + | otherwise = Just $ gu + & guPos .+.+~ _guVel gu + & guTime -~ 1 updateClouds :: World -> World updateClouds w = w' & clouds .~ catMaybes mclouds where diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 50ce056d3..f8814028c 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -89,7 +89,7 @@ makeExplosionAt p w fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' sizes = randomRs (2,9) $ _randGen w times = randomRs (20,25) $ _randGen w - mF q z v size time = makeFlameletTimed q z v Nothing size time + mF q z v size time = makeFlamelet q z v Nothing size time newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times addFlames w' = foldr ($) w' newFs pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 08620e724..e1687681b 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -48,13 +48,11 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare (a:b:c:d:_) = randomRs (2,20) (_randGen w) flareCircleAt :: Color -> Float -> Point3 -> World -> World -flareCircleAt col alphax tranv = particles .:~ theFlareCircle - where - theFlareCircle = Particle - { _ptDraw = const . setLayer 1 . translate3 tranv - $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30 - , _ptUpdate = ptSimpleTime 1 - } +flareCircleAt col alphax tranv = particles .:~ Particle + { _ptDraw = const . setLayer 1 . translate3 tranv + $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30 + , _ptUpdate = ptSimpleTime 1 + } explosionFlashAt :: Point2 -> World -> World explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc (addZ 20 p) @@ -65,8 +63,8 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc flameFlicker :: Particle -> World -> World flameFlicker pt - | _btTimer' pt `mod` 5 == 0 = tempLightSources .:~ theLight + | _ptTimer pt `mod` 5 == 0 = tempLightSources + .:~ tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10) | otherwise = id where - V2 x y = _btPos' pt - theLight = tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10) + V2 x y = _ptPos pt diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 101e761ea..df721cae7 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -28,8 +28,8 @@ destroyOnImpact crEff wlEff pt hitThings w = case hitThings of mvPt :: Particle -> Maybe Particle mvPt pt = Just $ pt & ptTrail %~ f - & btTimer' -~ 1 - & btPassThrough' .~ Nothing + & ptTimer -~ 1 + & ptCrIgnore .~ Nothing where f trl = head trl +.+ _ptVel pt : trl @@ -37,13 +37,13 @@ destroyAt :: Point2 -> Particle -> Maybe Particle destroyAt hitp pt = Just $ pt & ptUpdate .~ killBulletUpdate & ptTrail .:~ hitp - & btTimer' %~ (min 3 . subtract 1) + & ptTimer %~ (min 3 . subtract 1) killBulletUpdate :: World -> Particle -> (World,Maybe Particle) killBulletUpdate w pt - | _btTimer' pt <= 0 = (w,Nothing) + | _ptTimer pt <= 0 = (w,Nothing) | otherwise = (w - ,Just $ pt & btTimer' -~ 1 + ,Just $ pt & ptTimer -~ 1 & ptTrail %~ (\(x:xs) -> x:x:xs) ) @@ -65,7 +65,7 @@ doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ Flaming amount sp p ep where - sp = _btPos' pt + sp = _ptPos pt ep = sp +.+ _ptVel pt noEff :: a -> b -> c -> d -> d diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 97f859417..00958e319 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -26,39 +26,39 @@ makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave { _ptDraw = drawShockwave , _ptUpdate = mvShockwave is , _ptColor = col - , _btPos' = p - , _btRad' = rad - , _btDam' = dam - , _btPush' = push - , _btMaxTime' = 10 - , _btTimer' = 10 + , _ptPos = p + , _ptRad = rad + , _ptDam = dam + , _ptPush = push + , _ptMaxTime = 10 + , _ptTimer = 10 } {- Shockwave picture. -} drawShockwave :: Particle -> Picture drawShockwave pt = setDepth 20 . setLayer 1 - . uncurryV translate (_btPos' pt) + . uncurryV translate (_ptPos pt) . color (_ptColor pt) $ thickCircle rad thickness where - r = _btRad' pt + r = _ptRad pt thickness = tFraction**2 * r rad = r - (3/4) * r * tFraction - tFraction = fromIntegral (_btTimer' pt) / fromIntegral (_btMaxTime' pt) + tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt) mvShockwave :: [Int] -- ^ IDs of invulnerable creatures. -> World -> Particle -> (World, Maybe Particle) mvShockwave is w pt - | _btTimer' pt <= 0 = ( w , Nothing) - | otherwise = (doDams w , Just $ pt & btTimer' -~ 1) + | _ptTimer pt <= 0 = ( w , Nothing) + | otherwise = (doDams w , Just $ pt & ptTimer -~ 1) where - r = _btRad' pt - p = _btPos' pt - push = _btPush' pt - dam = _btDam' pt - t = _btTimer' pt - tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) + r = _ptRad pt + p = _ptPos pt + push = _ptPush pt + dam = _ptDam pt + t = _ptTimer pt + tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt) rad = r - (3/4) * r * tFraction doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageWall (Explosive 10000 p))) hitBlocks @@ -79,12 +79,12 @@ inverseShockwaveAt p rad dam push = particles .:~ Shockwave { _ptDraw = drawInverseShockwave , _ptUpdate = moveInverseShockwave , _ptColor = cyan - , _btPos' = p - , _btRad' = rad - , _btDam' = dam - , _btPush' = push - , _btMaxTime' = 10 - , _btTimer' = 10 + , _ptPos = p + , _ptRad = rad + , _ptDam = dam + , _ptPush = push + , _ptMaxTime = 10 + , _ptTimer = 10 } moveInverseShockwave :: World @@ -92,11 +92,11 @@ moveInverseShockwave -> (World, Maybe Particle) moveInverseShockwave w pt | t <= 0 = ( w, Nothing) - | otherwise = (dams w, Just $ btTimer' -~ 1 $ pt ) + | otherwise = (dams w, Just $ ptTimer -~ 1 $ pt ) where - p = _btPos' pt - r = _btRad' pt - t = _btTimer' pt + p = _ptPos pt + r = _ptRad pt + t = _ptTimer pt rad = r - 0.1 * r * fromIntegral (10 - t) dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w @@ -110,8 +110,8 @@ drawInverseShockwave pt = setLayer 1 $ onLayer PtLayer $ uncurryV translate p $ color cyan $ thickCircle rad thickness where - p = _btPos' pt - r = _btRad' pt - t = _btTimer' pt + p = _ptPos pt + r = _ptRad pt + t = _ptTimer pt rad = r - 0.1 * r * fromIntegral (10 - t) thickness = fromIntegral (10 - t) **2 * rad / 40 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index c172f4e7a..7c9ce3bc3 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -2,7 +2,7 @@ module Dodge.WorldEvent.SpawnParticle ( makeGasCloud , aFlameParticle - , makeFlameletTimed + , makeFlamelet ) where import Dodge.Data import Dodge.Base @@ -31,11 +31,11 @@ aFlameParticle t pos vel maycid = PtZ , _ptUpdate = moveFlame vel , _ptVel = vel , _ptColor = red - , _btPos' = pos - , _btPassThrough' = maycid - , _btWidth' = 4 - , _btTimer' = t - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff + , _ptPos = pos + , _ptCrIgnore = maycid + , _ptWidth = 4 + , _ptTimer = t + , _ptHitEff = destroyOnImpact (doFlameDam 1) noEff , _ptZ = 20 } drawFlame @@ -49,7 +49,7 @@ drawFlame rotd pt = pictures , aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1 ] where - ep = _btPos' pt + ep = _ptPos pt aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture aPic lay offset depth (V2 scalex scaley) col = setLayer lay @@ -61,7 +61,7 @@ drawFlame rotd pt = pictures $ circleSolid 5 glow = setLayer 1 $ setDepth 0.3 $ uncurryV translate ep $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 - time = _btTimer' pt + time = _ptTimer pt scaleChange | time < 80 = 3 | otherwise = 3 - (fromIntegral time - 80) * 0.2 @@ -76,20 +76,20 @@ moveFlame -> (World, Maybe Particle) moveFlame rotd w pt | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) - | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of + | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of ((_,Left _):_) -> (doSound damcrs , mvPt 0.7) (thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p) _ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98) where - time = _btTimer' pt + time = _ptTimer pt doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) - sp@(V2 x y) = _btPos' pt + sp@(V2 x y) = _ptPos pt vel = _ptVel pt ep = sp +.+ vel mvPt speed = Just $ pt - { _btTimer' = time - 1 - , _btPos' = ep - , _btPassThrough' = Nothing + { _ptTimer = time - 1 + , _ptPos = ep + , _ptCrIgnore = Nothing , _ptVel = speed *.* vel } damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w $ IM.filter closeCrs $ _creatures w @@ -97,37 +97,37 @@ moveFlame rotd w pt < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) angleCoeff x' = abs $ 1 - abs ( (x' * 2 - pi) / pi ) - hiteff = _btHitEffect' pt pt + hiteff = _ptHitEff pt pt rfl wl p = Just $ pt - { _btTimer' = time -1 - , _btPos' = pOut p + { _ptTimer = time -1 + , _ptPos = pOut p , _ptVel = reflV wl } pOut p = p +.+ squashNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel ) +.+ (0.2 *.* vel) -makeFlameletTimed +makeFlamelet :: Point2 -- ^ Position -> Float -- ^ z position -> Point2 -- ^ Velocity - -> Maybe Int -- ^ Creature id + -> Maybe Int -- ^ Ignore creature id -> Float -- ^ Size -> Int -- ^ Timer -> World -> World -makeFlameletTimed (V2 x y) z vel maycid size time w = w +makeFlamelet (V2 x y) z vel maycid size time w = w & randGen .~ g & instantParticles .:~ PtZ { _ptDraw = drawFlameletZ rot , _ptUpdate = moveFlamelet , _ptVel = vel , _ptColor = red - , _btPos' = V2 x y - , _btPassThrough' = maycid - , _btWidth' = size - , _btTimer' = time - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff + , _ptPos = V2 x y + , _ptCrIgnore = maycid + , _ptWidth = size + , _ptTimer = time + , _ptHitEff = destroyOnImpact (doFlameDam 1) noEff , _ptZ = z } where @@ -144,12 +144,12 @@ drawFlameletZ rot pt = pictures ] where z = _ptZ pt - sp = _btPos' pt + sp = _ptPos pt vel = _ptVel pt ep = sp +.+ vel - size = _btWidth' pt + size = _ptWidth pt siz2 = size + 0.2 - time = _btTimer' pt + time = _ptTimer pt piu = setDepth (z + 25) . uncurryV translate ep . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) @@ -182,17 +182,17 @@ drawFlameletZ rot pt = pictures Applies movement and attaches damage to nearby creatures. -} moveFlamelet :: World -> Particle -> (World, Maybe Particle) moveFlamelet w pt - | _btTimer' pt <= 0 = ( w, Nothing) + | _ptTimer pt <= 0 = ( w, Nothing) | otherwise = (flameFlicker pt damcrs, mvPt) where - sp = _btPos' pt + sp = _ptPos pt vel = _ptVel pt ep = sp +.+ vel - size = _btWidth' pt - mvPt = Just $ pt & btTimer' -~ 1 - & btPos' .~ ep - & btPassThrough' .~ Nothing - & ptVel .~ 0.8 *.* vel + size = _ptWidth pt + mvPt = Just $ pt & ptTimer -~ 1 + & ptPos .~ ep + & ptCrIgnore .~ Nothing + & ptVel .~ 0.8 *.* vel damcrs = w & creatures %~ IM.map damifclose isClose cr = dist ep (_crPos cr) < _crRad cr + size damifclose cr diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 2d3d2173c..cb6acd858 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -4,6 +4,7 @@ Find which objects lie upon a line. -} module Dodge.WorldEvent.ThingsHit ( thingsHit + , wallsHit , thingHit , thingsHitLongLine , thingsHitExceptCr @@ -59,6 +60,26 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep crNotCid (_,Left cr) = _crID cr /= cid crNotCid _ = True +wallsHit + :: Point2 -- ^ Line start point + -> Point2 -- ^ Line end point + -> World + -> [(Point2, Wall)] +wallsHit sp ep w + | sp == ep = [] + | otherwise = sortOn (dist sp . fst) wls + where + hitWls = wallsOnLine sp ep + $ IM.unions [f b $ f a $ _znObjects $ _wallsZone w + | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] + -- $ _walls w + (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep)) + f i m = case IM.lookup i m of + Just val -> val + _ -> IM.empty + wls = zip (map (fromJust . hitPoint) hitWls) hitWls + hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w') + thingsHitExceptCrLongLine :: Maybe Int -> Point2 diff --git a/src/Geometry.hs b/src/Geometry.hs index 37634f725..20e0023b4 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -164,6 +164,13 @@ diffAngles x y | otherwise = diffAngles (x + 2*pi) y where diff = x-y + +mixAngles :: Float -> Float -> Float -> Float +mixAngles frac a1 a2 + | abs (a1 - a2) <= pi = normalizeAngle $ frac * a1 + (1 - frac) * a2 + | a1 > a2 = mixAngles frac (a1 - 2*pi) a2 + | otherwise = mixAngles frac (a1 + 2*pi) a2 + -- | Return Just a point if it is inside a circle, Nothing otherwise. pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2 pointInCircle p r c diff --git a/src/LensHelp.hs b/src/LensHelp.hs index a9ad32e13..8cb3aa539 100644 --- a/src/LensHelp.hs +++ b/src/LensHelp.hs @@ -3,13 +3,26 @@ module LensHelp , (.:~) , (.++~) , (++.~) + , (.*.*~) + , (.+.+~) ) where +import Geometry import Control.Lens infixr 4 .:~ (.:~) :: ASetter s t [a] [a] -> a -> s -> t (.:~) m x = m %~ (x :) +infixr 4 .*.*~ +(.*.*~) :: ASetter s t Point2 Point2 -> Float -> s -> t +{-# INLINABLE (.*.*~) #-} +(.*.*~) m x = m %~ (x *.*) + +infixr 4 .+.+~ +(.+.+~) :: ASetter s t Point2 Point2 -> Point2 -> s -> t +{-# INLINABLE (.+.+~) #-} +(.+.+~) m x = m %~ (x +.+) + infixr 4 .++~ (.++~) :: ASetter s t [a] [a] -> [a] -> s -> t (.++~) m x = m %~ (x ++) diff --git a/src/Picture.hs b/src/Picture.hs index 75196491d..d9e07b835 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -16,6 +16,7 @@ module Picture , thickArc , thickCircle , thickLine + , lineThick , thickLineCol , circleSolid , circleSolidCol @@ -236,6 +237,16 @@ lineCol :: [(Point2,RGBA)] -> Picture {-# INLINE lineCol #-} lineCol = flip thickLineCol 1 +lineThick :: Float -> [Point2] -> Picture +{-# INLINE lineThick #-} +lineThick t = pictures . f + where + f (x:y:ys) + | x == y = f (x:ys) + | otherwise = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys) + f _ = [] + n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b)) + thickLine :: [Point2] -> Float -> Picture {-# INLINE thickLine #-} thickLine ps t = pictures $ f ps