Split UseItem module

src/Dodge/AIs.hs

@@ -4,7 +4,7 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Path
 import Dodge.SoundLogic
-import Dodge.CreatureActions
+import Dodge.CreatureAction
 import Dodge.KeyEvents
 import Dodge.RandomHelp
 import Dodge.WorldActions

src/Dodge/CreatureAction.hs

@@ -1,6 +1,13 @@
 {-# LANGUAGE BangPatterns #-}
-module Dodge.CreatureActions where
+module Dodge.CreatureAction 
+    ( module Dodge.CreatureAction
+    , useItemContinuous
+    , tryUseItem
+    )
+    where
 -- imports {{{
+import Dodge.CreatureAction.UseItem
+
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
@@ -190,11 +197,7 @@ moveBy :: Int -> Point2 -> World -> World
 moveBy n v = over (creatures . ix n . crPos) (+.+ v)
 
 reloadWeapon :: Int -> World -> Maybe World
-reloadWeapon cid w = if _unlimitedAmmo w then reloadWeaponUnlimited cid w
+reloadWeapon cid w = 
-                                         else reloadWeaponAmmoCheck cid w
-
-reloadWeaponUnlimited :: Int -> World -> Maybe World
-reloadWeaponUnlimited cid w = 
     let cr = _creatures w IM.! cid
         it = _crInv cr IM.! _crInvSel cr
         itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
@@ -204,46 +207,6 @@ reloadWeaponUnlimited cid w =
                                             $ set ( itRef . wpReloadState) rT w
         _                          -> Nothing
 
-reloadWeaponAmmoCheck :: Int -> World -> Maybe World
-reloadWeaponAmmoCheck cid w = 
-    let cr = _creatures w IM.! cid
-        it = _crInv cr IM.! _crInvSel cr
-        itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
-    in  case it of 
-            Weapon {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA,_wpAmmoType=aT
-                   ,_wpReloadState=rS ,_wpReloadTime=rT} 
-                ->  do guard $ lA < maxA && rS == 0 && M.findWithDefault 0 aT (_crAmmo cr) > 0
-                       toAdd <- Just $ min (_crAmmo (you w) M.! aT) (maxA - lA)
-                       return $ over (creatures . ix cid . crAmmo) (M.adjust (\x -> x - toAdd) aT)
-                              $ over ( itRef . wpLoadedAmmo) (\x -> x + toAdd)
-                              $ set ( itRef . wpReloadState) rT w
-            _   -> Nothing
-
-
-useItemContinuous :: Int -> World -> World
-useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
-                            Just HammerUp -> useItem1 n $ setHammerDown w
-                            Just NoHammer -> useItem1 n w
-                            _             -> setHammerDown w
-    where 
-        cr = _creatures w IM.! n
-        setHammerDown = creatures . ix n . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
-
-tryUseItem :: Int -> World -> World
-tryUseItem cid w = case w ^? creatures . ix cid of
-    Just cr -> useItem2 cid (_crInv cr IM.! _crInvSel cr) w
-    Nothing -> w
-
-useItem1 :: Int -> World -> World
-useItem1 n w = useItem2 n it w
-    where c = (_creatures w IM.! n)
-          it = _crInv c IM.! _crInvSel c
-
-useItem2 :: Int -> Item -> World -> World
-useItem2 n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w
-useItem2 n (Weapon {_wpFire=eff}) w = eff n w
-useItem2 n (Throwable {_twFire = eff}) w = eff n w
-useItem2 _ _ w = w
 
 
 createItemAt :: Point2 -> FloorItem -> World -> World

src/Dodge/CreatureAction/UseItem.hs

@@ -0,0 +1,35 @@
+module Dodge.CreatureAction.UseItem
+    where
+import Dodge.Data
+
+import Dodge.Inventory
+
+import qualified Data.IntMap as IM
+
+import Control.Lens
+import Data.Maybe (fromMaybe)
+
+useItemContinuous :: Int -> World -> World
+useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+                            Just HammerUp -> useItem1 n $ setHammerDown w
+                            Just NoHammer -> useItem1 n w
+                            _             -> setHammerDown w
+    where 
+        cr = _creatures w IM.! n
+        setHammerDown = creatures . ix n . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+
+tryUseItem :: Int -> World -> World
+tryUseItem cid w = case w ^? creatures . ix cid of
+    Just cr -> useItem2 cid (_crInv cr IM.! _crInvSel cr) w
+    Nothing -> w
+
+useItem1 :: Int -> World -> World
+useItem1 n w = useItem2 n it w
+    where c = (_creatures w IM.! n)
+          it = _crInv c IM.! _crInvSel c
+
+useItem2 :: Int -> Item -> World -> World
+useItem2 n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w
+useItem2 n (Weapon {_wpFire=eff}) w = eff n w
+useItem2 n (Throwable {_twFire = eff}) w = eff n w
+useItem2 _ _ w = w

src/Dodge/CreatureState.hs

@@ -6,7 +6,7 @@ import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.WorldActions
 import Dodge.WallCreatureCollisions
-import Dodge.CreatureActions
+import Dodge.CreatureAction
 
 import Geometry
 

src/Dodge/Critters.hs

@@ -125,7 +125,6 @@ miniGunCrit = basicCreature
     , _crInv = IM.fromList [(0,miniGun)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[InitGuard]]}
     , _crHP = 500
@@ -139,7 +138,6 @@ longCrit = basicCreature
     , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[InitGuard]]}
     , _crHP = 300
@@ -153,7 +151,6 @@ multGunCrit = basicCreature
     , _crInv = IM.fromList [(0,multGun),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[InitGuard]]}
     , _crHP = 300
@@ -167,7 +164,6 @@ launcherCrit = basicCreature
     , _crInv = IM.fromList [(0,launcher),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[Init]]}
     , _crHP = 300
@@ -181,7 +177,6 @@ spreadGunCrit = basicCreature
     , _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[Init]]}
     , _crHP = 300
@@ -195,7 +190,6 @@ pistolCrit = basicCreature
     , _crInv = IM.fromList [(0,pistol),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[InitGuard]]}
     , _crHP = 500
@@ -209,7 +203,6 @@ autoCrit = basicCreature
     , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crAmmo = M.fromList [(PistolBullet, 1000)]
     --, _crState = ShooterWait
     , _crState = basicState {_goals = [[InitGuard]]}
     , _crHP = 300
@@ -226,7 +219,6 @@ addArmour = over crInv insarmour
 --    , _crInv = IM.fromList [(0,ltAutoGun)]
 --    , _crInvSel = 0
 --    , _crRad = 10
---    , _crAmmo = M.fromList [(PistolBullet, 1000)]
 --    , _crState = basicState {_goals = [[InitGuard]]}
 --    , _crHP = 50
 --    }
@@ -370,7 +362,6 @@ startCr = basicCreature
                             ] 
                             ++ repeat NoItem)) 
                           -- startInv
-    , _crAmmo = M.fromList [(PistolBullet, 0),(LiquidFuel, 100),(Battery, 20000),(Shell,200)]
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
     }
 

src/Dodge/Data.hs

@@ -77,7 +77,6 @@ data World = World
                 , _pathGraph' :: ~[(Point2,Point2)]
                 , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
                 , _pathInc :: ~(M.Map Point2 [Point2])
-                , _unlimitedAmmo :: Bool
                 , _storedLevel :: Maybe World
                 , _menuState :: MenuState
                 , _worldState :: M.Map WorldState Bool
@@ -144,7 +143,6 @@ data Creature = Creature
                 , _crMaxHP :: Int
                 , _crInv :: IM.IntMap Item
                 , _crInvSel :: Int
-                , _crAmmo :: M.Map Ammo Int
                 , _crState :: CreatureState
                 , _crCorpse :: Drawing
                 }
@@ -270,7 +268,6 @@ data PressPlate = PressPlate { _ppPict :: Drawing
                              }
 
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
-               | FlAm { _flAm :: Ammo , _flItPos :: Point2 , _flAmNum :: Int , _flItID :: Int}
 
 data ItemPos =  InInv   { _itCrId :: Int
                         , _itInvId :: Int
@@ -282,7 +279,6 @@ data Item = Weapon
             { _itName :: String
             , _wpMaxAmmo :: Int
             , _wpLoadedAmmo :: Int
-            , _wpAmmoType :: Ammo
             , _wpReloadTime :: Int
             , _wpReloadState :: Int
             , _wpFireRate :: Int
@@ -597,9 +593,6 @@ data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
                      }
 data FFState = FFDestroyable { _ffsHP :: Int }
 
-data Ammo = PistolBullet | LiquidFuel | Battery | Shell
-    deriving (Eq,Ord,Enum)
-
 data SoundOrigin = InventorySound 
                  | BackgroundSound
                  | OnceSound

src/Dodge/Initialisation.hs

@@ -57,7 +57,6 @@ initialWorld = basicWorld
 --                , _loadedSounds = IM.empty
                 , _sounds = M.empty
                 , _decorations = IM.empty
-                , _unlimitedAmmo = True
                 , _storedLevel = Nothing
                 , _menuState = LevelMenu 1
                 , _worldState = M.empty

src/Dodge/Item/Weapon.hs

@@ -7,7 +7,7 @@ module Dodge.Item.Weapon
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
-import Dodge.CreatureActions
+import Dodge.CreatureAction
 import Dodge.RandomHelp
 import Dodge.WorldActions
 import Dodge.Debug
@@ -55,7 +55,6 @@ pistol = Weapon
     , _itIdentity = Pistol
     , _wpMaxAmmo = 15
     , _wpLoadedAmmo = 15
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _wpFireRate = 8
@@ -100,7 +99,6 @@ autoGun = defaultGun
     , _itIdentity = AutoGun
     , _wpMaxAmmo = 30
     , _wpLoadedAmmo = 30
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 6
@@ -164,7 +162,6 @@ rezGun = defaultGun
     { _itName = "REANIMATOR"
     , _wpMaxAmmo = 50
     , _wpLoadedAmmo = 50
-    , _wpAmmoType = Battery
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -189,7 +186,6 @@ teslaGun = defaultAutoGun
     , _itIdentity = TeslaGun
     , _wpMaxAmmo = 200
     , _wpLoadedAmmo = 200
-    , _wpAmmoType = Battery
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -215,7 +211,6 @@ lasGun = defaultAutoGun
     , _itIdentity = LasGun
     , _wpMaxAmmo = 200
     , _wpLoadedAmmo = 200
-    , _wpAmmoType = Battery
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -260,7 +255,6 @@ forceFieldGun = defaultGun
     , _itIdentity = ForceFieldGun
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
-    , _wpAmmoType = Battery
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _wpFireRate = 10
@@ -279,7 +273,6 @@ forceFieldGun = defaultGun
 --     , _itIdentity = GrapGun
 --     , _wpMaxAmmo = 1
 --     , _wpLoadedAmmo = 1
---     , _wpAmmoType = Battery
 --     , _wpReloadTime = 40
 --     , _wpReloadState = 0
 --     , _wpFireRate = 10
@@ -299,7 +292,6 @@ tractorGun = defaultAutoGun
     , _itIdentity = TractorGun
     , _wpMaxAmmo = 10000
     , _wpLoadedAmmo = 10000
-    , _wpAmmoType = Battery
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -319,7 +311,6 @@ launcher = defaultGun
     , _itIdentity = Launcher
     , _wpMaxAmmo = 30
     , _wpLoadedAmmo = 30
-    , _wpAmmoType = Shell
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 20
@@ -354,7 +345,6 @@ remoteLauncher = defaultGun
     , _itIdentity = RemoteLauncher
     , _wpMaxAmmo = 1
     , _wpLoadedAmmo = 1
-    , _wpAmmoType = Shell
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 10
@@ -375,7 +365,6 @@ hvAutoGun = defaultAutoGun
     , _itIdentity = HvAutoGun
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 200
     , _wpReloadState = 0
     , _wpFireRate = 25
@@ -402,7 +391,6 @@ ltAutoGun = defaultAutoGun
     , _itIdentity = LtAutoGun
     , _wpMaxAmmo = 25
     , _wpLoadedAmmo = 25
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 4
@@ -427,7 +415,6 @@ miniGun = defaultAutoGun
     , _itIdentity = MiniGun
     , _wpMaxAmmo = 150
     , _wpLoadedAmmo = 150
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 200
     , _wpReloadState = 0
     , _wpFireRate = 2
@@ -448,7 +435,6 @@ spreadGun = defaultGun
     , _itIdentity = SpreadGun
     , _wpMaxAmmo = 5
     , _wpLoadedAmmo = 5
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 20
@@ -472,7 +458,6 @@ spreadGun = defaultGun
 --     , _itIdentity = ShatterGun
 --     , _wpMaxAmmo = 50
 --     , _wpLoadedAmmo = 50
---     , _wpAmmoType = PistolBullet
 --     , _wpReloadTime = 80
 --     , _wpReloadState = 0
 --     , _wpFireRate = 40
@@ -492,7 +477,6 @@ multGun = defaultGun
     , _itIdentity = MultGun
     , _wpMaxAmmo = 2
     , _wpLoadedAmmo = 2
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 40
     , _wpReloadState = 0
     , _wpFireRate = 20
@@ -523,7 +507,6 @@ longGun = defaultGun
     , _itIdentity = LongGun
     , _wpMaxAmmo = 1
     , _wpLoadedAmmo = 1
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 80
     , _wpReloadState = 0
     , _wpFireRate = 100
@@ -564,7 +547,6 @@ poisonSprayer = defaultAutoGun
     , _itIdentity = PoisonSprayer
     , _wpMaxAmmo = 500
     , _wpLoadedAmmo = 500
-    , _wpAmmoType = LiquidFuel
     , _wpReloadTime = 100
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -586,7 +568,6 @@ flamer = defaultAutoGun
     , _itIdentity = Flamethrower
     , _wpMaxAmmo = 250
     , _wpLoadedAmmo = 250
-    , _wpAmmoType = LiquidFuel
     , _wpReloadTime = 100
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -610,7 +591,6 @@ blinkGun = defaultGun
     , _itIdentity = Blinker
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
-    , _wpAmmoType = Battery
     , _wpReloadTime = 20
     , _wpReloadState = 0
     , _wpFireRate = 0
@@ -1982,7 +1962,6 @@ radar = defaultGun
     , _itIdentity = Generic
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 200
     , _wpReloadState = 0
     , _wpFireRate = 120
@@ -2004,7 +1983,6 @@ sonar = defaultGun
     , _itIdentity = Generic
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
-    , _wpAmmoType = PistolBullet
     , _wpReloadTime = 200
     , _wpReloadState = 0
     , _wpFireRate = 120

src/Dodge/Item/Weapon/TriggerType.hs

@@ -2,7 +2,7 @@ module Dodge.Item.Weapon.TriggerType
     where
 import Dodge.Data
 import Dodge.SoundLogic
-import Dodge.CreatureActions (reloadWeapon)
+import Dodge.CreatureAction (reloadWeapon)
 import Dodge.WorldActions (muzFlareAt,lowLightAt,tLightAt)
 import Dodge.RandomHelp
 

src/Dodge/KeyEvents.hs

@@ -2,7 +2,7 @@ module Dodge.KeyEvents where
 -- imports {{{
 import Dodge.Data
 import Dodge.Base
-import Dodge.CreatureActions
+import Dodge.CreatureAction
 import Dodge.SoundLogic
 import Dodge.Inventory
 

src/Dodge/Prototypes.hs

@@ -60,7 +60,6 @@ basicCreature = Creature
     , _crMaxHP = 150
     , _crInv = IM.empty
     , _crInvSel = 0
-    , _crAmmo = M.empty
     , _crState = basicState
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
     }
@@ -208,7 +207,6 @@ basicWorld = World
     , _sounds = M.empty
     , _corpses = IM.empty
     , _decorations = IM.empty
-    , _unlimitedAmmo = True
     , _storedLevel = Nothing
     , _menuState = LevelMenu 1
     , _worldState = M.empty

src/Dodge/Rendering.hs

@@ -362,7 +362,6 @@ displayAmount n | n > 1 = "-x" ++show n
 rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
 
 drawItem :: FloorItem -> Drawing
-drawItem (FlAm {_flItPos = p}) = uncurry translate p $ onLayer FlItLayer $ rectangleSolid 5 5
 drawItem flIt = uncurry translate (_flItPos flIt) 
                     $ rotateDrawing (radToDeg $ _flItRot flIt)  (_itFloorPict (_flIt flIt))
 
@@ -415,9 +414,7 @@ drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
           t = rotate (0 - (_cameraRot w)) 
                 . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
                 . rotate (_cameraRot w)
-          nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
+          nameOfItem = _itName $ _flIt flIt
-                                    FlAm {_flAm = PistolBullet} -> "Bullets"
-                                    FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
           zoom = _cameraZoom w
 
 ringPict :: Drawing

src/Dodge/WorldActions/Bullet.hs

@@ -0,0 +1,137 @@
+module Dodge.WorldActions.Bullet
+    where
+import Dodge.Data
+import Dodge.Base
+
+import Dodge.WorldActions.ThingsHit
+
+import Picture
+import Geometry
+
+import Control.Lens
+
+import Data.Maybe
+import Data.List
+import Data.Function (on)
+import Data.Bifunctor
+import qualified Data.IntMap.Strict as IM
+
+mvBulletTrajectory :: (Int -> [Point2]) -> World -> Particle' -> (World, Maybe Particle')
+mvBulletTrajectory velF w bt
+    | t <= 0 = (w, Nothing)
+    | t < 4  = (w, Just $ set btPassThrough' Nothing
+                        $ set btTrail' (replicate numPs p ++ (p:ps) )
+                        $ set ptPict' (bulLineLen numPs col wth (replicate numPs p ++ (p:ps) ) )
+                        $ set btTimer' (t-1) 
+                        bt                      
+                )
+    | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
+        (_,Nothing)  -> (w, Just  $ set btPassThrough' Nothing
+                        $ set btVel' newVel -- this may be useful for hit effects
+                        $ set btTrail' (init (reverse newPs) ++ (p:ps))
+                        $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
+                        $ set btTimer' (t-1) bt                      
+                )
+        (mvPs,Just (hitp,thing)) 
+            -> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
+                   hitVel  = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) )
+               in  ( hiteff bt (hitp,thing) w
+               --in  ( w
+                   , Just  $ set btPassThrough' Nothing
+                           $ set btVel' hitVel -- this may be useful for hit effects
+                           $ set btTrail' (newMvPs ++ (p:ps))
+                           $ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) )
+                           $ set btTimer' 3 bt                      
+                   )
+  where mcr     = _btPassThrough' bt
+        col     = _btColor' bt
+        (p:ps)  = _btTrail' bt
+        hiteff  = _btHitEffect' bt
+        wth     = _btWidth' bt
+        t       = _btTimer' bt
+        newPs   = velF t
+        numPs   = (length $ newPs) - 1
+        firstThingHit :: [[(Point2,(Either3 Creature Wall ForceField))]] 
+                            -> ([Point2], Maybe (Point2,Either3 Creature Wall ForceField))
+        firstThingHit hitList = second last $ unzip $ zip newPs 
+                                $ takeUntil isJust 
+                                $ map listToMaybe hitList
+        newVel  = speed *.* ( last newPs -.- (last $ init newPs) )
+        speed   = sum . map magV $ zipWith (-.-) (init newPs) (tail newPs)
+
+
+thingsHitExceptCrCurve :: Maybe Int -> [Point2] -> World 
+                        -> [ [(Point2, (Either3 Creature Wall ForceField))]
+                           ]
+thingsHitExceptCrCurve mcid ps@(a:b:_) w 
+                            = zipWith (\x y -> thingsHitExceptCr mcid x y w) ps $ tail ps
+thingsHitExceptCrLine _ _ _ = []
+
+thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World 
+                        -> [(Point2, (Either3 Creature Wall ForceField))]
+thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
+thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
+    where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
+          crNotCid _ = True
+
+mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
+mvGenBullet' w bt 
+    | t <= 0 = (w, Nothing)
+    | t < 4  = (w, Just $ set btPassThrough' Nothing
+                        $ set btTrail' (p:p:ps)
+                        $ set ptPict' (bulLine col wth (p:p:ps))
+                        $ set btTimer' (t-1) bt                      
+                )
+    | otherwise = case thingsHitExceptCr mcr p (p +.+ vel) w of
+        []  -> (w, Just  $ set btPassThrough' Nothing
+                        $ set btTrail' (p +.+ vel :p:ps)
+                        $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
+                        $ set btTimer' (t-1) bt                      
+                )
+        ((hitp,thing):_) 
+            -> ( hiteff bt (hitp,thing) w
+               , Just   $ set btPassThrough' Nothing
+                        $ set btTrail' (hitp:p:ps)
+                        $ set ptPict' (bulLine col wth (hitp:p:ps))
+                        $ set btTimer' 3 bt                      
+                )
+  where mcr     = _btPassThrough' bt
+        col     = _btColor' bt
+        (p:ps)  = _btTrail' bt
+        vel     = _btVel' bt
+        hiteff  = _btHitEffect' bt
+        wth     = _btWidth' bt
+        t       = _btTimer' bt
+
+bulLineLen :: Int -> Color -> Float -> [Point2] -> Picture
+bulLineLen n c w ps = 
+    setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 3) ps) w
+
+bulLine c w = setLayer 1 . bulLinea c w
+
+bulLinea :: Color -> Float -> [Point2] -> Picture
+bulLinea _ _ [] = blank
+bulLinea _ _ (x:[]) = blank
+bulLinea col width (a:b:[]) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures $ reverse
+        [polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]
+bulLinea col width (a:b:c:[]) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures $ reverse
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]
+bulLinea col width (a:b:_:c:[]) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures $ reverse
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]
+bulLinea col width (a:b:_:_:c:_) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures $ reverse
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]

src/Dodge/WorldActions/Flash.hs

@@ -0,0 +1,80 @@
+module Dodge.WorldActions.Flash
+    where
+import Dodge.Data
+import Dodge.Base
+
+import Dodge.WorldActions.ThingsHit
+import Dodge.WorldActions.HelperParticle
+
+import Picture
+import Geometry
+
+import Control.Lens
+
+flareAt :: Color -> Point2 -> World -> World
+flareAt c p = flareAt' c 0.02 0.5 p
+
+flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
+flareAt' col alphax alphay p 
+    = -- over particles' ((:) (flashColAt col alphax p))
+      -- . 
+      lowLightColAt col alphay p
+
+lowLightColAt :: Color -> Float ->  Point2 -> World -> World
+lowLightColAt col alphay p w = foldr (lowLightColHit col alphay p) w ps
+    where ps = map ((+.+) p) $ nRaysRad 20 30
+
+lowLightColHit :: Color -> Float -> Point2 -> Point2 -> World -> World
+lowLightColHit col alphay a b w 
+    = case thingsHitLongLine a b w of
+        ((p, E3x2 wall):_) 
+            -> over particles' ((:) (wallGlareCol col alphay p wall)) w
+        ((p, E3x1 cr):_) 
+            -> over afterParticles' ((:) (crGlareCol col alphay p cr)) w
+        _  -> w
+
+flashColAt :: Color -> Float -> Point2 -> Particle'
+flashColAt col alphax (x,y) =
+    Particle' 
+        { _ptPict' = pictures $
+                         map (\i -> onLayerL [levLayer PtLayer] 
+                                    $ color (withAlpha alphax col) $ translate x y $ circleSolid i
+                         )
+                         [20,25,30,35,40,45,50]
+        , _ptUpdate' = ptTimer' 1
+        }
+
+wallGlareCol :: Color -> Float -> Point2 -> Wall -> Particle'
+wallGlareCol col alphay p wl = wallGlareWidth 10 5 col alphay p wl
+
+crGlareCol :: Color -> Float -> Point2 -> Creature -> Particle'
+crGlareCol col alphay p cr = crGlareWidth 5 col alphay p cr
+
+wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
+wallGlareWidth len wdth col alphay p wl = 
+    Particle'
+        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
+        , _ptUpdate' = ptTimer' 1
+        }
+    where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
+          x = len *.* ( normalizeV $ a -.- b)
+          (a:b:_) = _wlLine wl
+
+crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle'
+crGlareWidth wdth col alphay p cr =
+    Particle'
+        { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
+        , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
+                                              ,_ptUpdate' = ptTimer' 0
+                                              }
+                                )
+        }
+    where l x = uncurry translate x
+                $ rotate (-0.25*pi + argV (p -.- x))
+                $ color (withAlpha alphay col) 
+                $ thickArc 0 (pi/2) (_crRad cr) wdth
+          cp = _crPos cr
+          cid = _crID cr
+          upp cid' w' = case w' ^? creatures . ix cid . crPos of
+                            Just y -> l y 
+                            _      -> blank

src/Dodge/WorldActions/HelperParticle.hs

@@ -0,0 +1,8 @@
+module Dodge.WorldActions.HelperParticle
+    where
+
+import Dodge.Data
+
+ptTimer' :: Int -> World -> Particle' -> (World, Maybe Particle')
+ptTimer' 0 w pt = (w, Nothing)
+ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})

src/Dodge/WorldActions/ThingsHit.hs

@@ -0,0 +1,56 @@
+module Dodge.WorldActions.ThingsHit
+    where
+import Dodge.Data
+import Dodge.Base
+
+import Geometry
+
+import qualified Data.IntMap.Strict as IM
+import Data.List
+import Data.Maybe
+import Data.Function (on)
+
+thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World 
+                        -> [(Point2, (Either3 Creature Wall ForceField))]
+thingsHitExceptCrLongLine Nothing    sp ep = thingsHitLongLine sp ep
+thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
+    where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
+          crNotCid _ = True
+
+thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
+thingsHitLongLine sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+    where 
+          crs  = zip crPs (map E3x1 hitCrs)
+          hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
+                                        $ _creatures w
+                                      --   $ creaturesAlongLine sp ep w
+          crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
+
+          walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
+          hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
+          hitPoint wl = intersectSegSeg' sp ep (_wlLine wl !! 0) (_wlLine wl !! 1)
+
+          hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
+          ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
+
+thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
+thingsHit sp ep w = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+    where 
+          hitCrs   = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
+                                            $ _creatures w
+                                        --  $ creaturesAlongLine sp ep w
+                                        --  creaturesAlongLine doesn't always
+                                        --  hit crs
+          crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
+          crs   = zip crPs (map E3x1 hitCrs)
+
+          hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
+                                                                            , b<-[y-1,y,y+1]])
+          (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
+          f i m = case IM.lookup i m of Just val -> val
+                                        _        -> IM.empty
+          walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
+          hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
+          hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
+          ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
+

src/Geometry/Bezier.hs

@@ -0,0 +1,27 @@
+module Geometry.Bezier
+    where
+import Geometry.Data
+import Geometry.Vector
+
+type BQuad = (Point2,Point2,Point2)
+
+splitBezierquad :: BQuad -> Float -> (BQuad,BQuad)
+splitBezierquad (a,b,c) z
+    = ( ( a
+        , (z *.* b) -.- ((z-1) *.* a)
+        , (z**2 *.* c) +.+ ((z-1)**2 *.* a) -.- (2*z*(z-1) *.* b)
+        )
+      , ( (z**2 *.* c) +.+ ((z-1)**2 *.* a) -.- (2*z*(z-1) *.* b)
+        , (z *.* c) -.- ((z-1) *.* b)
+        , c
+        )
+      )
+
+bQuadToLine :: BQuad -> Int -> [Point2]
+bQuadToLine (a,_,c) 0 = [a,c]
+bQuadToLine x i = let (l,r) = splitBezierquad x 0.5
+                  in  bQuadToLine l (i-1) ++ bQuadToLine r (i-1)
+
+bQuadToF :: (Point2,Point2,Point2) -> Float -> Point2
+bQuadToF (c,b,a) t = t     *.* (t *.* a +.+ (1-t) *.* b) +.+
+                     (1-t) *.* (t *.* b +.+ (1-t) *.* c)

src/Geometry/Intersect.hs

@@ -0,0 +1,110 @@
+module Geometry.Intersect
+    where
+import Geometry.Data
+
+import Control.Applicative
+
+intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2]
+intersectSegBezquad = undefined
+
+intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+{-# INLINE intersectLineLine' #-}
+intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+    | den == 0 = Nothing
+    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    where 
+        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
+        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+
+intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+{-# INLINE intersectSegSeg' #-}
+intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+    | den == 0 = Nothing
+    | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
+        = Nothing
+    | den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den)
+        = Nothing
+    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    where 
+        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
+        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+
+intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+{-# INLINE intersectSegLineFrom' #-}
+intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+    | den == 0 = Nothing
+    | den > 0 && ( t' < 0 || u' < 0 || t' > den )
+        = Nothing
+    | den < 0 && ( t' > 0 || u' > 0 || t' < den )
+        = Nothing
+    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    where 
+        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
+        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+
+intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+{-# INLINE intersectSegLine' #-}
+intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+    | den == 0 = Nothing
+    | den > 0 && (t' < 0 || t' > den)
+        = Nothing
+    | den < 0 && (t' > 0 || t' < den)
+        = Nothing
+    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    where 
+        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
+        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+
+-- intersectSegSeg is sometimes broken-- the following fixes at least some of
+-- the cases
+-- it is, however, slow
+myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
+        Nothing    -> Nothing
+        Just (x,y) -> if inbetween x && inbetween' y 
+                        then Just (x,y)
+                        else Nothing
+    where inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) &&
+                         ((cx <= x && x <= dx) || (dx <= x && x <= cx))
+          inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) &&
+                         ((cy <= y && y <= dy) || (dy <= y && y <= cy))
+
+myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
+myIntersectLineLine a@(ax,ay) b c@(cx,cy) d
+    | linGrad a b == Nothing = fmap ((,) ax) $ axisInt (c *-* (ax,0)) (d *-* (ax,0))
+    | linGrad c d == Nothing = fmap ((,) cx) $ axisInt (a *-* (cx,0)) (b *-* (cx,0))
+    | otherwise              
+        = case linGrad a b ^-^ linGrad c d of
+            Just 0 -> Nothing
+            _      -> liftA2 (,) newx
+                                 ((linGrad a b ^*^ newx) ^+^ axisInt a b)
+    where (^-^) = liftA2 (-)
+          (^+^) = liftA2 (+)
+          (^/^) = liftA2 (/)
+          (^*^) = liftA2 (*)
+          newx  = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
+          (*-*) (ax,ay) (bx,by) = (ax-bx,ay-by)
+
+ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+ratIntersectLineLine a b c d = fmap toNumPoint2 $ myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
+    where toRatPoint2 (x,y) = (toRational x, toRational y)
+          toNumPoint2 (x,y) = (fromRational x, fromRational y)
+          f = toRatPoint2 . roundPoint2
+
+roundPoint2 :: Point2 -> Point2
+roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)
+
+linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
+linGrad (x,y) (a,b) | x-a == 0  = Nothing
+                    | otherwise = Just $ (y-b)/(x-a)
+
+axisInt :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
+axisInt p (a,b) =  pure b ^-^ (pure a ^*^ linGrad p (a,b))
+    where (^-^) = liftA2 (-)
+          (^*^) = liftA2 (*)
+
+
+intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
+intersectSegsSeg = undefined

src/Geometry/Vector.hs

@@ -0,0 +1,141 @@
+{-# LANGUAGE BangPatterns #-}
+module Geometry.Vector
+    where
+import Geometry.Data
+
+zeroZ :: Point2 -> Point3
+{-# INLINE zeroZ #-}
+zeroZ (x,y) = (x,y,0)
+
+infixl 6 +.+, -.-
+infixl 7 *.*
+
+(+.+) :: Point2 -> Point2 -> Point2
+{-# INLINE (+.+) #-}
+(x1, y1) +.+ (x2, y2) =
+  let
+    !x = x1 + x2
+    !y = y1 + y2
+  in (x, y)
+
+(-.-) :: Point2 -> Point2 -> Point2
+{-# INLINE (-.-) #-}
+(x1, y1) -.- (x2, y2) =
+  let
+    !x = x1 - x2
+    !y = y1 - y2
+  in (x, y)
+
+(*.*) :: Float -> Point2 -> Point2
+{-# INLINE (*.*) #-}
+a *.* (x2, y2) =
+  let
+    !x = a * x2
+    !y = a * y2
+  in (x, y)
+
+infixl 6 +.+.+, -.-.-
+infixl 7 *.*.*
+
+(+.+.+) :: Point3 -> Point3 -> Point3
+{-# INLINE (+.+.+) #-}
+(x1, y1, z1) +.+.+ (x2, y2, z2) =
+  let
+    !x = x1 + x2
+    !y = y1 + y2
+    !z = z1 + z2
+  in (x, y, z)
+
+(-.-.-) :: Point3 -> Point3 -> Point3
+{-# INLINE (-.-.-) #-}
+(x1, y1, z1) -.-.- (x2, y2, z2) =
+  let
+    !x = x1 - x2
+    !y = y1 - y2
+    !z = z1 - z2
+  in (x, y, z)
+
+(*.*.*) :: Point3 -> Point3 -> Point3
+{-# INLINE (*.*.*) #-}
+(x1, y1, z1) *.*.* (x2, y2, z2) =
+  let
+    !x = x1 * x2
+    !y = y1 * y2
+    !z = z1 * z2
+  in (x, y, z)
+
+normalizeV :: Point2 -> Point2
+{-# INLINE normalizeV #-}
+normalizeV p = (1 / magV p) *.* p
+
+angleVV :: Point2 -> Point2 -> Float
+{-# INLINE angleVV #-}
+angleVV a b = let ma = magV a
+                  mb = magV b
+                  d  = a `dotV` b
+              in  acos $ d / (ma * mb)
+
+dotV :: Point2 -> Point2 -> Float
+{-# INLINE dotV #-}
+dotV (x,y) (z,w) = x*z + y*w
+
+argV :: Point2 -> Float
+{-# INLINE argV #-}
+argV (x,y) = normalizeAngle $ atan2 y x
+
+detV :: Point2 -> Point2 -> Float
+{-# INLINE detV #-}
+detV (x1, y1) (x2, y2)
+       = x1 * y2 - y1 * x2
+
+-- | Angle in radians, anticlockwise from +ve x-axis.
+unitVectorAtAngle :: Float -> Point2
+{-# INLINE unitVectorAtAngle #-}
+unitVectorAtAngle r
+        = (cos r, sin r)
+
+-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
+rotateV :: Float -> Point2 -> Point2
+rotateV r (x, y)
+ =      (  x * cos r - y * sin r
+        ,  x * sin r + y * cos r)
+{-# INLINE rotateV #-}
+
+-- | Convert degrees to radians
+degToRad :: Float -> Float
+degToRad d      = d * pi / 180
+{-# INLINE degToRad #-}
+
+
+-- | Convert radians to degrees
+radToDeg :: Float -> Float
+radToDeg r      = r * 180 / pi
+{-# INLINE radToDeg #-}
+
+
+-- | Normalize an angle to be between 0 and 2*pi radians
+normalizeAngle :: Float -> Float
+normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))
+ where  floor' :: Float -> Float
+        floor' x = fromIntegral (floor x :: Int)
+{-# INLINE normalizeAngle #-}
+
+vNormal :: Point2 -> Point2
+{-# INLINE vNormal #-}
+vNormal (x,y) = (y,-x)
+
+vInverse :: Point2 -> Point2
+vInverse (x,y) = (-x,-y)
+
+normV :: Point2 -> Point2
+{-# INLINE normV #-}
+normV (0,0) = (0,0)
+normV p = (1/magV p ) *.* p
+
+magV :: Point2 -> Float
+{-# INLINE magV #-}
+magV (x,y) = sqrt $ x^2 + y^2
+
+crossV :: Point2 -> Point2 -> Float
+crossV (ax,ay) (bx,by) = ax*by - ay*bx
+