Abstract out block placement

2022-06-27 13:38:46 +01:00
parent c8710fe92a
commit fec72cdf48
14 changed files with 105 additions and 55 deletions
@@ -0,0 +1,17 @@
+module Bound where
+import Geometry
+
+import Control.Lens
+import Streaming
+import qualified Streaming.Prelude as S
+import qualified Control.Foldl as L
+
+boundPoints :: Stream (Of Point2) Identity () -> Maybe (Float,Float,Float,Float)
+boundPoints = f . runIdentity . L.purely S.fold_ ((,,,) 
+    <$> L.premap (^?! _2) L.maximum
+    <*> L.premap (^?! _2) L.minimum
+    <*> L.premap (^?! _1) L.maximum
+    <*> L.premap (^?! _1) L.minimum
+    )
+  where
+    f (mn,ms,me,mw) = (,,,) <$> mn <*> ms <*> me <*> mw