Nub close points for game room boundaries

2021-10-04 09:39:18 +01:00
parent df9a8ea242
commit c8e08d903e
8 changed files with 67 additions and 95 deletions
@@ -25,7 +25,7 @@ import Tile
 import Polyhedra
 import Polyhedra.Data

-import Data.List (nub)
+import Data.List (nubBy)
 import Control.Monad.State
 import Control.Lens
 import System.Random
@@ -123,10 +123,12 @@ gameRoomsFromRooms = map f
    f rm = GameRoom
        { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
        , _grViewpointsEx = map fst (_rmLinks rm)
-        , _grBound = expandPolyByFixed 100 . convexHullSafe . nub . concat $ _rmBound rm ++ _rmPolys rm
+        , _grBound = expandPolyByFixed 100 . convexHullSafe . nubBy closePoints 
+            . concat $ _rmBound rm ++ _rmPolys rm
        , _grDir   = snd . last $ _rmLinks rm
        , _grName  = _rmName rm
        }
+    closePoints x y = dist x y < 1

 floorsFromRooms :: [Room] -> [(Point3,Point3)]
 floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)