From ca5ff885221c249bd14290fef3ed6cf68a30f644 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 16 Mar 2021 11:54:41 +0100 Subject: [PATCH] Split UseItem module --- src/Dodge/AIs.hs | 2 +- .../{CreatureActions.hs => CreatureAction.hs} | 55 ++----- src/Dodge/CreatureAction/UseItem.hs | 35 +++++ src/Dodge/CreatureState.hs | 2 +- src/Dodge/Critters.hs | 9 -- src/Dodge/Data.hs | 7 - src/Dodge/Initialisation.hs | 1 - src/Dodge/Item/Weapon.hs | 24 +-- src/Dodge/Item/Weapon/TriggerType.hs | 2 +- src/Dodge/KeyEvents.hs | 2 +- src/Dodge/Prototypes.hs | 2 - src/Dodge/Rendering.hs | 5 +- src/Dodge/WorldActions/Bullet.hs | 137 +++++++++++++++++ src/Dodge/WorldActions/Flash.hs | 80 ++++++++++ src/Dodge/WorldActions/HelperParticle.hs | 8 + src/Dodge/WorldActions/ThingsHit.hs | 56 +++++++ src/Geometry/Bezier.hs | 27 ++++ src/Geometry/Intersect.hs | 110 ++++++++++++++ src/Geometry/Vector.hs | 141 ++++++++++++++++++ 19 files changed, 609 insertions(+), 96 deletions(-) rename src/Dodge/{CreatureActions.hs => CreatureAction.hs} (85%) create mode 100644 src/Dodge/CreatureAction/UseItem.hs create mode 100644 src/Dodge/WorldActions/Bullet.hs create mode 100644 src/Dodge/WorldActions/Flash.hs create mode 100644 src/Dodge/WorldActions/HelperParticle.hs create mode 100644 src/Dodge/WorldActions/ThingsHit.hs create mode 100644 src/Geometry/Bezier.hs create mode 100644 src/Geometry/Intersect.hs create mode 100644 src/Geometry/Vector.hs diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 09f813b14..68e5712a3 100644 --- a/src/Dodge/AIs.hs +++ b/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 diff --git a/src/Dodge/CreatureActions.hs b/src/Dodge/CreatureAction.hs similarity index 85% rename from src/Dodge/CreatureActions.hs rename to src/Dodge/CreatureAction.hs index 393b8a645..97d01aaaa 100644 --- a/src/Dodge/CreatureActions.hs +++ b/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 - else reloadWeaponAmmoCheck cid w - -reloadWeaponUnlimited :: Int -> World -> Maybe World -reloadWeaponUnlimited cid w = +reloadWeapon 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 diff --git a/src/Dodge/CreatureAction/UseItem.hs b/src/Dodge/CreatureAction/UseItem.hs new file mode 100644 index 000000000..aa4cc550d --- /dev/null +++ b/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 diff --git a/src/Dodge/CreatureState.hs b/src/Dodge/CreatureState.hs index 800472fce..375d70b0d 100644 --- a/src/Dodge/CreatureState.hs +++ b/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 diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs index d9701afc1..9282f1909 100644 --- a/src/Dodge/Critters.hs +++ b/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] } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7af80dcda..3ff6532ae 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index fc823cfd6..5b04bc77c 100644 --- a/src/Dodge/Initialisation.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 3670ea440..8b5f050f6 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 9370f8b37..f6804c074 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/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 diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index a5ead542d..cbead2409 100644 --- a/src/Dodge/KeyEvents.hs +++ b/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 diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index 046d35416..f4daf37a9 100644 --- a/src/Dodge/Prototypes.hs +++ b/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 diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 67d690b97..4f82bfbc2 100644 --- a/src/Dodge/Rendering.hs +++ b/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 - FlAm {_flAm = PistolBullet} -> "Bullets" - FlAm {_flAm = LiquidFuel} -> "Liquid Fuel" + nameOfItem = _itName $ _flIt flIt zoom = _cameraZoom w ringPict :: Drawing diff --git a/src/Dodge/WorldActions/Bullet.hs b/src/Dodge/WorldActions/Bullet.hs new file mode 100644 index 000000000..0da6ce057 --- /dev/null +++ b/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] + ] diff --git a/src/Dodge/WorldActions/Flash.hs b/src/Dodge/WorldActions/Flash.hs new file mode 100644 index 000000000..abaa79568 --- /dev/null +++ b/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 diff --git a/src/Dodge/WorldActions/HelperParticle.hs b/src/Dodge/WorldActions/HelperParticle.hs new file mode 100644 index 000000000..6e3885574 --- /dev/null +++ b/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)}) diff --git a/src/Dodge/WorldActions/ThingsHit.hs b/src/Dodge/WorldActions/ThingsHit.hs new file mode 100644 index 000000000..6acd53cac --- /dev/null +++ b/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 + diff --git a/src/Geometry/Bezier.hs b/src/Geometry/Bezier.hs new file mode 100644 index 000000000..55b727007 --- /dev/null +++ b/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) diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs new file mode 100644 index 000000000..adc5e44ce --- /dev/null +++ b/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 diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs new file mode 100644 index 000000000..26a6d1803 --- /dev/null +++ b/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 +