Commit before introducing layers to pictures
This commit is contained in:
@@ -102,22 +102,6 @@ loadSounds = do
|
||||
, foamSpray'
|
||||
]
|
||||
|
||||
-- updateSound :: World -> IO World
|
||||
-- updateSound w
|
||||
-- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) 0 (_loadedSounds w IM.! n))
|
||||
-- fmap (set soundQueue creatureSounds) $ stepSoundTimers $ w
|
||||
-- -- = return $ set soundQueue creatureSounds w
|
||||
-- -- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) (_loadedSounds w IM.! n) 0)
|
||||
-- -- fmap (set soundQueue creatureSounds) $ return w
|
||||
-- where creatureSounds = []
|
||||
|
||||
--playSounds :: a -> World -> IO ()
|
||||
--playSounds _ w = do
|
||||
-- forM_ (_soundQueue w) (\n -> Mix.playOn (-1) 0 (_loadedSounds w IM.! n))
|
||||
-- -- = return $ set soundQueue creatureSounds w
|
||||
-- -- = do forM_ (_soundQueue w) (\n -> Mix.playOn (-1) (_loadedSounds w IM.! n) 0)
|
||||
-- -- fmap (set soundQueue creatureSounds) $ return w
|
||||
-- where creatureSounds = []
|
||||
|
||||
soundOnce :: Int -> World -> World
|
||||
soundOnce i = over soundQueue ((:) i)
|
||||
|
||||
@@ -714,8 +714,9 @@ aTeslaArc cid w = aTeslaArc' cid
|
||||
$ soundFrom (CrWeaponSound cid) 25 1 0 w
|
||||
|
||||
aTeslaArc' :: Int -> World -> World
|
||||
aTeslaArc' cid w = over particles (IM.insert i (makeTeslaArcAt i pos dir))
|
||||
$ flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir)
|
||||
aTeslaArc' cid w =
|
||||
flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir)
|
||||
$ over particles (IM.insert i (makeTeslaArcAt i pos dir))
|
||||
$ set randGen g w
|
||||
where cr = (_creatures w IM.! cid)
|
||||
i = newParticleKey w
|
||||
|
||||
@@ -1,11 +0,0 @@
|
||||
module EventHelper where
|
||||
import SDL
|
||||
|
||||
stripTimestamp :: (world -> EventPayload -> Maybe world)
|
||||
-> world -> Event -> Maybe world
|
||||
stripTimestamp f w e = f w (eventPayload e)
|
||||
|
||||
test :: world -> EventPayload -> Maybe world
|
||||
test w e = case e of
|
||||
KeyboardEvent (KeyboardEventData _ Pressed _ (Keysym _ KeycodeReturn _)) -> Nothing
|
||||
_ -> Just w
|
||||
+30
-30
@@ -30,14 +30,6 @@ import qualified Data.DList as DL
|
||||
|
||||
import Control.DeepSeq
|
||||
|
||||
concat34 :: (Point3,RGBA) -> [Float]
|
||||
concat34 ((x,y,z),(r,g,b,a)) = [x,y,z,r,g,b,a]
|
||||
|
||||
|
||||
toVec2 (x,y) = Vector2 x y
|
||||
toVec3 (x,y,z) = Vector3 x y z
|
||||
toVec4 (x,y,z,w) = Vector4 x y z w
|
||||
|
||||
polyToTris :: [s] -> [s]
|
||||
{-# INLINE polyToTris #-}
|
||||
polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
|
||||
@@ -247,11 +239,13 @@ threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
|
||||
threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
|
||||
(a:b:c:_) -> (a,b,c)
|
||||
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO ()
|
||||
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw lightmap
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
|
||||
wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
|
||||
@@ -282,12 +276,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
-- draw picture
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
clear [DepthBuffer]
|
||||
|
||||
let firstIndex = 0
|
||||
|
||||
-- poke necessary data
|
||||
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
|
||||
-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
|
||||
<- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)
|
||||
@@ -308,27 +302,26 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 1)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
|
||||
-- draw triangles
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
|
||||
drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
|
||||
drawArrays Triangles 0 (fromIntegral $ nTriVs)
|
||||
-- draw circles
|
||||
currentProgram $= Just (_circShader pdata)
|
||||
uniform (_uniWinSize pdata) $= Vector2 winx winy
|
||||
uniform (_csZoomUni pdata) $= zoom
|
||||
bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
|
||||
bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
|
||||
drawArrays Points 0 (fromIntegral $ numCircVs)
|
||||
-- draw arcs
|
||||
currentProgram $= Just (_arcShader pdata)
|
||||
uniform (_asWinUni pdata) $= Vector2 winx winy
|
||||
uniform (_asZoomUni pdata) $= zoom
|
||||
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
|
||||
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
|
||||
drawArrays Points 0 (fromIntegral $ nArcVs)
|
||||
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
@@ -337,22 +330,26 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
|
||||
drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
|
||||
drawArrays Lines 0 (fromIntegral $ nLineVs)
|
||||
-- draw text
|
||||
currentProgram $= Just (_textShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
|
||||
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 0)
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
|
||||
drawArrays Points 0 (fromIntegral $ nTextVs)
|
||||
|
||||
|
||||
bufferOffset :: Integral a => a -> Ptr b
|
||||
bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
|
||||
renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
|
||||
renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
|
||||
let firstIndex = 0
|
||||
|
||||
-- the following code draws a picture
|
||||
-- it does not set nor change the blend function or depth buffer
|
||||
renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> Picture -> IO ()
|
||||
renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
|
||||
|
||||
-- poke necessary data
|
||||
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
|
||||
-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
|
||||
<- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)
|
||||
@@ -363,7 +360,7 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
|
||||
) $ picToFTree pic
|
||||
|
||||
depthFunc $= Just Less
|
||||
|
||||
|
||||
currentProgram $= Just (_backShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
|
||||
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
|
||||
@@ -373,35 +370,38 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
|
||||
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 1)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
|
||||
-- draw triangles
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
|
||||
drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
|
||||
-- draw lines, don't need to change the program or vaos, just need to bind the
|
||||
-- vbos and draw
|
||||
bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
|
||||
drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
|
||||
drawArrays Triangles 0 (fromIntegral $ nTriVs)
|
||||
-- draw circles
|
||||
currentProgram $= Just (_circShader pdata)
|
||||
uniform (_uniWinSize pdata) $= Vector2 winx winy
|
||||
uniform (_csZoomUni pdata) $= zoom
|
||||
bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
|
||||
bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
|
||||
drawArrays Points 0 (fromIntegral $ numCircVs)
|
||||
-- draw arcs
|
||||
currentProgram $= Just (_arcShader pdata)
|
||||
uniform (_asWinUni pdata) $= Vector2 winx winy
|
||||
uniform (_asZoomUni pdata) $= zoom
|
||||
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
|
||||
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
|
||||
drawArrays Points 0 (fromIntegral $ nArcVs)
|
||||
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
|
||||
-- draw lines
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
|
||||
drawArrays Lines 0 (fromIntegral $ nLineVs)
|
||||
-- draw text
|
||||
currentProgram $= Just (_textShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
|
||||
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 0)
|
||||
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
|
||||
drawArrays Points 0 (fromIntegral $ nTextVs)
|
||||
|
||||
Reference in New Issue
Block a user