diff --git a/data/texture/ayene_wooden_floor.png b/data/texture/ayene_wooden_floor.png new file mode 100644 index 000000000..d8c4ade7c Binary files /dev/null and b/data/texture/ayene_wooden_floor.png differ diff --git a/data/texture/tagteam_floorswalls.png b/data/texture/tagteam_floorswalls.png new file mode 100644 index 000000000..1dbd9e43a Binary files /dev/null and b/data/texture/tagteam_floorswalls.png differ diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index c45e1b969..a9bc84119 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -16,7 +16,7 @@ useItem n w = itemEffect c it w -- TODO this needs sorting out and possibly removing crUseItem :: Creature -> World -> World --crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) -crUseItem cr = tryUseItem cr +crUseItem = tryUseItem tryUseItem :: Creature diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 5288d75c7..711a41af1 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -68,7 +68,7 @@ feet cr = case cr ^? crStance . carriage of , translate 0 (-off) $ circleSolid 5 ] where - setL = onLayerL [levLayer CrLayer, (-5)] . color (greyN 0.3) . pictures + setL = onLayerL [levLayer CrLayer, -5] . color (greyN 0.3) . pictures off = 5 sLen = _strideLength $ _crStance cr f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen @@ -86,7 +86,7 @@ arms col cr _ -> blank where sc = scale 1 1 - setL = onLayerL [levLayer CrLayer, (-4)] . color (light4 col) . pictures + setL = onLayerL [levLayer CrLayer, -4] . color (light4 col) . pictures off = 8 sLen = _strideLength $ _crStance cr f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen @@ -103,20 +103,20 @@ naked col cr [ translate (0.25 * crad) 0 $ circleSolid (crad * 0.5) , onCrL . translate 8 (-8) . color col' $ circleSolid 4 , translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr - , translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr + , translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr ] | aimingTwist = translate 0 (0.5* crad) . rotate twistA $ pictures [ aboveIt . translate (negate 0.25 * crad) 0.25 $ circleSolid (crad * 0.5) - , onCrL . translate 12 (4) . color col' $ circleSolid 4 + , onCrL . translate 12 4 . color col' $ circleSolid 4 , onCrL . translate 4 (-10) . color col' $ circleSolid 4 , onCrL . rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr - , onCrL . rotate (negate 0.2) . translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr + , onCrL . rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr ] | otherwise = onCrL $ pictures [ translate (0.25 * crad) 0 $ circleSolid (crad * 0.5) , translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr - , translate 0 (negate 3) . rotate (0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr + , translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr ] where aboveIt = onLayer HPtLayer diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ed57951b2..b581fca87 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -162,9 +162,9 @@ defaultPT = Projectile { _pjPos = (0,0) , _pjStartPos = (0,0) , _pjVel = (0,0) - , _pjDraw = \_ -> blank + , _pjDraw = const blank , _pjID = 0 - , _pjUpdate = \_ -> id + , _pjUpdate = const id } defaultPP :: PressPlate defaultPP = PressPlate diff --git a/src/Dodge/Default/Shell.hs b/src/Dodge/Default/Shell.hs index 98def6d00..71fc9e4dd 100644 --- a/src/Dodge/Default/Shell.hs +++ b/src/Dodge/Default/Shell.hs @@ -11,9 +11,9 @@ defaultShell = Shell , _pjAcc = (0,0) , _pjDir = 0 , _pjSpin = 0 - , _pjDraw = \_ -> blank + , _pjDraw = const blank , _pjID = 0 , _pjTimer = 0 - , _pjUpdate = \_ -> id - , _pjPayload = \_ -> id + , _pjUpdate = const id + , _pjPayload = const id } diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 2248fe55e..a2251dc94 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -46,9 +46,9 @@ defaultAutoGun = defaultGun } defaultShellAmmo :: Ammo defaultShellAmmo = ShellAmmo - { _amPayload = \_ -> id + { _amPayload = const id , _amString = "Shell" , _amPjParams = [] - , _amPjDraw = \_ -> blank + , _amPjDraw = const blank , _amParamSel = 0 } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 0f227d142..5fa03e058 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -114,7 +114,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of moveYourAmmoSel :: Int -> World -> World moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) - . wpAmmo . amParamSel %~ (`mod` (length l)) . (subtract i) + . wpAmmo . amParamSel %~ (`mod` (length l)) . subtract i _ -> w moveYourAmmoParam :: Int -> World -> World moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index f6e0262b5..a1df46b04 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -92,12 +92,12 @@ useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b) effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" - , _itUse = \_ -> eff + , _itUse = const eff } autoEffectGun :: String -> (Creature -> World -> World) -> Item autoEffectGun name eff = defaultAutoGun { _itName = name ++ "Gun" - , _itUse = \_ -> eff + , _itUse = const eff } rezGun :: Item rezGun = defaultGun @@ -876,7 +876,7 @@ throwRemoteBomb cr w = setLocation explodeRemoteBomb :: Int -> Int -> Creature -> World -> World explodeRemoteBomb itid pjid cr w = set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid) - $ set (projectiles . ix pjid . pjDraw) (\_ -> blank) +-- $ set (projectiles . ix pjid . pjDraw) (\_ -> blank) $ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id) $ resetName $ resetPict diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 9280dd0ab..86aa8cbf8 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -46,7 +46,7 @@ boostSelfL x cr invid w = case boostPoint x cr w of . (crInv . ix invid %~ ammoEff . (itEffect . itEffectCounter .~ 1) - . (itAttachment .~ Just (ItInt pid)) + . (itAttachment ?~ ItInt pid) ) boostSelf @@ -85,8 +85,8 @@ updateLinearShockwave pj w drawBoostShockwave :: Projectile -> Picture drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ pictures $ theArc ++ - [ lineCol $ zip (reverse lps) $ map (flip withAlpha white) [0,0.05..] - , lineCol $ zip (reverse rps) $ map (flip withAlpha white) [0,0.05..] + [ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0,0.05..] + , lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0,0.05..] ] where -- drawing half a circle here is not perfect, a slightly smaller arc would fit diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index eab6dab44..938785053 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -56,7 +56,7 @@ itemLaserScopeEffect :: ItEffect itemLaserScopeEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 } where - moveHammerUp !HammerDown = HammerReleased + moveHammerUp HammerDown = HammerReleased moveHammerUp !_ = HammerUp f _ cr invid w | invid == _crInvSel cr && crIsAiming' cr = w diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index b4fb4de27..abe62e65e 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -35,7 +35,7 @@ launcher = defaultGun , _wpReloadState = 0 , _itUseRate = 20 , _itUseTime = 0 - , _itUse = \it -> shootWithSound (fromIntegral launcherSound) $ aRocketWithItemParams it + , _itUse = shootWithSound (fromIntegral launcherSound) . aRocketWithItemParams , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer launcherPic @@ -64,7 +64,7 @@ basicAmPjMoves = ] spinDrag :: PjParam spinDrag = PjParam - { _pjMoveParam = \i _ _ -> reduceSpinBy (1 - (fromIntegral i)*2 / 200) + { _pjMoveParam = \i _ _ -> reduceSpinBy (1 - fromIntegral i*2 / 200) , _pjIntParam = 1 , _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show , _pjMaxParam = 5 @@ -87,7 +87,7 @@ thrustParam = PjParam } pjThrust :: Int -> Projectile -> World -> World -pjThrust i = pjEffTimeRange (st,et) $ doThrust +pjThrust i = pjEffTimeRange (st,et) doThrust where et | i == 0 = 36 | otherwise = 40 - (fromIntegral i * 20) @@ -131,7 +131,7 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w i = IM.newKey $ _projectiles w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr - ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjParams am) + ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am) theShell = defaultShell { _pjPos = pos , _pjStartPos = pos diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index f83d82749..117c13db4 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -126,7 +126,7 @@ tractorBeamAt colID i pos dir = Projectile { _pjPos = pos , _pjStartPos = p' , _pjVel = d - , _pjDraw = \_ -> blank + , _pjDraw = const blank , _pjID = i , _pjUpdate = \_ -> updateTractor colID 10 i } @@ -139,7 +139,7 @@ The interaction of this with objects, walls etc needs more thought. -} updateTractor :: Int -> Int -> Int -> World -> World updateTractor colID time i w | time > 0 = set (projectiles . ix i . pjUpdate) (\_ -> updateTractor colID (time-1) i) - $ set (projectiles . ix i . pjDraw) (\_ -> pic) + $ set (projectiles . ix i . pjDraw) (const pic) $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 44139eb08..e46f04542 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -54,7 +54,7 @@ doDrawing pdata w = do pic = worldPictures w wallPoints = map fst wallPointsCol -- set the coordinate uniforms ready for drawing elements using world coordinates - setCommonUniforms pdata rot camzoom trans wins + setIsoMatrixUniforms pdata rot camzoom trans wins depthFunc $= Just Less pmat <- (newMatrix RowMajor $ perspectiveMatrix rot camzoom trans wins viewFroms) :: IO (GLmatrix GLfloat) @@ -138,8 +138,7 @@ renderBlankWalls pdata wps pmat = do n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps bindShaderBuffers [_wallBlankShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) - uniform (( _shaderMatrixUniform $ _wallBlankShader pdata) ) - $= pmat + uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat cullFace $= Just Back drawShader (_wallBlankShader pdata) n cullFace $= Nothing @@ -153,8 +152,7 @@ renderTextureWalls pdata wps pmat = do n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps bindShaderBuffers [_wallTextureShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata) - uniform (( _shaderMatrixUniform $ _wallTextureShader pdata) ) - $= pmat + uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat cullFace $= Just Back drawShader (_wallTextureShader pdata) n cullFace $= Nothing diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index c8931878c..2dda0ed97 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -55,7 +55,7 @@ testPic w = ] crDraw :: World -> Creature -> Picture -crDraw w c = (_crPict c c w) +crDraw w c = _crPict c c w ppDraw :: PressPlate -> Picture ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) btDraw :: Button -> Picture diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 2e4c3ebf4..5171a3ed8 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -22,6 +22,7 @@ data RenderData = RenderData , _wallBlankShader :: FullShader ((Point2,Point2),Point4) , _wallTextureShader :: FullShader ((Point2,Point2),Point4) , _backgroundShader :: FullShader (Point2,Point2,Point2,Point2) + , _textureShader :: FullShader (Point3,Point2) , _fullscreenShader :: FullShader () , _boxBlurShader :: FullShader () , _grayscaleShader :: FullShader () @@ -85,6 +86,11 @@ preloadRender = do -- textured wallShader wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat >>= addTexture "data/texture/grayscaleDirt.png" + +-- texture shader + textShad <- makeShader "texture/simpleWorld" [vert,frag] [(0,3),(1,2)] Triangles poke32 + >>= addTexture "data/texture/ayene_wooden_floor.png" + -- framebuffer for lighting (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil framebuf2 <- setupFramebufferWithStencil @@ -98,6 +104,7 @@ preloadRender = do , _lightingWallShader = wlLightShad , _wallBlankShader = wlBlank , _wallTextureShader = wlTexture + , _textureShader = textShad , _backgroundShader = bgShad , _fullscreenShader = fsShad , _boxBlurShader = boxBlurShad @@ -209,5 +216,8 @@ pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]] pokeWPColStrat :: ((Point2,Point2),Point4) -> [[[Float]]] pokeWPColStrat (((x,y),(z,w)),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]] +poke32 :: (Point3,Point2) -> [[[Float]]] +poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]] + pokeBGStrat :: a -> [[[Float]]] pokeBGStrat = const [] diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index a0b4f224e..8e9d73517 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -31,7 +31,7 @@ setWallDepth -> (Float,Float) -- ^ View from point -> GLmatrix GLfloat -> IO Word32 -setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do +setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do startTicks <- SDL.ticks colorMask $= Color4 Disabled Disabled Disabled Disabled nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints @@ -41,6 +41,8 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do -- reseting this uniform appears to be necessary uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) $= Vector2 viewFromx viewFromy + -- the following uniform, however, was probably already set by + -- createLightMap -- uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata)) -- $= pmat -- cullFace $= Just Front @@ -92,8 +94,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _ currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) $= Vector2 viewFromx viewFromy - uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata)) - $= pmat + uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat cullFace $= Just Back drawShader (_lightingOccludeShader pdata) nWalls @@ -225,6 +226,34 @@ setCommonUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do : map extractProgAndUnis (_pictureShaders pdata) ) +setIsoMatrixUniforms + :: RenderData + -> Float -- ^ Rotation + -> Float -- ^ Zoom + -> (Float,Float) -- ^ Translation + -> (Float,Float) -- ^ Window size + -> IO () +setIsoMatrixUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do + setShaderUniforms rot camZoom (tranx,trany) (winx,winy) + ( extractProgAndUnis (_lightingFloorShader pdata) + : extractProgAndUnis (_backgroundShader pdata) + : extractProgAndUnis (_textureShader pdata) + : map extractProgAndUnis (_pictureShaders pdata) + ) + +renderShader + :: Foldable f + => FullShader a + -> f a + -> IO Word32 +renderShader shad dat = do + sticks <- SDL.ticks + i <- F.foldM (pokeShader shad) dat + bindShaderBuffers [shad] [i] + drawShader shad i + eticks <- SDL.ticks + return $ eticks - sticks + renderFoldable :: Foldable f => RenderData diff --git a/src/Shader.hs b/src/Shader.hs index b609052ad..3fee66050 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -70,7 +70,7 @@ bindArrayBuffers :: Int -> [(BufferObject,Ptr Float,Int)] -> IO () bindArrayBuffers numVs ps = do forM_ ps $ \(bo,ptr,i) -> do bindBuffer ArrayBuffer $= Just bo - bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, StreamDraw) + bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, DynamicDraw) bindShaderBuffers :: [FullShader a] -> [Int] -> IO () bindShaderBuffers = zipWithM_ f