Add new bullet trajectories

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 
+    f i m = fromMaybe IM.empty $ IM.lookup i m
-        Just val -> val
-        _        -> IM.empty
 
 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 
+    f i m = fromMaybe IM.empty $ IM.lookup i m
-        Just val -> val
-        _        -> IM.empty
 
 -- possible BUG, occurs when used in thingsHitLongLine
 creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature

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] ]
+    ++ [bangCaneX i | i <- [1..6] ]
-            ++ [revolverX i | i <- [1..5] ]
+    ++ [revolverX i | i <- [1..5] ]
-            ++ [miniGunX i   | i <- [3..16] ]
+    ++ [miniGunX  i | i <- [3..16] ]
-            ++ [bangCane
+    ++ [bangCane
-            ,pistol
+    ,pistol
-            ,autoPistol
+    ,autoPistol
-            ,smg
+    ,smg
-            ,machinePistol
+    ,machinePistol
-            ,revolver
+    ,revolver
-            ,rifle
+    ,rifle
-            ,repeater
+    ,repeater
-            ,autoRifle
+    ,autoRifle
-            ,burstRifle
+    ,burstRifle
-            ,fastBurstRifle
+    ,fastBurstRifle
-            ,completeBurstRifle
+    ,completeBurstRifle
-            ]
+    ]

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

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..] 

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

src/Dodge/Data.hs

@@ -380,15 +380,19 @@ data Item = Item
 data Targeting
     = NoTargeting
     | TargetingOnHeld
-        { _tgPos        :: Maybe Point2
+        { _tgPos    :: Maybe Point2
-        , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+        , _tgUpdate :: Item -> Creature -> World -> Targeting -> Targeting
-        , _tgDraw       :: Int -> Item -> Creature -> World -> Picture
+        , _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 }

src/Dodge/Default/Weapon.hs

@@ -99,8 +99,10 @@ defaultGun = Item
     , _itInvSize  = 1
     , _itParams = NoParams
     , _itTweaks = NoTweaks
-    , _itModules = M.fromList [(ModBullet , DefaultModule)
+    , _itModules = M.fromList 
-        ,(ModBulletTarget,DefaultModule)
+        [(ModBullet, DefaultModule)
+        ,(ModTarget, DefaultModule)
+        ,(ModBulletTrajectory, DefaultModule)
         ]
     , _itScope = NoScope
     , _itTargeting = NoTargeting

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 
+useAmmoParams it cr = case _amBulTraj b of
-    (muzvel *.* _amBulVel b) 
+    BasicBulletTrajectory -> withVelWthHiteff 
-    (_rifling $ _itParams it) 
+        (muzvel *.* _amBulVel b) 
-    (_amBulWth b) 
+        (_rifling $ _itParams it) 
-    muzlength
+        (_amBulWth b) 
-    (_amBulEff b) 
+        muzlength
-    cr
+        (_amBulEff b) 
+        cr
+    BezierTrajectory -> useTargetPos (\p -> shootBezier $ fromJust p) cr
+    FlechetteTrajectory -> undefined
+    MagnetTrajectory    -> undefined
   where
     muzlength = aimingMuzzlePos cr it
     muzvel = _muzVel $ _itParams it

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.List
-import Data.Bifunctor
+--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
+    (thHit, ps) = reflectLaserAlong phasev [] pos xp w
-    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
     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 

src/Dodge/Item/Weapon/Bezier.hs

@@ -1,5 +1,6 @@
 module Dodge.Item.Weapon.Bezier
     ( bezierGun
+    , shootBezier
     ) where
 import Dodge.Data
 import Dodge.Base

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
     }

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

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
+defaultTargeting :: Targeting
-targetRBPress = TargetingOnHeld
+defaultTargeting = TargetingOnHeld
     { _tgPos = Nothing
-    , _tgHeldUpdate = targetRBPressUpdate
+    , _tgUpdate = \_ _ _ -> id
-    , _tgDraw = targetRBPressDraw
+    , _tgDraw = \_ _ _ _ -> mempty
+    , _tgID = Nothing
+    , _tgActive = False
+    , _tgPoints = []
     }
-targetRBPressDraw :: Int -> Item -> Creature -> World -> Picture
+targetLaser :: Targeting
-targetRBPressDraw _ it _ w = fromMaybe mempty $ do
+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)

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)

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

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

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)

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
-