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

linted

Browse source
This commit is contained in:
nek0 2018-02-28 21:30:59 +01:00
parent fa0ca04128
commit 0ba795e904
2 changed files with 79 additions and 70 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
src/Floorplan.hs
View file

@ -39,10 +39,10 @@ buildElevator fc (gen, empty) =
boxCoord x = (,) <$> [row - x .. row + x] <*> [col - x .. col + x]
buildShaft = foldl
(\acc coord -> M.setElem (replaceTile (acc M.! coord) Hall) coord acc)
(foldl (\acc coord -> M.setElem Wall coord acc) empty (boxCoord 2))
(foldl (flip $ M.setElem Wall) empty (boxCoord 2))
(boxCoord 5)
elvDoor = M.setElem Door (row + 2, col) buildShaft
in (gen, foldl (\acc coord -> M.setElem Elev coord acc) elvDoor (boxCoord 1))
in (gen, foldl ( flip $ M.setElem Elev) elvDoor (boxCoord 1))
placeHalls
:: StdGen
@ -51,7 +51,7 @@ placeHalls
-> (StdGen, Matrix TileState)
placeHalls rng fc input =
doHalls rng
[(Boundaries (1,1) (nrows input, ncols input))]
[Boundaries (1,1) (nrows input, ncols input)]
(elevator fc) 5 input
where
doHalls rand bs cross wmax mat =
@ -61,7 +61,7 @@ placeHalls rng fc input =
(nw, g3) = randomR (2, wmax) g2
(nbs, nmat) = buildHall cross nw b amat
in
if hallRatio nmat < 0.2 && wmax - 1 > 2
if hallRatio nmat < 0.25 && wmax - 1 > 2
then doHalls g3 nbs (row, col) (wmax -1) nmat
else (g3, nmat)
) (rand, mat) bs
@ -77,18 +77,18 @@ buildHall
-> Matrix TileState
-> ([Boundaries], Matrix TileState)
buildHall coord@(row, col) width bs mat =
let vertHalls = foldl (\acc c -> M.mapCol
let vertHalls = foldl (flip (M.mapCol
(\r cur -> if r >= fst (matmin bs) && r <= fst (matmax bs)
then replaceTile cur Hall
else cur
) c acc)
)))
mat
[col - (width `div` 2) .. col + (width `div` 2)]
horzHalls = foldl (\acc r -> M.mapRow
horzHalls = foldl (flip ( M.mapRow
(\c cur -> if c >= snd (matmin bs) && c <= snd (matmax bs)
then replaceTile cur Hall
else cur
) r acc)
)))
vertHalls
[row - (width `div` 2) .. row + (width `div` 2)]
in ( [ Boundaries (matmin bs) coord
@ -147,8 +147,8 @@ buildInnerWalls rng input =
mat
else
let btups = (,)
<$> [fst (coord) .. maxRow]
<*> [snd (coord) .. maxCol]
<$> [fst coord .. maxRow]
<*> [snd coord .. maxCol]
in
( g2
, foldl
@ -163,7 +163,7 @@ buildInnerWalls rng input =
-> Matrix TileState
-> (StdGen, Matrix TileState)
doCross gen cd@(xr, xc) b imat =
let nbs = map (\(mi, ma) -> Boundaries mi ma) bs
let nbs = map (uncurry Boundaries) bs
bs =
[ (matmin b, cd)
, ((fst (matmin b), col), (row, snd (matmax b)))
@ -211,7 +211,7 @@ closeOffices input =
let tups mat = (,) <$> [2 .. nrows mat - 1] <*> [2 .. ncols mat - 1]
isNeighbor (row, col) =
let subm = M.submatrix (row -1) (row + 1) (col - 1) (col + 1) input
in any (== Hall) (M.toList subm)
in Hall `elem` (M.toList subm)
in foldl (\acc coord ->
if input M.! coord == Offi && isNeighbor coord
then M.setElem Wall coord acc
@ -223,14 +223,14 @@ buildOuterWalls input =
let horz :: Matrix TileState
horz =
foldl
(\amat r -> M.mapRow (\_ _ -> Wall) r amat)
(flip $ M.mapRow (\_ _ -> Wall))
input
[ 1
, nrows input
]
vert =
foldl
(\amat c -> M.mapCol (\_ _ -> Wall) c amat)
(flip $ M.mapCol (\_ _ -> Wall))
horz
[ 1
, ncols horz
@ -249,7 +249,7 @@ buildFacilities gen fc input =
in
if cur == ts || cur /= Offi
then mat
else foldl (\acc cs -> flood ts acc cs)
else foldl (flood ts)
altered
[ (cr + 1, cc)
, (cr - 1, cc)
@ -257,11 +257,11 @@ buildFacilities gen fc input =
, (cr, cc - 1)
]
nearests = map (findNearestOffice input) (facilities fc)
in (foldl (\(agen, acc) x ->
in foldl (\(agen, acc) x ->
let (numfac, ngen) = randomR (0 :: Int, 1 :: Int) agen
facil = if numfac == 1 then Kitc else Toil
in (ngen, flood facil acc x)
) (gen, input) nearests)
) (gen, input) nearests
findNearestOffice
:: Matrix TileState

115
src/Test.hs
View file

@ -182,72 +182,81 @@ drawTile row col tile = do
closePath ctx
fill ctx
when (tile == Wall) $ do
let img = case neighWalls row col mat of
let img irow icol = case neighWalls irow icol mat of
4 ->
assetImages ud Map.! ImgWallCross
ImgWallCross
3
| M.safeGet (row + 1) col mat /= Just Wall &&
M.safeGet (row + 1) col mat /= Just Door ->
assetImages ud Map.! ImgWallTNW
| M.safeGet row (col + 1) mat /= Just Wall &&
M.safeGet row (col + 1) mat /= Just Door ->
assetImages ud Map.! ImgWallTSW
| M.safeGet (row - 1) col mat /= Just Wall &&
M.safeGet (row - 1) col mat /= Just Door ->
assetImages ud Map.! ImgWallTSE
| M.safeGet (irow + 1) icol mat /= Just Wall &&
M.safeGet (irow + 1) icol mat /= Just Door ->
ImgWallTNW
| M.safeGet irow (icol + 1) mat /= Just Wall &&
M.safeGet irow (icol + 1) mat /= Just Door ->
ImgWallTSW
| M.safeGet (irow - 1) icol mat /= Just Wall &&
M.safeGet (irow - 1) icol mat /= Just Door ->
ImgWallTSE
| otherwise ->
assetImages ud Map.! ImgWallTNE
ImgWallTNE
2
| (M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) &&
(M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door) ->
assetImages ud Map.! ImgWallDesc
| (M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door) &&
(M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallAsc
| (M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door) &&
(M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerW
| (M.safeGet row (col - 1) mat == Just Wall ||
M.safeGet row (col - 1) mat == Just Door) &&
(M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) ->
assetImages ud Map.! ImgWallCornerS
| (M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door) &&
(M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door) ->
assetImages ud Map.! ImgWallCornerE
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) ->
ImgWallDesc
| (M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallAsc
| (M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallCornerW
| (M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) &&
(M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) ->
ImgWallCornerS
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) ->
ImgWallCornerE
| otherwise ->
assetImages ud Map.! ImgWallCornerN
ImgWallCornerN
1
| M.safeGet (row - 1) col mat == Just Wall ||
M.safeGet (row - 1) col mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet (row + 1) col mat == Just Wall ||
M.safeGet (row + 1) col mat == Just Door ->
assetImages ud Map.! ImgWallDesc
| M.safeGet row (col + 1) mat == Just Wall ||
M.safeGet row (col + 1) mat == Just Door ->
assetImages ud Map.! ImgWallAsc
| M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door ->
ImgWallAsc
| otherwise ->
assetImages ud Map.! ImgWallAsc
ImgWallAsc
0 ->
assetImages ud Map.! ImgWallCross
ImgWallCross
_ ->
error "unexpected number if neighbouring walls"
mat = mapMat (stateData ud)
dist = distance (V2 (fromIntegral row) (fromIntegral col))
(V2 (realToFrac pr - 0.5) (realToFrac pc + 0.5)) / 4
fact = if floor pr <= row && floor pc >= col
then min 1 dist
else 1
paint <- imagePattern
ctx x (y - (74 - realToFrac tileHeight)) 64 74 0
img
1
ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74 0
(assetImages ud Map.! img row col)
fact
-- ( if floor pr <= row && floor pc >= col
-- then min 1 dist
-- else 1
-- )
beginPath ctx
rect ctx x (y - (74 - realToFrac tileHeight)) 64 74
rect ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74
fillPaint ctx paint
fill ctx
when (floor pr == row && floor pc == col) $ do