Modularise triggers for weapons

src/Dodge/Item/Weapon.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
-module Dodge.Item.Weapon where
+module Dodge.Item.Weapon 
+    ( module Dodge.Item.Weapon
+    )
+    where
 -- imports {{{
 import Dodge.Data
 import Dodge.Base
@@ -15,6 +18,7 @@ import Dodge.Item.Draw
 
 import Dodge.Item.Weapon.Bullet
 import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.TriggerType
 
 import Geometry
 import Picture
@@ -607,86 +611,6 @@ blinkGun = defaultGun
     , _itAimingRange = 0
     }
 
-withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
-withWarmUp t f cid w 
-            | reloadCondition = fromMaybe w $ reloadWeapon cid w
-            | _wpReloadState item /= 0 = w
-            | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) 
-                                            $ set (pointerToItem . wpFireState) 2 
-                                                w
-            | t > 1  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
-                                            $ set (pointerToItem . wpFireState) 2
-                                            $ soundFrom (CrWeaponSound cid) 26 1 0
-                                                w 
-            | t > 0  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
-                                            $ set (pointerToItem . wpFireState) 2
-                                                w
-          --  | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
-            | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
-                                            $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                                            $ set (pointerToItem . wpFireState) 2
-                                            $ f cid
-                                            $ continueSoundFrom (CrWeaponSound cid) 28 2 0
-                                                w
-    where cr = _creatures w IM.! cid
-          itRef = _crInvSel cr
-          item = _crInv cr IM.! itRef
-          pointerToItem = creatures . ix cid . crInv . ix itRef
-          fState = _wpFireState item
-          fRate = _wpFireRate item
-          reloadCondition = _wpLoadedAmmo item == 0
---          rotC = case cid of 0 -> fst $ randomR (-0.03,0.03) (_randGen w)
---                             _ -> 0
-
-withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
-withSound soundid f cid = soundOnce soundid . f cid
-
-withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
-withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
-    where pushback cr = over crPos 
---    where pushback cr = colCrWall w $ over crPos 
-                             (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
-                             cr
-withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
-withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
-    where push cr = over crPos 
-                             (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
-                             cr
-          (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
-          
-          
-
-shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
-shootWithSound soundid f cid w
-              | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                                    $ soundOnce soundid
-                                    $ set (pointerToItem . wpFireState) (_wpFireRate item)
-                                    $ f cid w
-              | reloadCondition = fromMaybe w $ reloadWeapon cid w
-              | otherwise = w
-    where cr  = (_creatures w IM.! cid)
-          itRef = _crInvSel cr
-          item = _crInv cr IM.! itRef
-          pointerToItem = creatures . ix cid . crInv . ix itRef
-          fireCondition = _wpReloadState item == 0
-                            && _wpFireState item == 0
-                            && _wpLoadedAmmo item > 0
-          reloadCondition = _wpLoadedAmmo item == 0
-
-shoot :: (Int -> World -> World) -> Int -> World -> World
-shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
-                                    $ set (pointerToItem . wpFireState) (_wpFireRate item)
-                                    $ f cid w
-              | reloadCondition = fromMaybe w $ reloadWeapon cid w
-              | otherwise = w
-    where cr  = (_creatures w IM.! cid)
-          itRef = _crInvSel cr
-          item = _crInv cr IM.! itRef
-          pointerToItem = creatures . ix cid . crInv . ix itRef
-          fireCondition = _wpReloadState item == 0
-                            && _wpFireState item == 0
-                            && _wpLoadedAmmo item > 0
-          reloadCondition = _wpLoadedAmmo item == 0
 
 aTeslaArc :: Int -> World -> World
 aTeslaArc cid w = aTeslaArc' cid 
@@ -856,39 +780,6 @@ tractorBeamAt colID i pos dir = Particle
     where d  = unitVectorAtAngle dir
           p' = pos +.+ 400 *.* d
 
-spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
-spreadNumVelWthHiteff' spread num vel wth eff cid w 
-    = over particles' (newbuls ++)
-        $ flip (foldr muzFlareAt) poss
-        w
-    where cr = _creatures w IM.! cid
-          newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) 
-                                                    pos (rotateV d vel) eff wth
-                            ) poss dirs colids
-          pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
-          poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
-                    $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
-          dirs = map ((+) (_crDir cr)) 
-                    $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
-                                  $ randomRs (0,spreadGunSpread/5) (_randGen w)
-          colids = take num $ randomRs (0,11) (_randGen w)
-
-numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
-numVelWthHitEff'  num vel wth eff cid w 
-    = over particles' (newbuls ++)
-        $ flip (foldr muzFlareAt) (take num poss)
-        w
-    where cr = _creatures w IM.! cid
-          newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) 
-                                                      pos (rotateV d vel) eff wth) 
-                            poss colids
-          d = _crDir cr
-          poss = map (\o -> o +.+ pos) offsets
-          maxOffset = fromIntegral num * 2.5 - 2.5
-          offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
-          colids = take num $ randomRs (0,11) (_randGen w)
-          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
-          pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
 
 aGasCloud :: Int -> World -> World
 aGasCloud cid w
@@ -1060,59 +951,6 @@ flamerAngle = 0.3
 aSelf :: Int -> World -> World
 aSelf = blinkAction
 
-withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
-withAccVelWthHiteff' acc vel width hiteff cid w 
-    = over particles' ((:) newbul)
-        . over tempLightSources ((:) (tLightAt 4 pos))
-        . lowLightAt pos2
-        $ set randGen g
-        w
-    where cr = _creatures w IM.! cid
-          newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
-          (colid, g) = randomR (0,11) $ _randGen w
-          (a, _) = randomR (-acc,acc) $ _randGen w
-          dir = _crDir cr + a
-          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
-          pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
-
-withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
-withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w 
-    = over particles' ((:) newbul )
-        $ muzFlareAt pos
-        $ set randGen g
-        w
-    where cr = _creatures w IM.! cid
-          newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
-          (colid, g) = randomR (0,11) $ _randGen w
-          (a, _) = randomR (-acc,acc) $ _randGen w
-          dir = _crDir cr + a
-          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset
-          (offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w
-          offset = rotateV (_crDir cr) (0,offsetVal)
-
-torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World
-torqueBeforeForced torque feff cid w 
-    | cid == 0  = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') 
-                                           $ over cameraRot (+rot') w
-    | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
-    where (rot, g) = randomR (-torque,torque) $ _randGen w
-          rot' | rot < 0   = rot - 0.1
-               | otherwise = rot + 0.1
-
-torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World
-torqueBefore torque feff cid w 
-    | cid == 0  = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) 
-                                           $ over cameraRot (+rot) w
-    | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
-    where (rot, g) = randomR (-torque,torque) $ _randGen w
-
-torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World
-torqueAfter torque feff cid w 
-    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w
-    | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w
-    where (rot, g) = randomR (-torque,torque) $ _randGen w
-          rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopePos %~ rotateV rot 
 
 
 
@@ -1879,14 +1717,6 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
           g (E3x1 cr1) = dist p $ _crPos cr1
           (arcLen,_) = randomR (25,50) $ _randGen w
 
-thingHit' :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,c) -> Maybe (Either (Point2,a) (Point2,c))
-thingHit' p Nothing Nothing = Nothing
-thingHit' p (Just x) Nothing = Just (Left x)
-thingHit' p Nothing (Just x) = Just (Right x)
-thingHit' p (Just x@(p1,_)) (Just y@(p2,_))
-    | magV (p -.- p1) > magV (p -.- p2) = Just (Right y)
-    | otherwise = Just (Left x)
-
 spreadGunSpread,autogunSpread :: Float
 spreadGunSpread = 0.5
 autogunSpread = 0.07

src/Dodge/Item/Weapon/TriggerType.hs

@@ -0,0 +1,187 @@
+module Dodge.Item.Weapon.TriggerType
+    where
+import Dodge.Data
+import Dodge.SoundLogic
+import Dodge.CreatureActions (reloadWeapon)
+import Dodge.WorldActions (muzFlareAt,lowLightAt,tLightAt)
+import Dodge.RandomHelp
+
+import Dodge.Item.Weapon.Bullet
+
+import Geometry
+
+import System.Random
+
+import Control.Lens
+import Control.Monad.State
+
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+
+withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
+withWarmUp t f cid w 
+            | reloadCondition = fromMaybe w $ reloadWeapon cid w
+            | _wpReloadState item /= 0 = w
+            | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) 
+                                            $ set (pointerToItem . wpFireState) 2 
+                                                w
+            | t > 1  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
+                                            $ set (pointerToItem . wpFireState) 2
+                                            $ soundFrom (CrWeaponSound cid) 26 1 0
+                                                w 
+            | t > 0  = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
+                                            $ set (pointerToItem . wpFireState) 2
+                                                w
+          --  | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f)
+            | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f)
+                                            $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+                                            $ set (pointerToItem . wpFireState) 2
+                                            $ f cid
+                                            $ continueSoundFrom (CrWeaponSound cid) 28 2 0
+                                                w
+    where cr = _creatures w IM.! cid
+          itRef = _crInvSel cr
+          item = _crInv cr IM.! itRef
+          pointerToItem = creatures . ix cid . crInv . ix itRef
+          fState = _wpFireState item
+          fRate = _wpFireRate item
+          reloadCondition = _wpLoadedAmmo item == 0
+
+withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
+withSound soundid f cid = soundOnce soundid . f cid
+
+withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
+withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
+    where pushback cr = over crPos 
+--    where pushback cr = colCrWall w $ over crPos 
+                             (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0))
+                             cr
+withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World
+withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w
+    where push cr = over crPos 
+                             (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr))
+                             cr
+          (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
+          
+          
+
+shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World
+shootWithSound soundid f cid w
+              | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+                                    $ soundOnce soundid
+                                    $ set (pointerToItem . wpFireState) (_wpFireRate item)
+                                    $ f cid w
+              | reloadCondition = fromMaybe w $ reloadWeapon cid w
+              | otherwise = w
+    where cr  = (_creatures w IM.! cid)
+          itRef = _crInvSel cr
+          item = _crInv cr IM.! itRef
+          pointerToItem = creatures . ix cid . crInv . ix itRef
+          fireCondition = _wpReloadState item == 0
+                            && _wpFireState item == 0
+                            && _wpLoadedAmmo item > 0
+          reloadCondition = _wpLoadedAmmo item == 0
+
+shoot :: (Int -> World -> World) -> Int -> World -> World
+shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+                                    $ set (pointerToItem . wpFireState) (_wpFireRate item)
+                                    $ f cid w
+              | reloadCondition = fromMaybe w $ reloadWeapon cid w
+              | otherwise = w
+    where cr  = (_creatures w IM.! cid)
+          itRef = _crInvSel cr
+          item = _crInv cr IM.! itRef
+          pointerToItem = creatures . ix cid . crInv . ix itRef
+          fireCondition = _wpReloadState item == 0
+                            && _wpFireState item == 0
+                            && _wpLoadedAmmo item > 0
+          reloadCondition = _wpLoadedAmmo item == 0
+
+withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
+withAccVelWthHiteff' acc vel width hiteff cid w 
+    = over particles' ((:) newbul)
+        . over tempLightSources ((:) (tLightAt 4 pos))
+        . lowLightAt pos2
+        $ set randGen g
+        w
+    where cr = _creatures w IM.! cid
+          newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
+          (colid, g) = randomR (0,11) $ _randGen w
+          (a, _) = randomR (-acc,acc) $ _randGen w
+          dir = _crDir cr + a
+          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+          pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+
+withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World
+withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w 
+    = over particles' ((:) newbul )
+        $ muzFlareAt pos
+        $ set randGen g
+        w
+    where cr = _creatures w IM.! cid
+          newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
+          (colid, g) = randomR (0,11) $ _randGen w
+          (a, _) = randomR (-acc,acc) $ _randGen w
+          dir = _crDir cr + a
+          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset
+          (offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w
+          offset = rotateV (_crDir cr) (0,offsetVal)
+
+torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World
+torqueBeforeForced torque feff cid w 
+    | cid == 0  = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') 
+                                           $ over cameraRot (+rot') w
+    | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
+    where (rot, g) = randomR (-torque,torque) $ _randGen w
+          rot' | rot < 0   = rot - 0.1
+               | otherwise = rot + 0.1
+
+torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World
+torqueBefore torque feff cid w 
+    | cid == 0  = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) 
+                                           $ over cameraRot (+rot) w
+    | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
+    where (rot, g) = randomR (-torque,torque) $ _randGen w
+
+torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World
+torqueAfter torque feff cid w 
+    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w
+    | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w
+    where (rot, g) = randomR (-torque,torque) $ _randGen w
+          rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
+                                . itAttachment . _Just . scopePos %~ rotateV rot 
+
+spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
+spreadNumVelWthHiteff' spread num vel wth eff cid w 
+    = over particles' (newbuls ++)
+        $ flip (foldr muzFlareAt) poss
+        w
+    where cr = _creatures w IM.! cid
+          newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) 
+                                                    pos (rotateV d vel) eff wth
+                            ) poss dirs colids
+          pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+          poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
+                    $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w
+          dirs = map ((+) (_crDir cr)) 
+                    $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..]
+                                  $ randomRs (0,spread/5) (_randGen w)
+                                 -- $ randomRs (0,spreadGunSpread/5) (_randGen w)
+          colids = take num $ randomRs (0,11) (_randGen w)
+
+numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World
+numVelWthHitEff'  num vel wth eff cid w 
+    = over particles' (newbuls ++)
+        $ flip (foldr muzFlareAt) (take num poss)
+        w
+    where cr = _creatures w IM.! cid
+          newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) 
+                                                      pos (rotateV d vel) eff wth) 
+                            poss colids
+          d = _crDir cr
+          poss = map (\o -> o +.+ pos) offsets
+          maxOffset = fromIntegral num * 2.5 - 2.5
+          offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..]
+          colids = take num $ randomRs (0,11) (_randGen w)
+          pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
+          pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)

src/Dodge/Rooms.hs

@@ -206,7 +206,7 @@ door = Room
     , _rmLinks = lnks
     , _rmPath  = [((20,35),(20,5))]
 -- door extends into side walls (for shadows as rendered 12/03)
-    , _rmPS    = [PS (0,20) 0 $ PutAutoDoor (-10,0) (50,0)]
+    , _rmPS    = [PS (0,20) 0 $ PutAutoDoor (-20,0) (60,0)]
     , _rmBound = [] 
     }
     where lnks = [((20,35),0)