diff --git a/app/Main.hs b/app/Main.hs index 7385911da..7fe2ea989 100644 --- a/app/Main.hs +++ b/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) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 8e516554e..f86a9d483 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -254,6 +254,7 @@ startCr = defaultCreature ( [pistol ,blinkGun + ,spawnGun lamp ,flameGrenade ,teslaGrenade ,autoGun diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 1cb76928c..3127a4955 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/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) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index dc900a111..487ee9248 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 066cfb270..855bbb2da 100644 --- a/src/Picture/Render.hs +++ b/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)