adding player sprite and handling

2018-05-21 00:40:40 +02:00 · 2018-05-21 00:40:40 +02:00 · b72f2f744b
commit b72f2f744b
parent e8847f2aa0
6 changed files with 125 additions and 36 deletions
--- a/shell.nix
+++ b/shell.nix
@ -79,7 +79,7 @@ let

  f = { mkDerivation, astar, base, containers, linear
      , matrix, OpenGL, random, sdl2, stdenv, stm, text, unordered-containers
-      , vector
+      , vector, JuicyPixels, JuicyPixels-extra, bytestring
      }:
      mkDerivation {
        pname = "tracer-game";
@ -90,7 +90,8 @@ let
        enableExecutableProfiling = true;
        executableHaskellDepends = [
          affectionNeko astar base containers ecstasyNeko linear matrix nanovgNeko
-          OpenGL random sdl2 stm text unordered-containers vector
+          OpenGL random sdl2 stm text unordered-containers vector JuicyPixels
+          JuicyPixels-extra bytestring
        ];
        license = stdenv.lib.licenses.gpl3;
      };
--- a/src/Init.hs
+++ b/src/Init.hs
@ -10,9 +10,13 @@ import qualified SDL
 import qualified Graphics.Rendering.OpenGL as GL

 import NanoVG hiding (V2(..), V3(..))
+import NanoVG.Internal.Image (ImageFlags(..))

 import Linear

+import Codec.Picture as CP
+import Codec.Picture.Extra
+
 import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)

@ -22,6 +26,7 @@ import qualified Data.Set as S
 import qualified Data.Map.Strict as M
 import Data.Ecstasy
 import Data.Maybe
+import Data.ByteString.Lazy (toStrict)

 import System.Exit (exitFailure)

@ -72,12 +77,14 @@ load = do
  when (any isNothing mimgs) $ do
    logIO Error "Failed to load image assets"
    exitFailure
+  playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
+    (zipWith (\a b -> (a, [b])) [0..] [ImgIntrE .. ImgIntrNE])
  let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
  return UserData
    { state       = Menu
    , subsystems  = subs
    , assetImages = M.fromList
-      imgs
+      (imgs ++ playerImgs)
    , assetFonts  = M.fromList
      [ (FontBedstead, "bedstead")
      ]
@ -86,3 +93,31 @@ load = do
    , worldState  = ws
    , stateData   = None
    }
+
+loadPlayerSprite
+  :: FilePath         -- Path to spritemap
+  -> Int              -- width of single sprite
+  -> Int              -- height of single sprite
+  -> Context          -- Nanovg context
+  -> [(Int, [ImgId])] -- [(picture row, Image IDs)]
+  -> IO [(ImgId, NanoVG.Image)]
+loadPlayerSprite fp w h nvg rids = do
+  eimg <- readImage fp
+  case eimg of
+    Left err -> do
+      logIO Error err
+      exitFailure
+    Right dimg -> do
+      let img = convertRGBA8 dimg
+      ret <- mapM (\(row, ids) -> do
+        mapM (\(num, id) -> do
+          let cr = crop (num * w) (row * h) w h img
+          mresimg <- createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)
+          case mresimg of
+            Nothing     -> do
+              logIO Error ("Failed to load: " ++ fp ++ " " ++ show id)
+              exitFailure
+            Just resimg -> return (id, resimg)
+          ) (zip [0..] ids)
+        ) rids
+      return $ concat ret
--- a/src/NPC.hs
+++ b/src/NPC.hs
@ -3,6 +3,7 @@ module NPC where
 import Affection as A

 import qualified Data.Matrix as M
+import Data.Map.Strict as Map hiding (filter, null)
 import Data.Ecstasy as E

 import Control.Monad.IO.Class (MonadIO(..))
@ -26,18 +27,19 @@ import Types.Map
 import Types.ReachPoint

 drawNPCs
-  :: Context
+  :: Map ImgId Image
+  -> Context
  -> UserData
-  -> [V2 Double]
+  -> [(V2 Double, Direction)]
  -> Double
  -> Double
  -> Int
  -> Int
  -> Maybe ImgId
  -> IO ()
-drawNPCs ctx ud npcposs prow pcol row col img = do
-  let fnpcposs = filter
-        (\(V2 nr nc) ->
+drawNPCs ai ctx ud npcposrots prow pcol row col img = do
+  let fnpcposrots = filter
+        (\((V2 nr nc, dir)) ->
          let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
              y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
          in  ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
@ -48,18 +50,23 @@ drawNPCs ctx ud npcposs prow pcol row col img = do
            all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) &&
            (floor nr == row && floor nc == col)
          )
-        npcposs
+        npcposrots
  mapM_
-    (\(V2 nr nc) -> do
+    (\((V2 nr nc, dir)) -> do
      let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
          y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
      beginPath ctx
-      circle ctx x y 5
-      closePath ctx
-      fillColor ctx (rgba 255 0 0 255)
+      paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0
+        (ai Map.! (dirToImgId dir)) 1
+      rect ctx (x - realToFrac (tileWidth / 2)) (y - 58)
+        (realToFrac tileWidth) 74
+      fillPaint ctx paint
+      -- circle ctx x y 5
+      -- closePath ctx
+      -- fillColor ctx (rgba 255 0 0 255)
      fill ctx
      )
-    fnpcposs
+    fnpcposrots
  where
    tileWidth = 64 :: Double
    tileHeight = 32 :: Double
--- a/src/Test.hs
+++ b/src/Test.hs
@ -63,6 +63,7 @@ loadMap = do
      { pos = Just (V2 20.5 20.5)
      , vel = Just (V2 0 0)
      , player = Just ()
+      , rot = Just SE
      }
    void $ mapM_ (\npcpos@(V2 nr nc) -> do
      -- ttl <- liftIO $ randomRIO (5, 30)
@ -72,7 +73,8 @@ loadMap = do
      createEntity $ newEntity
        { pos      = Just (V2 (nr + 0.5) (nc + 0.5))
        , vel      = Just (V2 0 0)
-        , velFact = Just fact
+        , velFact  = Just fact
+        , rot      = Just SE
        , npcState = Just (NPCStanding 0 future)
        }
      ) npcposs
@ -128,20 +130,23 @@ drawMap :: Affection UserData ()
 drawMap = do
  ud <- getAffection
  dt <- getDelta
-  (_, (playerPos, npcposs)) <- liftIO $ yieldSystemT (worldState ud) $ do
-    pc <- efor allEnts $ do
+  (_, (playerPos, playerRot, npcposrots)) <- liftIO $ yieldSystemT (worldState ud) $ do
+    (pc, dir) <- fmap head $ efor allEnts $ do
      with player
      with pos
+      with rot
      pos' <- query pos
-      pure pos'
+      rot' <- query rot
+      pure (pos', rot')
  -- (_, npcposs) <- yieldSystemT (worldState ud) $ do
-    npcs <- efor allEnts $ do
+    npcsrots <- efor allEnts $ do
      with npcState
      with pos
      pos' <- query pos
-      pure pos'
-    return (pc, npcs)
-  let V2 pr pc = head playerPos
+      rot' <- query rot
+      pure (pos', rot')
+    return (pc, dir, npcsrots)
+  let V2 pr pc = playerPos
      mat = imgMat (stateData ud)
      ctx = nano ud
      cols = fromIntegral (ncols mat)
@ -167,9 +172,8 @@ drawMap = do
    fill ctx
    mapM_ (\(i, ls) -> mapM_
      (\(j, t) -> do
-        drawTile
-          (assetImages ud) ctx pr pc i j t
-        drawNPCs ctx ud npcposs pr pc i j t
+        drawTile (assetImages ud) ctx pr pc i j t (dirToImgId playerRot)
+        drawNPCs (assetImages ud) ctx ud npcposrots pr pc i j t
        )
        (reverse $ zip [1..] ls))
      (zip [1..] (toLists mat))
@ -182,6 +186,14 @@ drawMap = do

 updateMap :: Double -> Affection UserData ()
 updateMap dt = do
+  let direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0
+        then toEnum (
+          let xuu = floor
+                ((((acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel'))) /
+                  pi) + 0.25) * 4 )
+              xu = if vr < 0 then 7 - xuu else xuu
+          in  A.log A.Debug ("xu: " ++ show xu) xu)
+        else rot'
  ud <- getAffection
  (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
    emap allEnts $ do
@ -189,21 +201,26 @@ updateMap dt = do
      with vel
      with velFact
      with pos
+      with rot
      pos'@(V2 pr pc) <- query pos
      vel' <- query vel
+      rot' <- query rot
      fact' <- query velFact
      let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel'
          dpos = npos - pos'
          ent = unchanged
            { pos = Set $ npos
+            , rot = Set $ direction vel' rot'
            }
      return ent
    emap allEnts $ do
      with player
      with vel
      with pos
+      with rot
      pos'@(V2 pr pc) <- query pos
-      vel' <- query vel
+      vel'@(V2 vr vc) <- query vel
+      rot' <- query rot
      let npos@(V2 nr nc) = pos' + fmap (* dt) vel'
          dpos@(V2 dpr dpc) = npos - pos'
          len = sqrt (dpos `dot` dpos)
@ -250,6 +267,8 @@ updateMap dt = do
                  )
                (A.log A.Verbose (show lll ++ " " ++ show len) lll)
              )
+            , rot = Set (A.log A.Debug ("dir: " ++ show (direction vel' rot'))
+              (direction vel' rot'))
            }
      return ent
    updateNPCs
@ -271,8 +290,9 @@ drawTile
  -> Int
  -> Int
  -> Maybe ImgId
+  -> ImgId
  -> IO ()
-drawTile ai ctx pr pc row col img =
+drawTile ai ctx pr pc row col img playerImg =
  when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
    (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) $
      do
@ -330,9 +350,13 @@ drawTile ai ctx pr pc row col img =
    drawPlayer = do
      when (floor pr == row && floor pc == col) $ do
        beginPath ctx
-        circle ctx 640 360 5
-        closePath ctx
-        fillColor ctx (rgba 0 255 255 255)
+        paint <- imagePattern
+          ctx 608 302 64 74 0 (ai Map.! playerImg) 1
+        rect ctx 608 302 64 74
+        fillPaint ctx paint
+        -- circle ctx 640 360 5
+        -- closePath ctx
+        -- fillColor ctx (rgba 0 255 255 255)
        fill ctx

 checkBoundsCollision
--- a/src/Types/UserData.hs
+++ b/src/Types/UserData.hs
@ -62,6 +62,14 @@ data ImgId
  | ImgMiscTable3
  | ImgMiscTable4
  | ImgMiscTableCorner
+  | ImgIntrE
+  | ImgIntrSE
+  | ImgIntrS
+  | ImgIntrSW
+  | ImgIntrW
+  | ImgIntrNW
+  | ImgIntrN
+  | ImgIntrNE
  deriving (Show, Eq, Ord, Enum)

 isWall :: ImgId -> Bool
@ -136,14 +144,25 @@ data FontId
  deriving (Show, Eq, Ord, Enum)

 data Direction
-  = N
-  | W
-  | S
+  = NE
  | E
-  | NW
-  | SW
-  | NE
  | SE
+  | S
+  | SW
+  | W
+  | NW
+  | N
+  deriving (Show, Eq, Ord, Enum)
+
+dirToImgId :: Direction -> ImgId
+dirToImgId E  = ImgIntrE
+dirToImgId SE = ImgIntrSE
+dirToImgId S  = ImgIntrS
+dirToImgId SW = ImgIntrSW
+dirToImgId W  = ImgIntrW
+dirToImgId NW = ImgIntrNW
+dirToImgId N  = ImgIntrN
+dirToImgId NE = ImgIntrNE

 data Entity f = Entity
  { pos      :: Component f 'Field (V2 Double)
--- a/tracer-game.cabal
+++ b/tracer-game.cabal
@ -49,6 +49,9 @@ executable tracer-game
                     , vector
                     , astar
                     , unordered-containers
+                     , JuicyPixels
+                     , JuicyPixels-extra
+                     , bytestring
  hs-source-dirs:      src
  ghc-options:         -Wall -threaded
  default-language:    Haskell2010