Improve wall squashing further

2026-03-26 20:25:59 +00:00
parent 62a37388e7
commit 0ddedf7fd6
9 changed files with 99 additions and 79 deletions
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.TestString where

+import Dodge.WallCreatureCollisions
 import Data.List ((\\))
 import ShortShow
 import Geometry
@@ -34,6 +35,22 @@ import RandomHelp

 testStringInit :: Universe -> [String]
 testStringInit u = (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crWallTouch)
+    <> fromMaybe [] (do
+    w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18
+    w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61
+    let 
+        f = uncurry (-) . (^. wlLine)
+        g = argV . f
+        h = normalizeV . uncurry (-) . (^. wlLine)
+        a = angleVV (f w1) (f w2)
+    return [show $ wlWlCrush w1 w2, show a , show (f w1), show (f w2)
+        , show $ g w1
+        , show $ g w2
+        , show $ h w1
+        , show $ h w2
+        , show (norm (h w1 + h w2))
+        ]
+    )
 --    <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
 --testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
 --testStringInit u =  map show