justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Delete cruft, add Reader monad to some internal ai

Browse Source
This commit is contained in:
justin
2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+12 -12
View File
@@ -25,7 +25,7 @@ import Data.Maybe
import Data.Tree
import Data.Either
import Data.Function
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Graph hiding ((&))
import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.NodeMap
@@ -61,16 +61,17 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
updateWallZoning :: World -> World
updateWallZoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w)) w
where
wallInZone wl | uncurry dist (_wlLine wl) <= 2*zoneSize
= insertIMInZone x y wlid wl
| otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
where (x,y) = zoneOfPoint $ (uncurry pHalf (_wlLine wl))
wlid = _wlID wl
ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
wallInZone wl
| uncurry dist (_wlLine wl) <= 2*zoneSize = insertIMInZone x y wlid wl
| otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
where
(x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
wlid = _wlID wl
ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
makePath :: Tree Room -> [(Point2,Point2)]
makePath = concat . map _rmPath . flatten
makePath = concatMap _rmPath . flatten
-- consider nubbing walls after dividing them
wallsFromTree :: Tree Room -> IM.IntMap Wall
@@ -81,7 +82,7 @@ wallsFromTree t =
. removeInverseWalls
. foldr cutWalls [] -- map (map (g . roundPoint2))
-- . map (map roundPoint2)
$ (concatMap _rmPolys $ flatten t)
$ concatMap _rmPolys (flatten t)
where
assignKeys = IM.fromList . zip [0..] . zipWith f [0..]
f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
@@ -98,9 +99,8 @@ wallsFromRooms =
divideWall :: Wall -> [Wall]
divideWall wl
= let (a,b) = _wlLine wl
--ps = divideLine (zoneSize * 2) a b
ps = divideLine (zoneSize * 2) a b
in map (\(x,y) -> wl {_wlLine = (x,y)}) $ zip (init ps) (tail ps)
in zipWith (\ x y -> wl & wlLine .~ (x,y) ) (init ps) (tail ps)
divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
divideWallIn wl wls =
@@ -130,7 +130,7 @@ shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
(_rmLinks t)
ts
where
f r = shiftRoomBy ((0,0) -.- (rotateV (pi-a) p),0) $ shiftRoomBy ((0,0),pi-a) r
f r = shiftRoomBy ( (0,0) -.- rotateV (pi-a) p , 0) $ shiftRoomBy ((0,0),pi-a) r
where
(p,a) = last $ _rmLinks r