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 Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM
@ -20,6 +21,9 @@ import Control.Concurrent.STM
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.Ecstasy
import Data.Maybe
import System.Exit (exitFailure)
import Foreign.C.Types (CInt(..))
@ -40,10 +44,16 @@ load = do
<$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO [])
(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
{ state = Menu
, subsystems = subs
, assetImages = M.empty -- FILLME!
, assetImages = M.fromList
[ (ImgWall, fromJust mwall)
]
, nano = nvg
, uuid = []
, 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.IO.Class (liftIO)
import Data.Map.Strict as Map
import Data.Matrix as M (toLists, (!))
import Data.Ecstasy as E
@ -66,6 +67,8 @@ mouseToPlayer mv2 = do
(nws, _) <- yieldSystemT (worldState ud) $ do
emap $ do
with player
pos' <- E.get pos
liftIO $ logIO A.Debug $ show pos'
pure $ defEntity'
{ vel = Set $ V2 dr dc
}
@ -123,7 +126,7 @@ updateMap dt = do
}
| otherwise =
defEntity'
pure ent
return ent
putAffection ud
{ worldState = nws
}
@ -146,7 +149,7 @@ drawTile row col tile = do
beginPath ctx
let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) +
(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)
fillColor ctx (case tile of
Wall -> rgba 128 128 128 255
@ -158,13 +161,22 @@ drawTile row col tile = do
Elev -> rgba 0 0 0 255
_ -> rgba 255 255 0 255
)
moveTo ctx x y
lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight / 2)
lineTo ctx (x + realToFrac tileWidth) y
lineTo ctx (x + realToFrac tileWidth / 2) (y - realToFrac tileHeight / 2)
moveTo ctx x (y + realToFrac tileHeight / 2)
lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight)
lineTo ctx (x + realToFrac tileWidth) (y + realToFrac tileHeight / 2)
lineTo ctx (x + realToFrac tileWidth / 2) y
closePath 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
circle ctx 640 360 5
closePath ctx

View File

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