fix broken textures and load NPC graphics

This commit is contained in:
nek0 2018-06-16 19:34:17 +02:00
parent 9ff57c47c7
commit 373daaa2c0
4 changed files with 21 additions and 14 deletions

View file

@ -3,6 +3,7 @@ module Load where
import Affection as A import Affection as A
import qualified SDL import qualified SDL
import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
import Control.Concurrent.MVar import Control.Concurrent.MVar
@ -56,7 +57,7 @@ loadFork
-> MVar Float -> MVar Float
-> IO () -> IO ()
loadFork ws (Just win) (Just glc) nvg future progress = do loadFork ws (Just win) (Just glc) nvg future progress = do
let stateSteps = 20 let stateSteps = 22
increment = 1 / stateSteps increment = 1 / stateSteps
SDL.glMakeCurrent win glc SDL.glMakeCurrent win glc
modifyMVar_ progress (return . (+ increment)) modifyMVar_ progress (return . (+ increment))
@ -107,26 +108,33 @@ loadFork ws (Just win) (Just glc) nvg future progress = do
-- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE]) -- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
directions = [E .. N] ++ [NE] directions = [E .. N] ++ [NE]
standIds = map (AnimId 0 "standing") directions standIds var = map (AnimId var "standing") directions
walkIds = map (AnimId 0 "walking") directions walkIds var = map (AnimId var "walking") directions
standConfigs = map standConfigs = map
(\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop) (\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop)
[0 .. length standIds - 1] [0 .. length (standIds 0) - 1]
walkConfigs = map walkConfigs = map
(\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop) (\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop)
[0 .. length walkIds - 1] [0 .. length (walkIds 0) - 1]
playerStanding <- loadAnimationSprites "assets/intruder.png" nvg playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
(zip standIds standConfigs) (zip (standIds 0) standConfigs)
liftIO $modifyMVar_ progress (return . (+ increment)) liftIO $modifyMVar_ progress (return . (+ increment))
playerWalking <- loadAnimationSprites "assets/intruder.png" nvg playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
(zip walkIds walkConfigs) (zip (walkIds 0) walkConfigs)
modifyMVar_ progress (return . (+ increment)) modifyMVar_ progress (return . (+ increment))
jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
(zip (standIds 1) standConfigs)
liftIO $modifyMVar_ progress (return . (+ increment))
jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
(zip (walkIds 1) walkConfigs)
modifyMVar_ progress (return . (+ increment))
finish
putMVar future putMVar future
( ws ( ws
, LoadData , LoadData
{ loadAssetImages = M.fromList imgs { loadAssetImages = M.fromList imgs
, loadAssetAnims = M.fromList , loadAssetAnims = M.fromList
(playerStanding ++ playerWalking) (playerStanding ++ playerWalking ++ jdoemStanding ++ jdoemWalking)
} }
) )

View file

@ -4,8 +4,6 @@ module Main where
import Affection as A import Affection as A
import qualified SDL import qualified SDL
import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL
import NanoVG hiding (V2(..), V3(..)) import NanoVG hiding (V2(..), V3(..))
@ -49,7 +47,7 @@ pre :: Affection UserData ()
pre = do pre = do
ad <- A.get ad <- A.get
ud <- getAffection ud <- getAffection
_ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 -- _ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
threadContext <- SDL.glCreateContext (drawWindow ad) threadContext <- SDL.glCreateContext (drawWindow ad)
SDL.glMakeCurrent (drawWindow ad) (glContext ad) SDL.glMakeCurrent (drawWindow ad) (glContext ad)
Subsystems w m <- subsystems <$> getAffection Subsystems w m <- subsystems <$> getAffection

View file

@ -97,7 +97,7 @@ loadMapFork ud future progress = do
, velFact = Just fact , velFact = Just fact
, rot = Just SE , rot = Just SE
, npcState = Just (NPCStanding 0 future) , npcState = Just (NPCStanding 0 future)
, anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 , anim = Just $ AnimState (AnimId 1 "standing" SE) 0 0
} }
) npcposs ) npcposs
void $ liftIO $ swapMVar progress (16 / loadSteps) void $ liftIO $ swapMVar progress (16 / loadSteps)
@ -238,7 +238,7 @@ drawTile ud ctx posanims pr pc row col img =
((realToFrac x :: Double) < 1280 && ((realToFrac x :: Double) < 1280 &&
(realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $ (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $
do do
let (bef, beh) = L.partition delimiter posanims let (bef, beh) = L.partition delimiter sorted
save ctx save ctx
mapM_ drawAnim beh mapM_ drawAnim beh
when (isJust img) drawImage when (isJust img) drawImage

View file

@ -209,7 +209,8 @@ loadAnimationSprites fp nvg idconfs = do
[0 .. (count - 1)] [0 .. (count - 1)]
mresimgs <- mapM mresimgs <- mapM
(\cr -> (\cr ->
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)) createImageMem nvg
(ImagePremultiplied) (toStrict $ encodePng cr))
crs crs
imgs <- if any isNothing mresimgs imgs <- if any isNothing mresimgs
then do then do