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

115
src/Test.hs
View file

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