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

Fix aiming with no weapon crash

Browse Source
This commit is contained in:
justin
2022-02-08 12:47:58 +00:00
parent 9ead5b3979
commit 0a860e6f68
39 changed files with 317 additions and 244 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+10
View File
@@ -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.
src/Dodge/Clock.hs
+1 -2
View File
@@ -1,7 +1,6 @@
module Dodge.Clock
( clockCycle
)
where
) where
import Dodge.Data
import qualified Data.Vector as V
src/Dodge/Combine.hs
+7 -7
View File
@@ -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
src/Dodge/Combine/Combinations.hs
+5
View File
@@ -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]
src/Dodge/Combine/Data.hs
+1
View File
@@ -40,6 +40,7 @@ data CombineType
| LONGGUN
| TESLAGUN
| LASGUN
| SONICGUN
| TRACTORGUN
| LAUNCHER
| SPRAYER
src/Dodge/Creature.hs
+3 -2
View File
@@ -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
src/Dodge/Creature/Impulse/Movement.hs
+7 -10
View File
@@ -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
src/Dodge/Creature/Impulse/UseItem.hs
+2 -2
View File
@@ -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
src/Dodge/Creature/State.hs
+10 -10
View File
@@ -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
src/Dodge/Data.hs
+34 -55
View File
@@ -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
src/Dodge/Default/World.hs
+2
View File
@@ -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 = []
src/Dodge/Event.hs
+3 -1
View File
@@ -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
src/Dodge/Item/Craftable.hs
+3
View File
@@ -18,3 +18,6 @@ makeTypeCraft :: CombineType -> Item
makeTypeCraft = makeTypeCraftNum 1
pipe :: Item
pipe = makeTypeCraft PIPE
plateCraft :: Item
plateCraft = makeTypeCraft PLATE
src/Dodge/Item/Draw.hs
-9
View File
@@ -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
src/Dodge/Item/Equipment.hs
+25 -6
View File
@@ -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
src/Dodge/Item/Weapon.hs
+2
View File
@@ -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
src/Dodge/Item/Weapon/BatteryGuns.hs
+6 -7
View File
@@ -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
}
src/Dodge/Item/Weapon/BulletGun/Cane.hs
+3 -1
View File
@@ -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
src/Dodge/Item/Weapon/BulletGun/Stick.hs
+2 -2
View File
@@ -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
src/Dodge/Item/Weapon/Grenade.hs
+2 -2
View File
@@ -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
src/Dodge/Item/Weapon/InventoryDisplay.hs
+1 -1
View File
@@ -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
src/Dodge/Item/Weapon/Launcher.hs
+2 -2
View File
@@ -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
src/Dodge/Item/Weapon/Radar.hs
+2 -2
View File
@@ -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. -}
src/Dodge/Item/Weapon/TriggerType.hs
+4 -3
View File
@@ -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
src/Dodge/Particle/Bullet/Draw.hs
+1 -1
View File
@@ -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)
src/Dodge/Particle/Bullet/HitEffect.hs
+8 -8
View File
@@ -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
src/Dodge/Particle/Bullet/Spawn.hs
+13 -13
View File
@@ -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
src/Dodge/Particle/Bullet/Update.hs
+5 -6
View File
@@ -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
src/Dodge/Particle/Spark.hs
+8 -8
View File
@@ -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
src/Dodge/Update.hs
+13 -2
View File
@@ -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
src/Dodge/WorldEvent/Explosion.hs
+1 -1
View File
@@ -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
src/Dodge/WorldEvent/Flash.hs
+8 -10
View File
@@ -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
src/Dodge/WorldEvent/HitEffect.hs
+6 -6
View File
@@ -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
src/Dodge/WorldEvent/Shockwave.hs
+30 -30
View File
@@ -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
src/Dodge/WorldEvent/SpawnParticle.hs
+35 -35
View File
@@ -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
src/Dodge/WorldEvent/ThingsHit.hs
+21
View File
@@ -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
src/Geometry.hs
+7
View File
@@ -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
src/LensHelp.hs
+13
View File
@@ -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 ++)
src/Picture.hs
+11
View File
@@ -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