Modularise item data, change tesla arc from projectile to particle

shader/background.frag

@@ -6,5 +6,6 @@ uniform sampler2D aTexture;
 
 void main()
 {
+//    fColor = vec4 (1,1,0,1);
     fColor = texture(aTexture, gTexPos);
 }

src/Dodge/Creature.hs

@@ -158,6 +158,7 @@ startInventory :: IM.IntMap Item
 startInventory = IM.fromList (zip [0..20] 
     (
     [hvAutoGun
+    ,teslaGun
     ,blinkGun
     ,miniGun
     ,bezierGun

src/Dodge/Creature/Action/Movement.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.Action.Movement
     where
 import Dodge.Data
 import Dodge.Creature.Stance.Data
+import Dodge.Item.Data
 import Geometry
 
 import Data.Maybe

src/Dodge/Creature/Picture.hs

@@ -24,7 +24,7 @@ basicCrPict
     -> Picture
 basicCrPict col cr w = pictures $
     targetingPic ++
-    [ tr . onLayer CrLayer . piercingMod $ bluntScale naked 
+    [ tr . onLayer CrLayer . piercingMod $ bluntScale $ naked 
 --    , drawAwakeLevel cr
     , tr $ drawEquipment cr
     ]
@@ -37,7 +37,11 @@ basicCrPict col cr w = pictures $
         | strikeMelee   = color white $ circleSolid $ _crRad cr
         | pdam > 200    = color red $ circleSolid $ _crRad cr
         | pdam > 99     = color white $ circleSolid $ _crRad cr
-        | otherwise     = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
+        | otherwise     = pictures 
+            [ translate (0.25 * crad) 0 $ circleSolid (crad * 0.5)
+            , scale 0.5 1 $ color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr
+            ]
+    crad = _crRad cr
     pastDams = _crPastDamage $ _crState cr
     pdam = sum $ concatMap (map _dmAmount) pastDams
     col' = light . light . light $ light col

src/Dodge/Creature/Property.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature.Property
     where
 import Dodge.Data
+import Dodge.Item.Data
 import Geometry
 
 import Control.Lens

src/Dodge/Creature/State.hs

@@ -1,5 +1,6 @@
 module Dodge.Creature.State where
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Test

src/Dodge/Data.hs

@@ -25,6 +25,7 @@ import Dodge.Data.DamageType
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Dodge.Item.Attachment.Data
+import Dodge.Item.Data
 import Dodge.World.Trigger.Data
 import Preload.Data
 import Picture.Data
@@ -230,6 +231,7 @@ data Item
         , _itInvColor :: Color
         , _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
         , _itWorldTrigger :: Maybe (Int -> World -> Bool)
+        , _itAimStance :: AimStance
         }
     | Consumable
         { _itName :: String
@@ -244,6 +246,7 @@ data Item
         , _itInvColor :: Color
         , _itEffect :: ItEffect
         , _itHammer :: HammerPosition
+        , _itAimStance :: AimStance
         }
     | Craftable
         { _itName :: String
@@ -255,6 +258,7 @@ data Item
         , _itID :: Maybe Int
         , _itInvDisplay :: Item -> String
         , _itInvColor :: Color
+        , _itAimStance :: AimStance
         }
      | Equipment
         { _itName :: String
@@ -271,6 +275,7 @@ data Item
         , _itInvDisplay :: Item -> String
         , _itInvColor :: Color
         , _itHammer :: HammerPosition
+        , _itAimStance :: AimStance
         }
      | Throwable
         { _itName :: String
@@ -295,6 +300,7 @@ data Item
         , _itHammer :: HammerPosition
         , _itScrollUp :: Int -> World -> World
         , _itScrollDown :: Int -> World -> World
+        , _itAimStance :: AimStance
         }
      | NoItem
 data ItEffect = NoItEffect
@@ -317,44 +323,6 @@ data ItZoom = ItZoom
     ,_itZoomFac    :: Float 
     }
 data IntID a = IntID Int a
-data HammerPosition 
-    = HammerDown
-    | HammerReleased
-    | HammerUp
-    | NoHammer
-  deriving
-    (Eq, Ord, Show)
-data ItemIdentity 
-    = Pistol
-    | SpreadGun
-    | MultGun
-    | HvAutoGun
-    | AutoGun
-    | LtAutoGun
-    | MiniGun
-    | Medkit25
-    | MagShield
-    | FrontArmour
-    | JetPack
-    | FlameShield
-    | Generic
-    | SparkGun
-    | ShatterGun
-    | LongGun
-    | Flamethrower
-    | Blinker
-    | Grenade
-    | RemoteBomb
-    | TeslaGun
-    | LasGun
-    | ForceFieldGun
-    | GrapGun
-    | TractorGun 
-    | Launcher
-    | RemoteLauncher
-    | LightningGun
-    | PoisonSprayer
-    deriving (Eq,Show,Ord,Enum)
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
@@ -362,6 +330,13 @@ data Particle
         { _ptDraw :: Particle -> Picture
         , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
         }
+    | LinearParticle 
+        { _ptDraw :: Particle -> Picture
+        , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
+        , _ptPoints :: [Point2]
+        , _ptTimer :: Int
+        , _ptColor :: Color
+        }
     | Bul'  
         { _ptDraw :: Particle -> Picture
         , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)

src/Dodge/Data/DamageType.hs

@@ -16,6 +16,7 @@ data DamageType
     | SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } 
     | Flaming  {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
     | Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
+    | Electrical {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
     | Concussive 
         { _dmAmount :: Int 
         , _dmFrom :: Point2 

src/Dodge/Default.hs

@@ -7,6 +7,7 @@ This module contains prototypical data structures.
 module Dodge.Default where
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.AlertLevel.Data
@@ -140,6 +141,7 @@ defaultEquipment = Equipment
     , _itZoom = defaultItZoom
     , _itInvColor = yellow
     , _itInvDisplay = _itName
+    , _itAimStance = LeaveHolstered
     }
 defaultItZoom :: ItZoom
 defaultItZoom = ItZoom 20 0.2 1 20 0.2 1
@@ -157,6 +159,7 @@ defaultConsumable = Consumable
     , _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
     , _itEffect = wpRecock
     , _itHammer = HammerUp
+    , _itAimStance = LeaveHolstered
     }
 defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
 defaultApplyDamage ds cr = (id, doPoisonDam $ foldr (\d c -> snd $ applyIndividualDamage d c) cr ds')
@@ -203,6 +206,7 @@ defaultIt = Consumable
     , _itInvColor = blue
     , _itEffect = NoItEffect
     , _itHammer = HammerUp
+    , _itAimStance = LeaveHolstered
     }
 defaultButton :: Button
 defaultButton = Button

src/Dodge/Default/Weapon.hs

@@ -3,6 +3,7 @@ module Dodge.Default.Weapon
 import Dodge.Data
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Data
 import Picture
 defaultGun :: Item
 defaultGun = Weapon 
@@ -37,6 +38,7 @@ defaultGun = Weapon
     , _itInvColor = white
     , _itTargeting = Nothing
     , _itWorldTrigger = Nothing
+    , _itAimStance = OneHand
     }
 
 defaultAutoGun :: Item
@@ -44,6 +46,7 @@ defaultAutoGun = defaultGun
     { _itScrollUp   = const id
     , _itScrollDown = const id
     , _itInvDisplay = basicWeaponDisplay
+    , _itAimStance = TwoHandTwist
     }
 
 defaultShellAmmo :: Ammo

src/Dodge/Item.hs

@@ -1,6 +1,7 @@
 module Dodge.Item
   where
 import Dodge.Data
+import Dodge.Item.Data
 --import Dodge.Base
 import Dodge.Default
 import Dodge.Picture

src/Dodge/Item/Consumable.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Consumable
     where
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.SoundLogic

src/Dodge/Item/Data.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE StrictData #-}
+module Dodge.Item.Data
+    where
+data HammerPosition 
+    = HammerDown
+    | HammerReleased
+    | HammerUp
+    | NoHammer
+  deriving
+    (Eq, Ord, Show)
+data ItemIdentity 
+    = Pistol
+    | SpreadGun
+    | MultGun
+    | HvAutoGun
+    | AutoGun
+    | LtAutoGun
+    | MiniGun
+    | Medkit25
+    | MagShield
+    | FrontArmour
+    | JetPack
+    | FlameShield
+    | Generic
+    | SparkGun
+    | ShatterGun
+    | LongGun
+    | Flamethrower
+    | Blinker
+    | Grenade
+    | RemoteBomb
+    | TeslaGun
+    | LasGun
+    | ForceFieldGun
+    | GrapGun
+    | TractorGun 
+    | Launcher
+    | RemoteLauncher
+    | LightningGun
+    | PoisonSprayer
+  deriving 
+    (Eq,Show,Ord,Enum)
+data AimStance
+    = TwoHandTwist
+    | TwoHand
+    | OneHand
+    | LeaveHolstered

src/Dodge/Item/Equipment.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Equipment
     where
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Default
 import Dodge.Picture.Layer
 import Picture

src/Dodge/Item/Weapon.hs

@@ -13,6 +13,7 @@ import Dodge.Default
 --import Dodge.Default.Shell
 import Dodge.Item.Draw
 import Dodge.Particle.Bullet.HitEffect
+import Dodge.Item.Data
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
@@ -540,10 +541,10 @@ aTeslaArc cr w = aTeslaArc' cr $ soundFrom (CrWeaponSound cid) 25 1 0 w
 aTeslaArc' :: Creature -> World -> World
 aTeslaArc' cr w 
     = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-    $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
+--    $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
     $ set randGen g w
+    & particles %~ (makeTeslaArcAt pos dir :)
   where 
-    i = newProjectileKey w
     pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) 
                     +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
     (sideOffset,g) = randomR (-5,5) $ _randGen w
@@ -720,6 +721,7 @@ grenade = Throwable
     , _itHammer = HammerUp
     , _itScrollUp = decreaseFuse fuseTime
     , _itScrollDown = increaseFuse fuseTime
+    , _itAimStance = OneHand
     }
   where 
     fuseTime = 50
@@ -932,6 +934,7 @@ pipe = Craftable
     , _itID = Nothing
     , _itInvDisplay = _itName
     , _itInvColor = green
+    , _itAimStance = LeaveHolstered
     }
 {- |
 Sends out pulses that display walls.  -}

src/Dodge/Item/Weapon/Bezier.hs

@@ -3,6 +3,7 @@ module Dodge.Item.Weapon.Bezier
 import Dodge.Data
 import Dodge.Base
 import Dodge.Default.Weapon
+import Dodge.Item.Data
 import Dodge.Item.Weapon.Targeting
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -6,6 +6,7 @@ module Dodge.Item.Weapon.ExtraEffect
     where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Item.Data
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
 --import Dodge.Item.Attachment.Data

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Weapon.Grenade
     where
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.SoundLogic

src/Dodge/Item/Weapon/Launcher.hs

@@ -6,6 +6,7 @@ import Dodge.Default.Shell
 import Dodge.SoundLogic.Synonyms
 import Dodge.WorldEvent.Explosion
 import Dodge.Picture.Layer
+import Dodge.Item.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.TriggerType

src/Dodge/Item/Weapon/TriggerType.hs

@@ -10,6 +10,7 @@ import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
 import Dodge.Particle.Bullet.Spawn
 import Dodge.Item.Attachment.Data
+import Dodge.Item.Data
 import Geometry
 
 import System.Random

src/Dodge/Update/UsingInput.hs

@@ -4,6 +4,7 @@ Functions that affect the world according to what pressed buttons are stored in
 module Dodge.Update.UsingInput
     where
 import Dodge.Data
+import Dodge.Item.Data
 import Dodge.Creature.Action.UseItem
 import Geometry
 

src/Dodge/WorldEvent/Explosion.hs

@@ -36,14 +36,15 @@ makeTeslaExplosionAt
     :: Point2   -- ^ Position
     -> World 
     -> World
-makeTeslaExplosionAt pos w = soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
+makeTeslaExplosionAt pos w = undefined
-  where 
+--     soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
-    xs = randomRs (0, 2*pi) $ _randGen w
+--  where 
-    j = newProjectileKey w
+--    xs = randomRs (0, 2*pi) $ _randGen w
-    pks = [j..]
+--    j = newProjectileKey w
-    listOfFunctions = map 
+--    pks = [j..]
-            (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i)))) 
+--    listOfFunctions = map 
-            [1 .. 29]
+--            (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i)))) 
+--            [1 .. 29]
             
 makeFlameExplosionAt 
     :: Point2   -- ^ Position

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -16,7 +16,7 @@ import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Dodge.SoundLogic
 import Dodge.RandomHelp
-import Dodge.Debug
+--import Dodge.Debug
 import Picture
 import Geometry
 import qualified IntMapHelp as IM
@@ -237,54 +237,59 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC
     damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
     f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
     doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
-
+makeTeslaArcAt :: Point2 -> Float -> Particle
-{-
+makeTeslaArcAt pos dir = LinearParticle
-TODO: make tesla arc a particle.
+    { _ptPoints = [pos]
- -}
+    , _ptDraw = drawTeslaArc
-makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
+    , _ptUpdate' = moveTeslaArc pos dir
-makeTeslaArcAt i pos dir = Projectile
+    , _ptTimer = 2
-    { _pjPos = pos
+    , _ptColor = white
-    , _pjStartPos = pos
-    , _pjVel = (0,0)
-    , _pjDraw = \_ -> onLayer PtLayer $ line [(0,0),(0,0)]
-    , _pjID = i
-    , _pjUpdate = \_ -> moveTeslaArc pos dir i
     }
-
+drawTeslaArc :: Particle -> Picture
-moveTeslaArc 
+drawTeslaArc pt = pic
-    :: Point2   -- ^ Emmission position
+  where
-    -> Float    -- ^ Emmission direction
+    ps' = _ptPoints pt
-    -> Int      -- ^ Projectile id
-    -> World 
-    -> World
-moveTeslaArc p d i w = 
-        set (projectiles . ix i . pjDraw) (\_ -> pic)
-                            $ set (projectiles . ix i . pjUpdate) 
-                                  (\_ -> pjTimerF 2 i)
-                            $ set randGen g
-                            $ createSpark 8 nc q2 (argV sv + d1) Nothing
-                            $ foldr damCrs w hitCrs
- where 
     pic = setLayer 1 $ pictures 
-             [ onLayer PtLayer $ color (f2 nc) $ line ps'
+             [ onLayer PtLayer $ color (_ptColor pt) $ line ps'
              , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
              , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
              , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
              ]
-    ps' = lightningMids d pers ps
+-- todo: fix electrical damage location
+moveTeslaArc 
+    :: Point2   -- ^ Emmission position
+    -> Float    -- ^ Emmission direction
+    -> World 
+    -> Particle
+    -> (World, Maybe Particle)
+moveTeslaArc p d w pt
+    | t == 2 = 
+        (foldr damCrs w hitCrs & randGen .~ g
+            & createSpark 8 nc q2 (argV sv + d1) Nothing
+        , Just $ pt & ptTimer -~ 1
+                            & ptPoints .~ ps'
+                            & ptColor .~ theColor)
+    | t < 1 = (w , Nothing)
+    | otherwise = (w , Just $ pt & ptTimer -~ 1)
+ where 
+    t = _ptTimer pt
     ps = take 15 $ p : map f (crsLightChain p d 0 w)
     f (E3x1 cr) = _crPos cr
     f (E3x2 p1) = p1
     f (E3x3 p1) = p1
+    ps' = lightningMids d pers ps
     pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
     (nc,g) = randomR (0::Int,11) $ _randGen w
-    f1 (E3x1 cr) = Just $ _crID cr
+    theColor = f2 nc
-    f1 _         = Nothing
-    hitCrs       = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
-    damCrs cid = over (creatures . ix cid . crHP) (\hp -> hp - 5)
     f2 0 = cyan
     f2 1 = azure
     f2 _ = white
+    f1 (E3x1 cr) = Just $ _crID cr
+    f1 _         = Nothing
+    hitCrs       = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
+    damCrs cid = over (creatures . ix cid . crState . crDamage) (Electrical 5 cpos cpos cpos :)
+      where 
+        cpos = _crPos (_creatures w IM.! cid)
     q1 = last $ init ps'
     q2 = last ps'
     hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w

src/Picture/Render.hs

@@ -182,7 +182,6 @@ pingPongBlur pdata = do
     generateMipmap' Texture2D
     drawShader (_boxBlurShader pdata) 4
 
-
 renderBackground 
     :: RenderData 
     -> Float            -- Rotation