Stun turret turn with electrical damage

src/Dodge/Creature/Impulse.hs

@@ -6,7 +6,6 @@ import Dodge.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
-import Dodge.Data.DamageType
 --import Dodge.Creature.Action.UseItem
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data

src/Dodge/Data.hs

@@ -8,7 +8,9 @@ circular imports are probably not a good idea.
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data 
-    where
+    ( module Dodge.Data
+    , module Dodge.Data.DamageType
+    ) where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
@@ -563,7 +565,14 @@ data Machine = Machine
     , _mcSensor  :: Int
     , _mcDamage  :: [DamageType]
     , _mcLSs     :: [Int]
+    , _mcType    :: MachineType
     }
+data MachineType 
+    = StaticMachine
+    | Turret
+        { _tuWeapon     :: Item
+        , _tuTurnSpeed  :: Float
+        }
 data Door = Door
     { _drID :: Int
     , _drWallIDs :: IS.IntSet
@@ -788,5 +797,6 @@ makeLenses ''Intention
 makeLenses ''Door
 makeLenses ''Block
 makeLenses ''Machine
+makeLenses ''MachineType
 makeLenses ''Zone
 makeLenses ''ItemDimension

src/Dodge/Data/DamageType.hs

@@ -31,4 +31,8 @@ data DamageType
     | PoisonDam {_dmAmount :: Int}
   deriving (Eq,Ord,Show)
 
+isElectrical :: DamageType -> Bool
+isElectrical Electrical {} = True
+isElectrical _ = False
+
 makeLenses ''DamageType

src/Dodge/Data/SoundOrigin.hs

@@ -5,6 +5,7 @@ data SoundOrigin = InventorySound
     | OnceSound
     | CrSound Int
     | CrWeaponSound Int Int
+    | MachineSound Int
     | WallSound Int
     | CrReloadSound Int
     | Flamer

src/Dodge/Default.hs

@@ -7,7 +7,6 @@ This module contains prototypical data structures.
 module Dodge.Default where
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Data.SoundOrigin
 import Dodge.Item.Data
 import Dodge.Creature.Stance.Data
@@ -222,6 +221,7 @@ defaultMachine = Machine
     , _mcSensor = 0
     , _mcDamage = []
     , _mcLSs = []
+    , _mcType = StaticMachine
     }
 defaultMachineUpdate :: Machine -> World -> World
 defaultMachineUpdate mc

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -26,7 +26,7 @@ withVelWthHiteff
     :: Point2       -- ^ Velocity, x direction is forward with respect to the creature
     -> Float        -- ^ Bullet width
     -> HitEffect    -- ^ Bullet effect when hitting creature, wall etc
-    -> Creature          -- ^ Creature id
+    -> Creature
     -> World 
     -> World
 withVelWthHiteff vel width hiteff cr = over particles (newbul : ) 

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -2,12 +2,12 @@ module Dodge.Item.Weapon.BatteryGuns
     ( lasGun
     , teslaGun
     , tractorGun
+    , makeLaserAt
     )
     where
 import Dodge.Data
 import Dodge.Particle.TeslaArc
 import Dodge.SoundLogic.LoadSound
-import Dodge.Data.DamageType
 import Dodge.WorldEvent
 import Dodge.WorldEvent.Damage
 import Dodge.Default

src/Dodge/Machine/Sensor.hs

@@ -1,55 +0,0 @@
-module Dodge.Machine.Sensor
-    ( lightSensor
-    ) where
-import Color
-import Dodge.Data
-import Dodge.LevelGen.Data
-import Dodge.Default
-import Dodge.Data.DamageType
-import Geometry
-import ShapePicture
-import Shape
-
-import Control.Lens
-import Data.Either
-
-damageSensor 
-    :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
-    -> Point2 -> Float -> Placement
-damageSensor damF p r = Placement (PS p r) ( PutLS theLS)
-    $ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine
-        { _mcDraw = sensorSPic 
-        , _mcUpdate = sensorUpdate damF
-        , _mcLSs = [lsid]
-        }
-  where
-    theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
-
-lightSensor :: Point2 -> Float -> Placement
-lightSensor = damageSensor senseLasering
-
-senseLasering :: DamageType -> Either Int Int
-senseLasering Lasering {_dmAmount = x} = Left x
-senseLasering _ = Right 0
-
-sensorUpdate :: (DamageType -> Either Int Int) -> Machine -> World -> World
-sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
-    & lightSources . ix lsid %~ upls
-  where
-    upmc = ( mcSensor %~ \x' -> min 750 (max 0 (x' - 5 + newSense)) )
-        . ( mcHP -~ sum dam )
-        . (mcDamage .~ [])
-    x = _mcSensor mc
-    mcid = _mcID mc
-    lsid = head (_mcLSs mc)
-    (senseData,dam) = partitionEithers $ map damF $ _mcDamage mc
-    newSense = sum senseData
-    ni = fromIntegral x / 500
-    upls = lsIntensity .~ V3 ni ni ni
-
-sensorSPic :: Machine -> SPic
-sensorSPic _ = ( colorSH blue $ upperPrismPoly 25 (square wdth)
-    , mempty )
-
-wdth :: Float
-wdth = 5

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -5,7 +5,6 @@ module Dodge.Particle.Bullet.HitEffect
     where
 import Dodge.Data
 import Dodge.Particle.Spark
-import Dodge.Data.DamageType
 import Dodge.Data.SoundOrigin
 import Dodge.Wall.Damage
 import Dodge.WorldEvent

src/Dodge/Particle/Spark.hs

@@ -4,7 +4,6 @@ module Dodge.Particle.Spark
     )
     where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Dodge.WorldEvent.HitEffect

src/Dodge/Particle/TeslaArc.hs

@@ -2,7 +2,6 @@ module Dodge.Particle.TeslaArc
     ( makeTeslaArcAt
     ) where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Dodge.WorldEvent.Damage
 import Dodge.Base

src/Dodge/Placements.hs

@@ -3,9 +3,13 @@ module Dodge.Placements
     , module Dodge.Placements.LightSource
     , module Dodge.Placements.Wall
     , module Dodge.Placements.Button
+    , module Dodge.Placements.Turret
+    , module Dodge.Placements.Sensor
     )
     where
 import Dodge.Placements.Door
 import Dodge.Placements.LightSource
 import Dodge.Placements.Wall
 import Dodge.Placements.Button
+import Dodge.Placements.Turret
+import Dodge.Placements.Sensor

src/Dodge/Placements/Button.hs

@@ -13,7 +13,7 @@ import Dodge.Placements.Spot
 import Control.Lens
 
 putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
-putLitButtonID col p a subpl = mountLightAID ls p'' (addZ 40 p')
+putLitButtonID col p a subpl = mountLightAID (Just col) ls p'' (addZ 40 p')
     $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
     subpl
   where
@@ -23,7 +23,8 @@ putLitButtonID col p a subpl = mountLightAID ls p'' (addZ 40 p')
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
 
 putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement
-putLitButtonID' col f subpl = updatePSToLevel 3 (const thePS) $ mountLightAID ls 0 (V3 0 (-40) 40)
+putLitButtonID' col f subpl 
+    = updatePSToLevel 3 (const thePS) $ mountLightAID (Just col) ls 0 (V3 0 (-40) 40)
     $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
     subpl
   where

src/Dodge/Placements/LightSource.hs

@@ -10,28 +10,35 @@ import Dodge.Creature.Inanimate
 import Shape.Data
 import Dodge.Default
 import Dodge.RandomHelp 
+import Color
+import Shape
 
 mountLightOnShape
     :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
+    -> Maybe Color  -- ^ describing a possible color override for the shape
     -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
-mountLightOnShape shapeF ls wallp lsp = ps0j (PutForeground $ shapeF wallp lsp)
+mountLightOnShape shapeF mcol ls wallp lsp = ps0j (PutForeground . setCol $ shapeF wallp lsp)
     . ps0 (PutLS $ ls {_lsPos = lsp})
+  where
+    setCol = case mcol of
+        Just col -> colorSH col
+        Nothing  -> id
 
-mountLightID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightID = mountLightOnShape f 
   where
     f wp (V3 x y z) = thinHighBar (z+5) wp pout
       where
         pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wp)
 
-redMID :: (LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
+redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
     -> Point2 -> Point3 -> Placement
-redMID f wallp lampp = f defaultLS wallp lampp (const Nothing)
+redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)
 
 mountLight :: Point2 -> Point3 -> Placement
 mountLight = redMID mountLightID
 
-mountLightLID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightLID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightLID = mountLightOnShape f
   where
     f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
@@ -44,7 +51,7 @@ mountLightLID = mountLightOnShape f
 mountLightL :: Point2 -> Point3 -> Placement
 mountLightL = redMID mountLightLID
 
-mountLightJID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightJID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightJID = mountLightOnShape f
   where
     f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp turn1
@@ -61,7 +68,7 @@ mountLightJID = mountLightOnShape f
 mountLightJ :: Point2 -> Point3 -> Placement
 mountLightJ = redMID mountLightJID
 
-mountLightlID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightlID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightlID = mountLightOnShape f
   where
     f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
@@ -74,7 +81,7 @@ mountLightlID = mountLightOnShape f
 mountLightll :: Point2 -> Point3 -> Placement
 mountLightll = redMID mountLightlID
 
-mountLightAID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightAID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightAID = mountLightOnShape f
   where
     f wallpos (V3 x y z) = girder (z+10) 20 10 pout wallpos
@@ -97,7 +104,7 @@ mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20)
 mntLightCond :: ((Point2,Float) -> Bool) -> Placement
 mntLightCond f = RandomPlacement $ takeOne [mountLightVCond f,mountLightACond f]
 
-mountLightVID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
+mountLightVID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
 mountLightVID = mountLightOnShape f
   where
     f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)

src/Dodge/RandomHelp.hs

@@ -1,10 +1,7 @@
-{-
+{- Helpers for random generation.  -}
-Helpers for random generation.
--}
 module Dodge.RandomHelp where
 import Geometry
 import Geometry.Vector3D
---import Geometry.Data
 
 import System.Random
 import Control.Monad.State
@@ -20,8 +17,7 @@ takeOne :: RandomGen g => [a] -> State g a
 takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i))
 
 takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a
-takeOneWeighted ws xs = state (randomR (0, sum ws))
+takeOneWeighted ws xs = state (randomR (0, sum ws)) >>= (\w -> return (xs !! i w ws))
-    >>= (\w -> return (xs !! i w ws))
   where 
     i y (z:zs) 
         | y <= z = 0
@@ -45,8 +41,7 @@ takeN i xs = fst <$> takeNMore i ([],xs)
 -- | Randomly shuffle a list.
 shuffle :: RandomGen g => [a] -> State g [a]
 shuffle xs = do 
-    let l = length xs
+    rands <- forM [0..length xs-1] $ \i -> state $ randomR (0,i)
-    rands <- forM [0..l-1] $ \i -> state $ randomR (0,i)
     let f ys rand = let (as,b:bs) = splitAt rand ys
                     in  (as ++ bs, b)
     let (_,zs) = mapAccumR f xs rands
@@ -65,9 +60,10 @@ randProb p = do p1 <- state $ randomR (0,1)
                 return (p1 < p)
 
 randInCirc :: RandomGen g => Float -> State g Point2
-randInCirc maxRad = do rad <- state $ randomR (0,maxRad)
+randInCirc maxRad = do 
-                       ang <- state $ randomR (0,2*pi)
+    rad <- state $ randomR (0,maxRad)
-                       return $ rad *.* unitVectorAtAngle ang
+    ang <- state $ randomR (0,2*pi)
+    return $ rad *.* unitVectorAtAngle ang
 
 randOnUnitSphere :: RandomGen g => State g Point3
 randOnUnitSphere = do
@@ -90,9 +86,10 @@ randInHemisphere = do
     return $ r *.*.* p
 
 randInRect :: RandomGen g => Float -> Float -> State g Point2
-randInRect w h = do x <- state $ randomR (0,w)
+randInRect w h = do     
-                    y <- state $ randomR (0,h)
+    x <- state $ randomR (0,w)
-                    return (V2 x y)
+    y <- state $ randomR (0,h)
+    return (V2 x y)
 
 maybeTakeOne :: RandomGen g => [a] -> State g (Maybe a)
 maybeTakeOne [] = return Nothing

src/Dodge/Render.hs

@@ -235,6 +235,9 @@ doDrawing pdata w = do
             activeTexture $= TextureUnit 1
             zipWithM_ (>>) bindings $ map bindDrawDist rds
             activeTexture $= TextureUnit 0
+    depthFunc $= Just Always
+    blend $= Enabled
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     renderLayer 5 shadV layerCounts
     -- draw overlay
     depthFunc $= Just Always

src/Dodge/Room/Start.hs

@@ -9,7 +9,6 @@ import Dodge.Room.Furniture
 import Dodge.Placements
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.LevelGen.Data
-import Dodge.Machine.Sensor
 import Geometry.Data
 import Color
 import Shape
@@ -38,6 +37,7 @@ startRoom = do
             , tankSquare (dim orange) 50 50
             , tankSquare (dim orange) 50 120
             , lightSensor (V2 (0.8*w) (0.25*h)) 0
+            , putLasTurret & placementSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
             , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]
             )

src/Dodge/Wall/Damage.hs

@@ -6,7 +6,6 @@ module Dodge.Wall.Damage
     , damageWall
     ) where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.WorldEvent.Cloud
 import Dodge.Wall.Reflect
 import Dodge.Particle.Spark

src/Dodge/WorldEvent.hs

@@ -19,7 +19,6 @@ import Dodge.WorldEvent.SpawnParticle
 import Dodge.LightSources.Lamp
 import Dodge.Creature.State.Data
 import Dodge.Data
-import Dodge.Data.DamageType
 import Geometry
 import Color
 

src/Dodge/WorldEvent/Damage.hs

@@ -2,7 +2,6 @@ module Dodge.WorldEvent.Damage
     ( damThingHitWith
     ) where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Geometry
 import Dodge.Wall.Damage

src/Dodge/WorldEvent/Explosion.hs

@@ -72,10 +72,7 @@ makeFlameExplosionAt p w
     -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
     -- particle passes through for the first frame of its existence
 
-makeExplosionAt 
+makeExplosionAt :: Point2 -> World -> World
-    :: Point2   -- ^ Position
-    -> World 
-    -> World
 makeExplosionAt p w 
     = soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
     . addFlames 

src/Dodge/WorldEvent/HitEffect.hs

@@ -5,7 +5,6 @@ module Dodge.WorldEvent.HitEffect
     , penWalls
     ) where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Geometry
 

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,7 +4,6 @@ module Dodge.WorldEvent.Shockwave
     )
   where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Creature.State.Data
 import Dodge.Wall.Damage
 import Dodge.Base

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -7,7 +7,6 @@ module Dodge.WorldEvent.SpawnParticle
     , makeFlameletTimed
     ) where
 import Dodge.Data
-import Dodge.Data.DamageType
 import Dodge.Data.SoundOrigin
 import Dodge.Creature.State.Data
 --import Dodge.WorldEvent.Damage