diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 49cbc785e..a06ea6811 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -16,10 +16,10 @@ import Geometry --import Picture import qualified IntMapHelp as IM import FoldableHelp +import qualified FoldlHelp as L import Dodge.Base.You import Control.Lens -import qualified Control.Foldl as L import Data.Monoid import Data.Maybe --import Data.Bifunctor @@ -97,23 +97,22 @@ wallsOnCirc p r = IM.filter f allWalls :: World -> IM.IntMap Wall allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone +creatureNearPoint :: Point2 -> World -> Maybe Creature +creatureNearPoint p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPoint p + creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature creaturesNearPoint p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] where (x,y) = crZoneOfPoint p - f i m = case IM.lookup i m of - Just val -> val - _ -> IM.empty + f i m = fromMaybe IM.empty $ IM.lookup i m creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature creaturesNearPointI n p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]] where (x,y) = crZoneOfPoint p - f i m = case IM.lookup i m of - Just val -> val - _ -> IM.empty + f i m = fromMaybe IM.empty $ IM.lookup i m -- possible BUG, occurs when used in thingsHitLongLine creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index c8f7d187a..8f6f3e888 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -111,10 +111,23 @@ moduleCombinations = ,amod [BOUNCEMODULE] "+BOUNCE" (f $ destroyOnImpact bulBounceArmCr' bulBounceWall) ] ) - , ( ModBulletTarget + , ( ModTarget , launcher : bulletWeapons + , [amod [MICROCHIP,CREATURESENSOR] "+CREATURETARGETING" (itTargeting .~ targetRBCreature) + ,amod [MICROCHIP,PRISM] "+LASERTARGETING" (itTargeting .~ targetLaser) + ,amod [MICROCHIP,TIN] "+POSTIONALTARGETING" (itTargeting .~ targetRBPress) + ] + ) + , ( ModBulletTrajectory + , bulletWeapons , [amod [TELEPORTMODULE,MICROCHIP] "+TELEPORT" (itUse . useMods .:~ withPositionWallCheck (const . const mouseWorldPos)) ,amod [TELEPORTMODULE] "+DIRECTEDTELE" makeDirectedTele + ,amod [MAGNET,MICROCHIP,HARDWARE] "+MAGNETTRAJECTORY" + (itConsumption . aoType . amBulTraj .~ MagnetTrajectory) + ,amod [MICROCHIP,HARDWARE] "+FLECHETTETRAJECTORY" + (itConsumption . aoType . amBulTraj .~ FlechetteTrajectory) + ,amod [MAGNET,AIUNIT,HARDWARE] "+BEZIERTRAJECTORY" + (itConsumption . aoType . amBulTraj .~ BezierTrajectory) ] ) ] @@ -136,19 +149,19 @@ moduleCombinations = bulletWeapons :: [Item] bulletWeapons = [bangStick i | i <- [1..9] ] - ++ [bangCaneX i | i <- [1..6] ] - ++ [revolverX i | i <- [1..5] ] - ++ [miniGunX i | i <- [3..16] ] - ++ [bangCane - ,pistol - ,autoPistol - ,smg - ,machinePistol - ,revolver - ,rifle - ,repeater - ,autoRifle - ,burstRifle - ,fastBurstRifle - ,completeBurstRifle - ] + ++ [bangCaneX i | i <- [1..6] ] + ++ [revolverX i | i <- [1..5] ] + ++ [miniGunX i | i <- [3..16] ] + ++ [bangCane + ,pistol + ,autoPistol + ,smg + ,machinePistol + ,revolver + ,rifle + ,repeater + ,autoRifle + ,burstRifle + ,fastBurstRifle + ,completeBurstRifle + ] diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 4cbc89a08..f328a9c1a 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -84,11 +84,14 @@ data CombineType | MAGNET | PLATE | MICROCHIP + | AIUNIT | LED | NAILBOX | IRONBAR | LIGHTSENSOR | SOUNDSENSOR + | HEATSENSOR + | CREATURESENSOR | COPPERWIRE | BATTERY | FUELCELL diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index c5bc25df5..3f99da145 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -171,6 +171,7 @@ testInventory = IM.fromList $ zip [0..] , bounceModule , teleportModule , makeTypeCraftNum 5 TUBE + , makeTypeCraftNum 3 PRISM , makeTypeCraftNum 1 MAGNET , makeTypeCraftNum 5 HARDWARE , makeTypeCraftNum 3 SPRING @@ -178,7 +179,8 @@ testInventory = IM.fromList $ zip [0..] , makeTypeCraftNum 3 TIN , makeTypeCraftNum 3 PLANK , makeTypeCraftNum 1 MOTOR - , makeTypeCraftNum 1 MICROCHIP + , makeTypeCraftNum 5 MICROCHIP + , makeTypeCraftNum 5 AIUNIT ] stackedInventory :: IM.IntMap Item stackedInventory = IM.fromList $ zip [0..] diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 0024dca16..a3b2bb5f1 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -150,7 +150,7 @@ invSideEff cr w = weaponReloadSounds cr itpointer = creatures . ix (_crID cr) . crInv . ix i doHeldItemTargeting :: Creature -> World -> World -doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgHeldUpdate of +doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgUpdate of Nothing -> w Just f -> w & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting %~ f (_crInv cr IM.! _crInvSel cr) cr w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 2dd6a662e..79b97cf40 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -380,15 +380,19 @@ data Item = Item data Targeting = NoTargeting | TargetingOnHeld - { _tgPos :: Maybe Point2 - , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> Targeting - , _tgDraw :: Int -> Item -> Creature -> World -> Picture + { _tgPos :: Maybe Point2 + , _tgUpdate :: Item -> Creature -> World -> Targeting -> Targeting + , _tgDraw :: Int -> Item -> Creature -> World -> Picture + , _tgID :: Maybe Int + , _tgActive :: Bool + , _tgPoints :: [Point2] } data ModuleSlot = ModBullet | ModRifleMag | ModAutoMag - | ModBulletTarget + | ModTarget + | ModBulletTrajectory deriving (Eq,Ord) data ItemModule @@ -507,6 +511,12 @@ type HitEffect = Particle -> World -> (World,Maybe Particle) +data BulletTrajectory + = BasicBulletTrajectory + | BezierTrajectory + | FlechetteTrajectory + | MagnetTrajectory + data AmmoType = ProjectileAmmo { _amPayload :: Point2 -> World -> World @@ -519,6 +529,7 @@ data AmmoType , _amBulEff :: HitEffect , _amBulWth :: Float , _amBulVel :: Point2 + , _amBulTraj :: BulletTrajectory } | DroneAmmo { _amString :: String } diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 39232e683..376d0373b 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -99,8 +99,10 @@ defaultGun = Item , _itInvSize = 1 , _itParams = NoParams , _itTweaks = NoTweaks - , _itModules = M.fromList [(ModBullet , DefaultModule) - ,(ModBulletTarget,DefaultModule) + , _itModules = M.fromList + [(ModBullet, DefaultModule) + ,(ModTarget, DefaultModule) + ,(ModBulletTrajectory, DefaultModule) ] , _itScope = NoScope , _itTargeting = NoTargeting diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index ee0e1f1fe..af1939624 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -9,10 +9,12 @@ module Dodge.Item.Weapon.AmmoParams import Dodge.Data import Dodge.Particle.Bullet.Spawn import Dodge.Creature.HandPos +import Dodge.Item.Weapon.Targeting +import Dodge.Item.Weapon.Bezier import Geometry import LensHelp ---import Data.Maybe +import Data.Maybe --import Control.Lens useAmmoParamsRate :: Int @@ -35,13 +37,17 @@ defaultAimParams = AimParams } useAmmoParams :: Item -> Creature -> World -> World -useAmmoParams it cr = withVelWthHiteff - (muzvel *.* _amBulVel b) - (_rifling $ _itParams it) - (_amBulWth b) - muzlength - (_amBulEff b) - cr +useAmmoParams it cr = case _amBulTraj b of + BasicBulletTrajectory -> withVelWthHiteff + (muzvel *.* _amBulVel b) + (_rifling $ _itParams it) + (_amBulWth b) + muzlength + (_amBulEff b) + cr + BezierTrajectory -> useTargetPos (\p -> shootBezier $ fromJust p) cr + FlechetteTrajectory -> undefined + MagnetTrajectory -> undefined where muzlength = aimingMuzzlePos cr it muzvel = _muzVel $ _itParams it diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index f9977f143..91b6b7994 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -5,10 +5,11 @@ module Dodge.Item.Weapon.BatteryGuns , lasRayAt ) where import Dodge.Data +import Dodge.Item.Weapon.LaserPath import Dodge.Creature.HandPos import Dodge.Particle.TeslaArc import Dodge.SoundLogic.LoadSound -import Dodge.WorldEvent +--import Dodge.WorldEvent import Dodge.WorldEvent.Damage --import Dodge.Default --import Dodge.Item.Weapon.InventoryDisplay @@ -25,10 +26,10 @@ import Shape import ShapePicture import LensHelp -import Data.List -import Data.Bifunctor +--import Data.List +--import Data.Bifunctor import System.Random -import Data.Tuple +--import Data.Tuple import qualified Data.IntMap.Strict as IM teslaGun :: Item teslaGun = defaultGun @@ -178,45 +179,13 @@ mvLaser phasev pos dir w pt ) where xp = pos +.+ 800 *.* unitVectorAtAngle dir - (thHit, ps) = f [] pos xp - f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2]) - f seenWs x y = case find (notseen seenWs) $ thingsHitExceptCrLongLine Nothing x y w of - --f seenWs x y = case find (notseen seenWs) $ thingsHitExceptCr Nothing x y w of - Just (p,Right wl) - | _wlOpacity wl == SeeThrough -> second (p:) $ f (wl:seenWs) p (refract x y wl p) - | otherwise -> (Just (p,Right wl), [p]) - Just (p,obj) -> (Just (p,obj), [p]) - Nothing -> (Nothing, [y]) - refract x y wl p - | isEntering = p +.+ rotateV angleRef (normalDist wlNormal) - | otherwise = p +.+ rotateV angleRef' (normalDist wlNormal') - where - wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl) - wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl) - normalDist wlnormal = magV (p -.- y) *.* normalizeV wlnormal - angleInc = piRange $ argV wlNormal - argV (x -.- y) - angleRef - | reflectExternal = angleInc - | otherwise = asin $ sin angleInc / phasev - piRange a' - | a' > pi = a' - 2 * pi - | a' > negate pi = a' - | otherwise = a' + 2 * pi - isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl)) - angleInc' = piRange $ argV wlNormal' - argV (x -.- y) - angleRef' - | reflectInternal = angleInc' - | otherwise = asin $ phasev * sin angleInc' - reflectInternal = 1 < abs (phasev * sin angleInc') - reflectExternal = 1 < abs (sin angleInc / phasev) - - notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws - notseen _ _ = True + (thHit, ps) = reflectLaserAlong phasev [] pos xp w pic = setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 yellow) $ thickLine 20 (pos:ps) , setDepth 19.5 . color (brightX 10 1 yellow) $ thickLine 3 (pos:ps) ] + aTractorBeam :: Item -> Creature -> World -> World aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir where diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 6e1bfdb95..2d28e88f1 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -1,5 +1,6 @@ module Dodge.Item.Weapon.Bezier ( bezierGun + , shootBezier ) where import Dodge.Data import Dodge.Base diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 33cff5e50..df5d41430 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -17,6 +17,7 @@ basicBullet = BulletAmmo , _amBulEff = destroyOnImpact bulHitCr bulHitWall , _amBulWth = 2 , _amBulVel = V2 50 0 + , _amBulTraj = BasicBulletTrajectory } incBullet :: AmmoType incBullet = BulletAmmo @@ -24,6 +25,7 @@ incBullet = BulletAmmo , _amBulEff = destroyOnImpact bulIncCr bulIncWall , _amBulWth = 2 , _amBulVel = V2 50 0 + , _amBulTraj = BasicBulletTrajectory } conBullet :: AmmoType conBullet = BulletAmmo @@ -31,6 +33,7 @@ conBullet = BulletAmmo , _amBulEff = destroyOnImpact bulConCr bulConWall , _amBulWth = 2 , _amBulVel = V2 50 0 + , _amBulTraj = BasicBulletTrajectory } bounceBullet :: AmmoType bounceBullet = BulletAmmo @@ -38,6 +41,7 @@ bounceBullet = BulletAmmo , _amBulEff = destroyOnImpact bulHitCr bulBounceWall , _amBulWth = 2 , _amBulVel = V2 50 0 + , _amBulTraj = BasicBulletTrajectory } ltBullet :: AmmoType ltBullet = BulletAmmo @@ -45,6 +49,7 @@ ltBullet = BulletAmmo , _amBulEff = destroyOnImpact bulHitCr bulHitWall , _amBulWth = 2 , _amBulVel = V2 40 0 + , _amBulTraj = BasicBulletTrajectory } hvBullet :: AmmoType hvBullet = BulletAmmo @@ -52,4 +57,5 @@ hvBullet = BulletAmmo , _amBulEff = penWalls hvBulHitCr hvBulHitWall , _amBulWth = 6 , _amBulVel = V2 80 0 + , _amBulTraj = BasicBulletTrajectory } diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 46e91952e..66b4c66c2 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -44,7 +44,7 @@ bangCane :: Item bangCane = defaultGun { _itName = "BANGCANE" , _itType = BANGCANE - ,_itParams = BulletShooter + , _itParams = BulletShooter { _muzVel = 0.8 , _rifling = 0.9 , _bore = 2 diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 97a4dc8a0..f5caa37fc 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -3,17 +3,20 @@ Extra weapon effects, supplementing explicit use effects. -} module Dodge.Item.Weapon.ExtraEffect - (-- wpRecock - itemLaserScopeEffect + ( itemLaserScopeEffect , autoSonarEffect , autoRadarEffect , targetRBPress + , targetRBCreature + , targetCursor + , targetLaser -- , rbSetTarget ) where import Dodge.Data import Dodge.Base import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.UseEffect +import Dodge.Item.Weapon.LaserPath --import Dodge.Item.Attachment.Data import Dodge.WorldEvent.ThingsHit import Dodge.Picture.Layer @@ -82,16 +85,35 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } f t _ cr i w = w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) -targetRBPress :: Targeting -targetRBPress = TargetingOnHeld +defaultTargeting :: Targeting +defaultTargeting = TargetingOnHeld { _tgPos = Nothing - , _tgHeldUpdate = targetRBPressUpdate - , _tgDraw = targetRBPressDraw + , _tgUpdate = \_ _ _ -> id + , _tgDraw = \_ _ _ _ -> mempty + , _tgID = Nothing + , _tgActive = False + , _tgPoints = [] } -targetRBPressDraw :: Int -> Item -> Creature -> World -> Picture -targetRBPressDraw _ it _ w = fromMaybe mempty $ do +targetLaser :: Targeting +targetLaser = defaultTargeting + & tgUpdate .~ targetLaserUpdate + & tgDraw .~ targetLaserDraw +targetRBPress :: Targeting +targetRBPress = defaultTargeting + & tgUpdate .~ targetRBPressUpdate + & tgDraw .~ targetSimpleDraw +targetRBCreature :: Targeting +targetRBCreature = defaultTargeting + & tgUpdate .~ targetRBCreatureUpdate + & tgDraw .~ targetRBCreatureDraw +targetCursor :: Targeting +targetCursor = defaultTargeting + & tgUpdate .~ targetCursorUpdate + & tgDraw .~ targetSimpleDraw +targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture +targetSimpleDraw _ it _ w = fromMaybe mempty $ do mwp <- it ^? itTargeting . tgPos . _Just - return $ setLayer 1 $ color red $ onLayer InvLayer $ uncurryV translate mwp + return $ setLayer 5 $ color red $ onLayer InvLayer $ uncurryV translate mwp $ rotate (_cameraRot w) $ pictures [line [V2 x x, V2 (-x) (-x)] @@ -100,8 +122,67 @@ targetRBPressDraw _ it _ w = fromMaybe mempty $ do where x = 5 / _cameraZoom w +targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture +targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do + mwp <- it ^? itTargeting . tgPos . _Just + return $ setLayer 5 $ color thecolor $ onLayer InvLayer $ uncurryV translate mwp + $ rotate (_cameraRot w) + $ pictures + [line [V2 x x, V2 (-x) (-x)] + ,line [V2 (-x) x, V2 x (-x)] + ] + where + x = 5 / _cameraZoom w + thecolor | _tgActive $ _itTargeting it = red + | otherwise = blue + +targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting +targetCursorUpdate _ _ w t + | SDL.ButtonRight `S.member` _mouseButtons w = t + & tgPos . _Just .~ mouseWorldPos w + & tgActive .~ True + | otherwise = t & tgPos %~ const Nothing + & tgActive .~ False + targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting targetRBPressUpdate _ _ w t | SDL.ButtonRight `S.member` _mouseButtons w = t & tgPos %~ maybe (Just $ mouseWorldPos w) Just + & tgActive .~ True | otherwise = t & tgPos %~ const Nothing + & tgActive .~ False + +targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting +targetRBCreatureUpdate _ _ w t + | SDL.ButtonRight `S.member` _mouseButtons w = t & updatePos + & tgActive .~ True + | otherwise = t & tgID .~ fmap _crID (creatureNearPoint mwp w) + & updatePos + & tgActive .~ False + where + mwp = mouseWorldPos w + updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') + posFromMaybeID Nothing = Nothing + posFromMaybeID (Just i) = w ^? creatures . ix i . crPos + +targetLaserDraw :: Int -> Item -> Creature -> World -> Picture +targetLaserDraw _ it _ _ = fromMaybe mempty $ do + ps <- it ^? itTargeting . tgPoints + return $ setLayer 1 $ pictures + [ setDepth 19 . color (brightX 0 0.5 red) $ thickLine 5 ps + , setDepth 19.5 . color (brightX 5 1 red) $ thickLine 1 ps + ] + +targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting +targetLaserUpdate _ cr w t + | SDL.ButtonRight `S.member` _mouseButtons w = t + & tgPos .~ fmap fst mp + & tgPoints .~ ps ++ [sp] + & tgActive .~ True + | otherwise = t & tgPos %~ const Nothing + & tgPoints .~ [] + & tgActive .~ False + where + (mp, ps) = reflectLaserAlong 0.2 [] sp ep w + sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) + ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp) diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs new file mode 100644 index 000000000..68fa62e52 --- /dev/null +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -0,0 +1,54 @@ +module Dodge.Item.Weapon.LaserPath + ( reflectLaserAlong + ) where +import Dodge.Data +--import Dodge.Creature.HandPos +import Dodge.WorldEvent +--import Dodge.Default +--import Dodge.Item.Weapon.InventoryDisplay +--import Dodge.Item.Weapon.TriggerType +--import Dodge.Item.Attachment +--import Dodge.Base +import Geometry + +--import Data.Maybe +import Data.List +import Data.Bifunctor +import Data.Tuple + +-- not sure why we need to keep a list of seen walls, but seems to loop +-- infinitely when removed +reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World + -> (Maybe (Point2,Either Creature Wall),[Point2]) +reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl) + $ thingsHitExceptCrLongLine Nothing sp ep w of + Just (p,Right wl) + | _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w + | otherwise -> (Just (p,Right wl), [p]) + Just (p,obj) -> (Just (p,obj), [p]) + Nothing -> (Nothing, [ep]) + where + notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws + notseen _ _ = True + refract x y wl p + | isEntering = p +.+ rotateV angleRef (normalDist wlNormal) + | otherwise = p +.+ rotateV angleRef' (normalDist wlNormal') + where + wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl) + wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl) + normalDist wlnormal = magV (p -.- y) *.* normalizeV wlnormal + angleInc = piRange $ argV wlNormal - argV (x -.- y) + angleRef + | reflectExternal = angleInc + | otherwise = asin $ sin angleInc / phasev + piRange a' + | a' > pi = a' - 2 * pi + | a' > negate pi = a' + | otherwise = a' + 2 * pi + isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl)) + angleInc' = piRange $ argV wlNormal' - argV (x -.- y) + angleRef' + | reflectInternal = angleInc' + | otherwise = asin $ phasev * sin angleInc' + reflectInternal = 1 < abs (phasev * sin angleInc') + reflectExternal = 1 < abs (sin angleInc / phasev) diff --git a/src/Dodge/Movement/Turn.hs b/src/Dodge/Movement/Turn.hs new file mode 100644 index 000000000..18be39d4a --- /dev/null +++ b/src/Dodge/Movement/Turn.hs @@ -0,0 +1,22 @@ +module Dodge.Movement.Turn where +import Geometry + +turnTo :: Float -> Point2 -> Point2 -> Float -> Float +turnTo turnSpeed sp tp a + | vToTarg == V2 0 0 = a + | angleVV vToTarg vdir <= turnSpeed + = argV vToTarg + | isLHS (sp +.+ vdir) sp tp = a - turnSpeed + | otherwise = a + turnSpeed + where + vdir = unitVectorAtAngle a + vToTarg = tp -.- sp + +vecTurnTo :: Float -> Point2 -> Point2 -> Point2 -> Point2 +vecTurnTo turnSpeed sp tp vdir + | angleVV vToTarg vdir <= turnSpeed + = argV vdir *.* normalizeV vToTarg + | isLHS (sp +.+ vdir) sp tp = rotateV (negate turnSpeed) vdir + | otherwise = rotateV turnSpeed vdir + where + vToTarg = tp -.- sp diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index c5a0e4622..4c88e6405 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -7,6 +7,7 @@ module Dodge.Particle.Bullet.Spawn import Dodge.Data import Dodge.Particle.Bullet.Draw import Dodge.Particle.Bullet.Update +import Dodge.Movement.Turn import Geometry import Picture import LensHelp @@ -105,3 +106,28 @@ accelBulAt maycid col pos vel acc hiteff width = BulletPt } where setVel pt = pt & ptVel .+.+~ acc + +turnBulAt + :: Maybe Int -- ^ Pass-through creature id + -> Color + -> Point2 -- ^ Start position + -> Point2 -- ^ Velocity + -> Point2 -- ^ Acceleration + -> HitEffect + -> Float -- ^ Bullet width + -> Point2 -- ^ Target position + -> Particle +turnBulAt maycid col pos vel acc hiteff width tpos = BulletPt + { _ptDraw = drawBul + , _ptUpdate = \w -> mvBullet w . setVel + , _ptVel = vel + , _btDrag = 1 + , _ptColor = col + , _ptTrail = [pos] + , _ptCrIgnore = maycid + , _ptWidth = width + , _ptTimer = 100 + , _ptHitEff = hiteff + } + where + setVel pt = pt & ptVel %~ vecTurnTo 0.1 (head $ _ptTrail pt) tpos diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index d7dd290d4..2880d76cd 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -7,6 +7,7 @@ import Dodge.Creature.Impulse import Dodge.Creature.Picture import Dodge.LevelGen.Data import Dodge.Default +import Dodge.Movement.Turn --import Dodge.Creature.Impulse.UseItem import Dodge.FloorItem import Dodge.Wall.Delete @@ -109,16 +110,6 @@ updateTurret rotSpeed mc w | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20 | otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) -turnTo :: Float -> Point2 -> Point2 -> Float -> Float -turnTo turnSpeed sp tp a - | vToTarg == V2 0 0 = a - | angleVV vToTarg vdir <= turnSpeed - = argV vToTarg - | isLHS (sp +.+ vdir) sp tp = a - turnSpeed - | otherwise = a + turnSpeed - where - vdir = unitVectorAtAngle a - vToTarg = tp -.- sp drawTurret :: Machine -> SPic drawTurret mc = (rotateSH (-_mcDir mc) . colorSH blue $ upperPrismPoly 20 (square wdth) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 09773577c..b58ed786e 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -1,5 +1,4 @@ -{- | -Contains the central drawing functions for the dodge loop. -} +{- | Contains the central drawing functions for the dodge loop. -} module Dodge.Render ( doDrawing ) where @@ -278,4 +277,3 @@ renderTextureWalls pdata nWalls = do cullFace $= Just Back drawShader (_wallTextureShader pdata) nWalls cullFace $= Nothing -