From 373daaa2c020a80e09511c64334817644c472011 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 Jun 2018 19:34:17 +0200 Subject: [PATCH] fix broken textures and load NPC graphics --- src/Load.hs | 24 ++++++++++++++++-------- src/Main.hs | 4 +--- src/Test.hs | 4 ++-- src/Util.hs | 3 ++- 4 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/Load.hs b/src/Load.hs index 7c6d878..8a6367c 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -3,6 +3,7 @@ module Load where import Affection as A import qualified SDL +import Graphics.Rendering.OpenGL.GL.FlushFinish (finish) import Control.Concurrent (forkIO) import Control.Concurrent.MVar @@ -56,7 +57,7 @@ loadFork -> MVar Float -> IO () loadFork ws (Just win) (Just glc) nvg future progress = do - let stateSteps = 20 + let stateSteps = 22 increment = 1 / stateSteps SDL.glMakeCurrent win glc 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]) let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs directions = [E .. N] ++ [NE] - standIds = map (AnimId 0 "standing") directions - walkIds = map (AnimId 0 "walking") directions + standIds var = map (AnimId var "standing") directions + walkIds var = map (AnimId var "walking") directions standConfigs = map (\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop) - [0 .. length standIds - 1] + [0 .. length (standIds 0) - 1] walkConfigs = map (\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 - (zip standIds standConfigs) + (zip (standIds 0) standConfigs) liftIO $modifyMVar_ progress (return . (+ increment)) playerWalking <- loadAnimationSprites "assets/intruder.png" nvg - (zip walkIds walkConfigs) + (zip (walkIds 0) walkConfigs) 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 ( ws , LoadData { loadAssetImages = M.fromList imgs , loadAssetAnims = M.fromList - (playerStanding ++ playerWalking) + (playerStanding ++ playerWalking ++ jdoemStanding ++ jdoemWalking) } ) diff --git a/src/Main.hs b/src/Main.hs index 82f2064..9066b1a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,8 +4,6 @@ module Main where import Affection as A import qualified SDL -import qualified SDL.Raw.Video as SDL (glSetAttribute) -import qualified SDL.Raw.Enum as SDL import NanoVG hiding (V2(..), V3(..)) @@ -49,7 +47,7 @@ pre :: Affection UserData () pre = do ad <- A.get 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) SDL.glMakeCurrent (drawWindow ad) (glContext ad) Subsystems w m <- subsystems <$> getAffection diff --git a/src/Test.hs b/src/Test.hs index 0176d92..2511a2f 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -97,7 +97,7 @@ loadMapFork ud future progress = do , velFact = Just fact , rot = Just SE , npcState = Just (NPCStanding 0 future) - , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 + , anim = Just $ AnimState (AnimId 1 "standing" SE) 0 0 } ) npcposs void $ liftIO $ swapMVar progress (16 / loadSteps) @@ -238,7 +238,7 @@ drawTile ud ctx posanims pr pc row col img = ((realToFrac x :: Double) < 1280 && (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $ do - let (bef, beh) = L.partition delimiter posanims + let (bef, beh) = L.partition delimiter sorted save ctx mapM_ drawAnim beh when (isJust img) drawImage diff --git a/src/Util.hs b/src/Util.hs index ea539a1..0730b75 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -209,7 +209,8 @@ loadAnimationSprites fp nvg idconfs = do [0 .. (count - 1)] mresimgs <- mapM (\cr -> - createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)) + createImageMem nvg + (ImagePremultiplied) (toStrict $ encodePng cr)) crs imgs <- if any isNothing mresimgs then do