nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

blargh

Browse source
This commit is contained in:
nek0 2018-02-24 22:24:48 +01:00
parent d02c6e0a2b
commit 86d5ba6dc4
2 changed files with 7 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Floorplan.hs
View file

@ -309,7 +309,7 @@ buildDoorsGraph mat =
then [(fr, fc + 1)] then [(fr, fc + 1)]
else []) else [])
in foldl flood (acc ++ ncoords) ncoords in foldl flood (acc ++ ncoords) ncoords
roomcoords = flood [] coord roomcoords = flood [coord] coord
b = Boundaries b = Boundaries
(minimum (map fst roomcoords), minimum (map snd roomcoords)) (minimum (map fst roomcoords), minimum (map snd roomcoords))
(maximum (map fst roomcoords), maximum (map snd roomcoords)) (maximum (map fst roomcoords), maximum (map snd roomcoords))

12
src/Test.hs
View file

@ -27,7 +27,7 @@ import Debug.Trace
loadMap :: Affection UserData () loadMap :: Affection UserData ()
loadMap = do loadMap = do
ud <- getAffection ud <- getAffection
let fc = FloorConfig (20, 20) [(5,5), (45, 95)] (50,100) let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,80)
(Subsystems _ m) = subsystems ud (Subsystems _ m) = subsystems ud
matrix <- liftIO $ buildHallFloorIO fc matrix <- liftIO $ buildHallFloorIO fc
(nws, nworld) <- yieldSystemT (worldState ud) $ do (nws, nworld) <- yieldSystemT (worldState ud) $ do
@ -104,7 +104,7 @@ drawMap = do
(zip [0..] (toLists matrix)) (zip [0..] (toLists matrix))
updateMap :: Double -> Affection UserData () updateMap :: Double -> Affection UserData ()
updateMap _ = do updateMap dt = do
ud <- getAffection ud <- getAffection
(nws, nw) <- yieldSystemT (worldState ud) $ do (nws, nw) <- yieldSystemT (worldState ud) $ do
emap $ do emap $ do
@ -112,7 +112,7 @@ updateMap _ = do
pos' <- E.get pos pos' <- E.get pos
vel' <- E.get vel vel' <- E.get vel
pure $ defEntity' pure $ defEntity'
{ pos = Set $ pos' + vel' { pos = Set $ pos' + fmap (* (4 * dt)) vel'
} }
getWorld getWorld
putAffection ud putAffection ud
@ -131,12 +131,12 @@ drawTile row col tile = do
let V2 pr pc = head playerPos let V2 pr pc = head playerPos
ctx = nano ud ctx = nano ud
(xinit, yinit) = initCoords $ stateData ud (xinit, yinit) = initCoords $ stateData ud
tileWidth = 20 :: Double tileWidth = 64 :: Double
tileHeight = 10 :: Double tileHeight = 32 :: Double
liftIO $ do liftIO $ do
save ctx save ctx
beginPath ctx beginPath ctx
let x = realToFrac $ 650 + ((fromIntegral col - pc) + let x = realToFrac $ (640 + tileWidth / 2) + ((fromIntegral col - pc) +
(fromIntegral row - pr)) * (tileWidth / 2) (fromIntegral row - pr)) * (tileWidth / 2)
y = realToFrac $ 360 + ((fromIntegral row - pr) - y = realToFrac $ 360 + ((fromIntegral row - pr) -
(fromIntegral col - pc)) * (tileHeight / 2) (fromIntegral col - pc)) * (tileHeight / 2)