Add spawner gun

app/Main.hs

@@ -24,6 +24,7 @@ import Sound.Preload
 
 import Control.Concurrent
 import Control.Lens
+import Foreign (Word32)
 
 import Control.Monad (when)
  
@@ -52,18 +53,7 @@ main = do
         (fmap (setWindowSize sizex sizey keyConfig) firstWorld)
         ( \preData w -> do
             startTicks <- SDL.ticks
-            clear [ColorBuffer,DepthBuffer]
-            (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) 
-                (_cameraRot w) (_cameraZoom w) 
-                (_cameraCenter w)
-                (_windowX w,_windowY w) 
-                (wallsPointsAndCols w)
-                (wallsWindows w)
-                (lightsForGloom' w)
-                (_cameraViewFrom w)
-                (worldPictures w)
-            blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-            renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
+            doTheRender preData w
             playSoundQueue (_soundData preData) (_soundQueue w)
             newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
 
@@ -91,3 +81,20 @@ setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World
 setWindowSize x y z w = w & windowX .~ fromIntegral x
                         & windowY .~ fromIntegral y
                         & keyConfig .~ z
+doTheRender :: PreloadData a -> World -> IO (Word32)
+doTheRender preData w = do
+    sTicks <- SDL.ticks
+    clear [ColorBuffer,DepthBuffer]
+    renderPicture' (_renderData preData) 
+        (_cameraRot w) (_cameraZoom w) 
+        (_cameraCenter w)
+        (_windowX w,_windowY w) 
+        (wallsPointsAndCols w)
+        (wallsWindows w)
+        (lightsForGloom' w)
+        (_cameraViewFrom w)
+        (worldPictures w)
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
+    eTicks <- SDL.ticks
+    return (eTicks - sTicks)

src/Dodge/Creature.hs

@@ -254,6 +254,7 @@ startCr = defaultCreature
         (
         [pistol
         ,blinkGun
+        ,spawnGun lamp
         ,flameGrenade
         ,teslaGrenade
         ,autoGun

src/Dodge/Item/Weapon.hs

@@ -82,6 +82,7 @@ pistol = Weapon
     , _itInvColor = white
     }
 defaultGun = pistol
+
 defaultAutoGun = autoGun {_itScrollUp = const id
                          , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
 effectGun :: String -> (Int -> World -> World) -> Item
@@ -900,13 +901,14 @@ aFlame a cid w
             w
         where 
             (a2,g) = randomR (-0.1,0.1) (_randGen w)
+            (t,_) = randomR (99,101) (_randGen w)
             angle = min flamerAngle $ max (-flamerAngle) (a + a2)
             cr = (_creatures w IM.! cid)
             dir = _crDir cr + angle
             pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
             w1 = set randGen g w
             vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
-            insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
+            insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
             resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
                                               (shoot $ aFlame angle)
 
@@ -1942,4 +1944,23 @@ makeLaserScope p ep d relFrac = Particle'
 
 
 
+spawnGun :: Creature -> Item
+spawnGun cr = defaultGun
+    { _itName       = "SPAWNER"
+    , _wpMaxAmmo    = 1
+    , _wpLoadedAmmo = 1
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _wpFireRate   = 100
+    , _wpFire       = spawnCrNextTo cr
+    }
 
+spawnCrNextTo :: Creature -> Int -> World -> World
+spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
+  where
+    k = newKey $ _creatures w
+    sCr = _creatures w IM.! i
+    newCr = cr
+        & crID  .~ k
+        & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+        & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -37,8 +37,8 @@ aFlameParticle t pos vel maycid = Pt'
     , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff noEff
     }
 
-makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
-makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : )
+makeFlame :: Int -> Point2 -> Point2 -> Maybe Int -> World -> World
+makeFlame t pos vel maycid = over particles' (aFlameParticle t pos vel maycid : )
 
 drawFlame :: Point2 -> Particle' -> Picture
 drawFlame rotd pt = thePic

src/Picture/Render.hs

@@ -33,25 +33,22 @@ import qualified SDL as SDL
 
 renderPicture' :: RenderData -> Float -> Float -> Point2 -> Point2 ->
                     [((Point2,Point2),Point4)] -> [((Point2,Point2),Point4)] -> [Point4] ->
-                    (Float,Float) -> Picture -> IO (Word32,Word32)
+                    (Float,Float) -> Picture -> IO (Word32)
 renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
                     viewFroms@(viewFromx,viewFromy) pic = do
-    let wallPoints = map fst wallPointsCol
     startTicks <- SDL.ticks
+    let wallPoints = map fst wallPointsCol
 
     setCommonUniforms pdata rot zoom trans wins
 
     depthFunc $= Just Less
 
--- calculate perspective matrix
     pmat <- (newMatrix RowMajor 
                 $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
             ) :: IO (GLmatrix GLfloat)
 
     createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
 
-    ticksAfterLighting <- SDL.ticks
-
     renderBackground pdata rot zoom trans wins
 
     renderWalls pdata wallPointsCol pmat
@@ -65,6 +62,7 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 -- reset blend so that light map doesn't apply
 --    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
+--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     renderFoldable pdata $ picToLTree (Just 1) pic
 
 -- set drawing for on top
@@ -78,7 +76,7 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
     endTicks <- SDL.ticks
-    return (ticksAfterLighting, endTicks - startTicks)
+    return (endTicks - startTicks)
 
 renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
 renderWalls pdata wps pmat = do
@@ -190,15 +188,11 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
 
     blend $= Disabled
 
---    blendFunc $= (Zero,One)
     bindFramebuffer Framebuffer $= defaultFramebufferObject
 
     colorMask $= (Color4 Disabled Disabled Disabled Enabled)
---
---    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
     bindShaderBuffers [_fullscreenShader pdata] [4]
     textureBinding Texture2D $= Just (_fboTexture pdata)
---    blendFunc $= (One, Zero)
     drawShader (_fullscreenShader pdata) 4
 
     colorMask $= (Color4 Enabled Enabled Enabled Enabled)