Refactor window block

src/Dodge/LevelGen.hs

@@ -16,6 +16,7 @@ import Dodge.Data
 import Dodge.Base
 
 import Dodge.LevelGen.Block
+import Dodge.LevelGen.WindowBlock
 import Dodge.LevelGen.Pathing
 import Dodge.LevelGen.StaticWalls
 import Dodge.LevelGen.AutoDoor
@@ -85,7 +86,7 @@ placeSpot ps w = case ps of
                             (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
 
     PS {_psPos = p, _psRot = rot, _psType = PutWindowBlock a b}
-        -> putWindowBlock (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
+        -> putWindowBlock' (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
 
     PS {_psPos = p, _psRot = rot, _psType = PutWindow { _pwPoly = ps, _pwColor = c }}
         -> rmCrossPaths $ over walls (addWindow (q:qs) c) w
@@ -119,71 +120,6 @@ instance Shiftable PlacementSpot where
     translateS p' (PS p r x) = PS (p +.+ p') r x
     rotateS    r' (PS p r x) = PS (rotateV r' p) (r + r') x
 
-putWindowBlock :: Point2 -> Point2 -> World -> World
-putWindowBlock a b w = removePathsCrossing a b $ foldr (makeBlockAt bSide) w $ zip ps ns
-    where d = dist a b
-          rot = argV (b -.- a)
-          numPoints' = floor (d / 20)
-          numPoints = numPoints'*2
-          ns = take (numPoints+1) [0..]
-          ps = map (\i -> a +.+ i/ (fromIntegral numPoints) *.* (b -.- a)) 
-                   $ map fromIntegral ns
-          bSide = d / (fromIntegral numPoints)
-          makeBlockAt :: Float -> (Point2,Int) -> World -> World
-          makeBlockAt bSide (p,i) w = 
-            let k = newKey $ _walls w
-                ds = [(-bSide,-9),(-bSide,9),(bSide,9),(bSide,-9)]
-                polyAtP p = map ((+.+) p . rotateV rot) ds
-                hp = 1
-                degradeHP = [5,5]
-                winCol = withAlpha 0.5 cyan
-                ksAtN i = [k+i*4,k+i*4 + 1 ,k+i*4 +2, k+i*4+3]
-                (k0:k1:k2:k3:_) = ksAtN i
-                (bl:tl:tr:br:_) = polyAtP p
-                shadows | i == 0 = ksAtN 1
-                        | i == numPoints - 1 = ksAtN $ numPoints - 2
-                        | otherwise = ksAtN (i-1) ++ ksAtN (i+1)
-                seen | even i    = True
-                     | otherwise = False
-                isLeftmost | i == 0 = True
-                           | otherwise = False
-                isRightmost | i == numPoints = True
-                            | otherwise = False
-                l = baseBlock 
-                        { _wlLine = [bl,tl]
-                        , _wlID = k0
-                        , _blVisible = isLeftmost
-                        }
-                t = baseBlock 
-                        { _wlLine = [tl,tr]
-                        , _wlID = k1
-                        , _blVisible = seen
-                        }
-                r = baseBlock 
-                        { _wlLine = [tr,br]
-                        , _wlID = k2
-                        , _blVisible = isRightmost
-                        }
-                b = baseBlock 
-                        { _wlLine = [br,bl]
-                        , _wlID = k3
-                        , _blVisible = seen
-                        }
-                baseBlock = Block
-                        { _wlLine = []
-                        , _wlID = 0
-                        , _wlColor = winCol
-                        , _wlDraw = Nothing
-                        , _wlSeen = False
-                        , _blIDs = ksAtN i
-                        , _blHP = hp
-                        , _wlIsSeeThrough = True
-                        , _blVisible = seen
-                        , _blShadows = shadows
-                        , _blDegrades = degradeHP
-                        }
-                f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
-            in  over walls f w
 
 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p