Skip to content

Commit d6d74d8

Browse files
levexlevex
committed
ADD ALL WORK
Signed-off-by: Levente Kurusa <[email protected]>
1 parent feb43c4 commit d6d74d8

File tree

5 files changed

+132
-71
lines changed

5 files changed

+132
-71
lines changed

‎src/Flat.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,8 @@ import Game
2121

2222
loadFlatData :: WAD.Wad -> WAD.LumpName -> [Word8]
2323
-- special, transparent flat
24-
loadFlatData :: WAD.Wad -> WAD.LumpName -> [Word8]
24+
loadFlatData wad "F_SKY1"
25+
= replicate 4096 0xFF
2526
loadFlatData wad name
2627
= BS.unpack $ WAD.flatData flat
2728
where

‎src/Game.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,11 +42,16 @@ data RenderData = RenderData {
4242
, rdProg :: GLuint
4343
}
4444

45+
46+
scale :: GLfloat
47+
scale = 16
48+
4549
data Sprite = Sprite {
4650
spriteName :: String, -- sprite name in WAD
4751
spriteActive :: IORef Bool, -- whether we can start moving
4852
spriteAnimFrame :: IORef Int, -- current animation frame
49-
spriteRenderData :: RenderData
53+
spriteRenderData :: RenderData,
54+
spritePos :: Pos
5055
}
5156

5257
type ColorPalette = [[(Word8, Word8, Word8)]]

‎src/Main.hs

Lines changed: 14 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -37,16 +37,14 @@ import Enemy
3737
import Sky
3838
import Triangulation
3939
import Flat
40+
import Sky
4041
import Debug.Trace
4142

4243

4344
width :: Int
4445
height :: Int
4546
(width, height) = (1280, 1024)
4647

47-
scale :: GLfloat
48-
scale = 16
49-
5048
class BufferStuff a where
5149
extract :: proxy a -> [(String, Int)]
5250

@@ -355,7 +353,6 @@ main = do
355353

356354
let playerPos = V3 posX 1.6 posY
357355

358-
<<<<<<< 6667a2b75c94e545f2aeed1bda773480ff14c69c
359356
--texId <- getTextureId wad
360357
--let levelData = RenderData { rdVbo = vertexBufferId
361358
-- , rdEbo = elementBufferId
@@ -369,49 +366,21 @@ main = do
369366
, rdProg = floorProgId
370367
, rdVao = floorVertexArrayId
371368
}
372-
=======
373-
testSprite <- makeSprite wad spriteProgId "BOSSF7"
374-
texId <- getTextureId wad
375-
let rd = RenderData { rdVbo = vertexBufferId,
376-
rdEbo = elementBufferId,
377-
rdTex = texId,
378-
rdProg = progId,
379-
rdVao = vertexArrayId}
380-
>>>>>>> Remove loadTexture from Game monad
381-
369+
sprites <- createLevelThings wad progId (WAD.levelThings level)
382370
initState <- GameState <$> return progId
383371
<*> return wad
384372
<*> return sideDefCount
385-
<<<<<<< 6667a2b75c94e545f2aeed1bda773480ff14c69c
386373
<*> pure levelRData
387374
<*> pure floorRData
388-
<*> pure []
375+
<*> pure sprites
389376
<*> newIORef undefined -- TODO: current sector
390377
<*> newIORef 0
391378
<*> newIORef playerPos
392379
<*> newIORef levelEnemies
393380
<*> pure (loadPalettes wad)
394381
<*> fillSkyTextureData wad
395-
=======
396-
<*> pure rd
397-
<*> pure [testSprite]
398-
<*> newIORef (Sector undefined undefined)
399-
<*> newIORef 0
400-
<*> newIORef playerPos
401-
<*> newIORef levelEnemies
402-
<*> pure (loadPalettes wad)
403382
mainLoop (\w -> runGame (loop w) initState)
404383

405-
406-
extendToV4 :: V3 GLfloat -> V4 GLfloat
407-
extendToV4 (V3 x z y) = V4 x z y 1
408-
409-
-- Needs to take into account the current sector,
410-
-- hence in the Game monad.
411-
getCurrentPlayerPos :: Pos -> Game Pos
412-
getCurrentPlayerPos pos = return pos
413-
414-
<<<<<<< 6667a2b75c94e545f2aeed1bda773480ff14c69c
415384
getTextureId :: WAD.Wad -> WAD.LumpName -> IO GLuint
416385
getTextureId wad name = do
417386
(tW, tH, txt) <- loadTexture wad name
@@ -466,6 +435,13 @@ updateView w initV modelM = do
466435
(V3 0 1 0) :: M44 GLfloat
467436

468437
Uniform progId' "view" $= viewTrans
438+
439+
-- render the sky
440+
glDepthMask (fromBool False)
441+
sky' <- asks sky
442+
bindRenderData sky'
443+
glDrawElements GL_TRIANGLES 6 GL_UNSIGNED_INT nullPtr
444+
glDepthMask (fromBool True)
469445

470446
-- render the sky
471447
glDepthMask (fromBool False)
@@ -511,6 +487,10 @@ updateView w initV modelM = do
511487
glDrawElements GL_TRIANGLES 6 GL_UNSIGNED_INT nullPtr
512488

513489
-- this is a huge mess
490+
--
491+
492+
extendToV4 :: V3 GLfloat -> V4 GLfloat
493+
extendToV4 (V3 x z y) = V4 x z y 1
514494

515495
multAndProject :: M44 GLfloat -> V3 GLfloat -> V3 GLfloat
516496
multAndProject m v =

‎src/Sprite.hs

Lines changed: 86 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1,90 +1,136 @@
1-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE StandaloneDeriving #-}
22
module Sprite where
33
-- TODO: prune
44
import Control.Monad
55
import Control.Monad.Reader
66
import Data.CaseInsensitive hiding (map)
77
import Data.Foldable
88
import Data.IORef
9-
import Data.Array.IO as AI
10-
import qualified Data.ByteString as BS
11-
import qualified Data.ByteString.Char8 as BSC
12-
import qualified Data.Map as M
9+
import Data.Array.IO as AI
10+
import qualified Data.ByteString as BS
11+
import qualified Data.ByteString.Char8 as BSC
12+
import qualified Data.Map as M
1313
import Data.Maybe
14+
import Data.Char
1415
import Foreign
1516
import Foreign.C.String
1617
import Game
17-
import qualified Game.Waddle as WAD
18+
import qualified Game.Waddle as WAD
1819
import GLUtils
1920
import Graphics.GL.Core33
2021
import Graphics.UI.GLFW
2122
import Linear
2223
import Var
2324
import Window
25+
import Types
2426
import TextureLoader
27+
import SpriteMap
2528
import Data.Array.IO
26-
import Data.List
2729

28-
testSpriteVbo :: Float -> Float -> [GLfloat]
29-
testSpriteVbo k n = [
30-
-1/8, 1, 0.0, k/n, 0.0,
31-
1/8, 1, 0.0, (k+1)/n, 0.0,
32-
-1/8, -1, 0.0, k/n, 1,
33-
1/8, -1, 0.0, (k+1)/n, 1]
30+
testSpriteVbo :: [GLfloat]
31+
testSpriteVbo = [
32+
-0.5, 0.5, 0.0, 0.0, 0.0,
33+
0.5, 0.5, 0.0, 1.0, 0.0,
34+
-0.5, -0.5, 0.0, 0.0, 1.0,
35+
0.5, -0.5, 0.0, 1.0, 1.0]
3436

3537
testSpriteEbo :: [GLuint]
3638
testSpriteEbo = [
3739
0, 1, 2,
3840
2, 1, 3]
3941

40-
loadSprite :: [WAD.Sprite] -> IO [Word8]
41-
loadSprite sprites@(s:_) = do
42-
let pic = WAD.spritePicture s
42+
loadSpriteColor :: WAD.Sprite -> ColorPalette -> IO [GLfloat]
43+
loadSpriteColor sprite cp
44+
= unpackTuples <$> (textureDataToColor cp <$> loadSprite sprite)
45+
46+
loadSprite :: WAD.Sprite -> IO [Word8]
47+
loadSprite sprite = do
48+
let pic = WAD.spritePicture sprite
4349
let fW = WAD.pictureWidth pic
4450
let fH = WAD.pictureHeight pic
45-
pxArr <- AI.newArray (0, fW * fH * length sprites) (0xFF :: Word8)
51+
pxArr <- AI.newArray (0, fW * fH) (0xFF :: Word8)
4652
:: IO (IOArray Int Word8)
47-
forM_ (zip [0..] sprites) $ \(n, col) -> do
48-
let posts = WAD.picturePosts pic
49-
forM_ (zip [0..] posts) $ \(x, col) ->
50-
forM_ col $ \post -> do
51-
let tx = x
52-
forM_ (zip [0..] (BS.unpack $ WAD.postPixels post)) $ \(i, pt) -> do
53-
let ty = (fromIntegral $ WAD.postTop post) + i
54-
writeArray pxArr (tx + ty * fW + fW * n) pt
53+
let posts = WAD.picturePosts pic
54+
forM_ (zip [0..] posts) $ \(x, col) ->
55+
forM_ col $ \post -> do
56+
let tx = x
57+
forM_ (zip [0..] (BS.unpack $ WAD.postPixels post)) $ \(i, pt) -> do
58+
let ty = (fromIntegral $ WAD.postTop post) + i
59+
when (tx <= fW - 1 && ty <= fH - 1 && tx >= 0 && ty >= 0) $
60+
writeArray pxArr (tx + ty * fW) pt
5561
getElems pxArr
5662

63+
createLevelThings :: WAD.Wad -> GLuint -> [WAD.Thing] -> IO [Sprite]
64+
createLevelThings wad progId things
65+
= mapM (\t -> makeSprite' (mkVbo t) (mkEbo t) (Just t) wad progId (thingToSprite $ WAD.thingType t))
66+
(filter (\t ->
67+
notElem (thingTypeToInt $ WAD.thingType t) reservedSpriteIds)
68+
things)
69+
where
70+
pW = 3 -- fixME, ugly
71+
pH = 3 -- fixME, ugly
72+
tx t = fromIntegral (WAD.thingX t) / scale
73+
ty t = fromIntegral (WAD.thingY t) / scale
74+
mkVbo t = [ - tx t, pW, ty t, 1, 0
75+
, - tx t + pH, pW, ty t + pH, 0, 0
76+
, - tx t, 0, ty t, 1, 1
77+
, - tx t + pH, 0, ty t + pH, 0, 1
78+
]
79+
mkEbo t = [
80+
0, 1, 2,
81+
2, 1, 3]
82+
5783
makeSprite :: WAD.Wad -> GLuint -> WAD.LumpName -> IO Sprite
58-
makeSprite wad progId spriteName = do
84+
makeSprite
85+
= makeSprite' testSpriteVbo testSpriteEbo Nothing
86+
87+
findSpriteName :: WAD.Wad -> WAD.LumpName -> WAD.LumpName
88+
findSpriteName wad name
89+
= findSpriteName' wad name "A" "0"
90+
where
91+
findSpriteName' wad name f@(a : as) g@(b : bs)
92+
| isNothing p = findSpriteName' wad name (na : as) (nb : bs)
93+
| otherwise = t
94+
where
95+
p = M.lookup (mk t) (WAD.wadSprites wad)
96+
t = BS.append (BS.append name (BSC.pack f)) (BSC.pack g)
97+
na = chr ((ord a) + 1)
98+
nb = chr ((ord b) + 1)
99+
100+
makeSprite' :: [GLfloat] -> [GLuint] -> Maybe WAD.Thing -> WAD.Wad -> GLuint -> WAD.LumpName -> IO Sprite
101+
makeSprite' vbo ebo thing wad progId spriteName' = do
102+
let spriteName = if (length (BS.unpack spriteName') == 4) then
103+
findSpriteName wad spriteName'
104+
else
105+
spriteName'
106+
59107
vaoId <- withNewPtr (glGenVertexArrays 1)
60108
glBindVertexArray vaoId
61109

62110
vboId <- withNewPtr (glGenBuffers 1)
63111
glBindBuffer GL_ARRAY_BUFFER vboId
64-
-- needs unhardcoding
65-
withArrayLen (testSpriteVbo 0 8) $ \len vertices ->
112+
withArrayLen vbo $ \len vertices ->
66113
glBufferData GL_ARRAY_BUFFER
67114
(fromIntegral $ len * sizeOf (0 :: GLfloat))
68115
(vertices :: Ptr GLfloat)
69116
GL_STATIC_DRAW
70117

71118
eboId <- withNewPtr (glGenBuffers 1)
72119
glBindBuffer GL_ELEMENT_ARRAY_BUFFER eboId
73-
withArrayLen testSpriteEbo $ \len vertices ->
120+
withArrayLen ebo $ \len vertices ->
74121
glBufferData GL_ELEMENT_ARRAY_BUFFER
75122
(fromIntegral $ len * sizeOf (0 :: GLuint))
76123
(vertices :: Ptr GLuint)
77124
GL_STATIC_DRAW
78125

79126
-- load sprite image
80-
let spriteMap = WAD.wadSprites wad
81-
let sprites@(sprite:_) = catMaybes [M.lookup (mk $ BS.concat [spriteName, BSC.singleton c, "1"]) spriteMap | c <- ['A'..'Z']]
127+
let sprite = fromMaybe (error ("invalid sprite " ++ (BSC.unpack spriteName)))
128+
(M.lookup (mk spriteName) (WAD.wadSprites wad))
82129
let loadedPalette = loadPalettes wad
83-
p <- loadSprite sprites
130+
p <- loadSprite sprite
84131
let spritePixels = unpackTuples (textureDataToColor loadedPalette p)
85132
let sW = fromIntegral $ WAD.pictureWidth $ WAD.spritePicture sprite
86133
let sH = fromIntegral $ WAD.pictureHeight $ WAD.spritePicture sprite
87-
n = length sprites
88134
texId <- withNewPtr (glGenTextures 1)
89135
glBindTexture GL_TEXTURE_2D texId
90136

@@ -93,7 +139,7 @@ makeSprite wad progId spriteName = do
93139
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (fromIntegral GL_NEAREST)
94140
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (fromIntegral GL_NEAREST)
95141
withArray spritePixels $
96-
glTexImage2D GL_TEXTURE_2D 0 (fromIntegral GL_RGBA) (sW * fromIntegral n) sH 0 GL_RGBA GL_FLOAT
142+
glTexImage2D GL_TEXTURE_2D 0 (fromIntegral GL_RGBA) sW sH 0 GL_RGBA GL_FLOAT
97143

98144
posAttrib <- get $ AttribLocation progId "position"
99145
glEnableVertexAttribArray posAttrib
@@ -119,7 +165,13 @@ makeSprite wad progId spriteName = do
119165
rdProg = progId,
120166
rdEbo = eboId}
121167

168+
let v3 = if isNothing thing then
169+
(V3 (vbo !! 0) (vbo !! 1) (vbo !! 2))
170+
else let jt = fromJust thing in
171+
(V3 (fromIntegral $ WAD.thingX jt) 0.0 (fromIntegral $ WAD.thingY jt))
172+
122173
Sprite <$> pure "Lev"
123174
<*> newIORef False
124175
<*> newIORef 0
125176
<*> pure renderData
177+
<*> pure v3

‎src/SpriteMap.hs

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,30 @@
1+
{-# LANGUAGE StandaloneDeriving #-}
2+
{-# LANGUAGE OverloadedStrings #-}
13
module SpriteMap where
4+
import Enemy
5+
6+
import qualified Game.Waddle as WAD
7+
import Data.Maybe
8+
9+
thingToSprite :: WAD.ThingType -> WAD.LumpName
10+
thingToSprite t
11+
= fromMaybe (error "NO THING")
12+
(lookup (thingTypeToInt t) thingIdToSprite)
13+
14+
reservedSpriteIds = [-1, 0, 1, 2, 3, 4, 11, 14]
15+
16+
thingTypeToInt :: Integral a => WAD.ThingType -> a
17+
thingTypeToInt t
18+
= thingTypeToInt' t [0..3006]
19+
where
20+
thingTypeToInt' t []
21+
= error "lol no"
22+
thingTypeToInt' t (x : xs)
23+
| t == WAD.thingTypeFromNumber x = x
24+
| otherwise = thingTypeToInt' t xs
225

326
thingIdToSprite = [
4-
(-1,"ffff"),
27+
((-1),"ffff"),
528
(0,"0000"),
629
(1,"PLAY"),
730
(2,"PLAY"),

0 commit comments

Comments
 (0)