placeholder walls

This commit is contained in:
nek0 2018-02-25 10:30:13 +01:00
parent 917351aee1
commit 36ad09bdbe
7 changed files with 32 additions and 9 deletions

BIN
assets/intruder.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
assets/wall_template.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

BIN
assets/walls/wall_desc.kra Normal file

Binary file not shown.

BIN
assets/walls/wall_desc.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 588 B

View file

@ -13,6 +13,7 @@ import NanoVG hiding (V2(..), V3(..))
import Linear import Linear
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM import Control.Concurrent.STM
@ -20,6 +21,9 @@ import Control.Concurrent.STM
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Ecstasy import Data.Ecstasy
import Data.Maybe
import System.Exit (exitFailure)
import Foreign.C.Types (CInt(..)) import Foreign.C.Types (CInt(..))
@ -40,10 +44,16 @@ load = do
<$> (Window <$> newTVarIO []) <$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO []) <*> (Mouse <$> newTVarIO [])
(ws, _) <- yieldSystemT (0, defWorld) (return ()) (ws, _) <- yieldSystemT (0, defWorld) (return ())
mwall <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
when (isNothing mwall) $ do
logIO Error "Failed to load wall"
exitFailure
return UserData return UserData
{ state = Menu { state = Menu
, subsystems = subs , subsystems = subs
, assetImages = M.empty -- FILLME! , assetImages = M.fromList
[ (ImgWall, fromJust mwall)
]
, nano = nvg , nano = nvg
, uuid = [] , uuid = []
, worldState = ws , worldState = ws

View file

@ -9,6 +9,7 @@ import qualified Graphics.Rendering.OpenGL as GL hiding (get)
import Control.Monad (when, void) import Control.Monad (when, void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Map.Strict as Map
import Data.Matrix as M (toLists, (!)) import Data.Matrix as M (toLists, (!))
import Data.Ecstasy as E import Data.Ecstasy as E
@ -66,6 +67,8 @@ mouseToPlayer mv2 = do
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
emap $ do emap $ do
with player with player
pos' <- E.get pos
liftIO $ logIO A.Debug $ show pos'
pure $ defEntity' pure $ defEntity'
{ vel = Set $ V2 dr dc { vel = Set $ V2 dr dc
} }
@ -123,7 +126,7 @@ updateMap dt = do
} }
| otherwise = | otherwise =
defEntity' defEntity'
pure ent return ent
putAffection ud putAffection ud
{ worldState = nws { worldState = nws
} }
@ -146,7 +149,7 @@ drawTile row col tile = do
beginPath ctx beginPath ctx
let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) + let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) +
(fromIntegral row - pr + 1)) * (tileWidth / 2) (fromIntegral row - pr + 1)) * (tileWidth / 2)
y = realToFrac $ 360 + ((fromIntegral row - pr + 1) - y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr + 1) -
(fromIntegral col - pc + 1)) * (tileHeight / 2) (fromIntegral col - pc + 1)) * (tileHeight / 2)
fillColor ctx (case tile of fillColor ctx (case tile of
Wall -> rgba 128 128 128 255 Wall -> rgba 128 128 128 255
@ -158,13 +161,22 @@ drawTile row col tile = do
Elev -> rgba 0 0 0 255 Elev -> rgba 0 0 0 255
_ -> rgba 255 255 0 255 _ -> rgba 255 255 0 255
) )
moveTo ctx x y moveTo ctx x (y + realToFrac tileHeight / 2)
lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight / 2) lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight)
lineTo ctx (x + realToFrac tileWidth) y lineTo ctx (x + realToFrac tileWidth) (y + realToFrac tileHeight / 2)
lineTo ctx (x + realToFrac tileWidth / 2) (y - realToFrac tileHeight / 2) lineTo ctx (x + realToFrac tileWidth / 2) y
closePath ctx closePath ctx
fill ctx fill ctx
when (floor pr + 1 == row && floor pc - 1 == col) $ do when (tile == Wall) $ do
paint <- imagePattern
ctx x (y - (74 - realToFrac tileHeight)) 64 74 0
((assetImages ud) Map.! ImgWall)
1
beginPath ctx
rect ctx x (y - (74 - realToFrac tileHeight)) 64 74
fillPaint ctx paint
fill ctx
when (floor pr == row && floor pc == col) $ do
beginPath ctx beginPath ctx
circle ctx 640 360 5 circle ctx 640 360 5
closePath ctx closePath ctx

View file

@ -37,7 +37,8 @@ data StateData
} }
data ImgId data ImgId
= ImgFloor = ImgWall
deriving (Show, Eq, Ord)
data Direction data Direction
= N = N