Add IntMapHelper, locate wall cutting bug

2021-05-22 15:14:21 +02:00
parent 26f0ca4ab5
commit 9c2bcbec10
35 changed files with 221 additions and 139 deletions
@@ -0,0 +1,34 @@
+module Dodge.Debug.LinkDecoration
+    ( addRoomLinkDecorations
+    , addRoomPolyDecorations
+    ) where
+import Dodge.Data
+--import Dodge.Base
+import Dodge.Room.Data
+import Dodge.Picture.Layer
+import Picture
+import qualified IntMapHelp as IM
+import Geometry.Vector
+
+import Control.Lens
+
+addRoomPolyDecorations :: [Room] -> World -> World
+addRoomPolyDecorations rms w = w & decorations %~ 
+    IM.insertWithNewKeys (map roomPolyDecorations rms)
+
+addRoomLinkDecorations :: [Room] -> World -> World
+addRoomLinkDecorations rms w = w & decorations %~ 
+    IM.insertWithNewKeys (map roomLinkDecorations rms)
+
+roomLinkDecorations :: Room -> Picture
+roomLinkDecorations rm = pictures . map linkDecoration $ _rmLinks rm 
+
+linkDecoration :: (Point2,Float) -> Picture
+linkDecoration (p,a) = setLayer 1 . onLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)]
+
+roomPolyDecorations :: Room -> Picture
+roomPolyDecorations rm = pictures . map polyWireFrame $ _rmPolys rm
+
+polyWireFrame :: [Point2] -> Picture
+polyWireFrame (x:xs) = setLayer 1 . onLayer DebugLayer . color green $ line $ (x:xs) ++ [x]
+polyWireFrame _ = undefined