Quick hack to make window rendering passable

Before windows drew even on black backgrounds

src/Dodge/Placement/Instance/Door.hs

@@ -14,13 +14,7 @@ import Dodge.LevelGen.PlacementHelper
 import Geometry
 import Linear
 
-putDoubleDoor ::
-    Wall ->
-    WdBl ->
-    Point2 ->
-    Point2 ->
-    Float ->
-    Placement
+putDoubleDoor :: Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
 putDoubleDoor wl cond a b speed =
     putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
 

src/Dodge/Placement/PlaceSpot.hs

@@ -6,7 +6,6 @@
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
-import Dodge.Placement.PlaceSpot.Block
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Foldable
@@ -17,6 +16,7 @@ import Dodge.Base.NewID
 import Dodge.Data.GenWorld
 import Dodge.Default.Wall
 import Dodge.Path
+import Dodge.Placement.PlaceSpot.Block
 import Dodge.Placement.PlaceSpot.TriggerDoor
 import Dodge.Placement.Shift
 import Dodge.ShiftPoint
@@ -32,11 +32,10 @@ import NewInt
 -- to the placement. This id should be associated with the type of placement and
 -- match up with the created id for the object (creature id, flitid id, etc)
 placeSpot :: Int -> GenWorld -> Placement -> GenWorld
-placeSpot rid w plmnt = case plmnt of
-    Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rid i f plmnt w
-    Placement{_plSpot = PSPos extract eff fallback} ->
-        placeSpotUsingLink w rid plmnt extract eff fallback
-    Placement{} -> placePlainPSSpot w rid plmnt shift
+placeSpot rid w plmnt = case plmnt ^. plSpot of
+    PSRoomRand i f -> placeSpotRoomRand rid i f plmnt w
+    PSPos extract eff fallback -> placeSpotUsingLink w rid plmnt extract eff fallback
+    _ -> placePlainPSSpot w rid plmnt shift
   where
     shift = _rmShift $ w ^?! genRooms . ix rid
 
@@ -126,7 +125,7 @@ placeSpotID rid ps pt w = case pt of
             )
     PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs ->
-            (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
+        (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
     PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
@@ -161,15 +160,8 @@ placeChasm gw rid ps shiftps =
     f w = foldl' g w (loopPairs shiftps)
     g w (x, y) = obstructPathsCrossing (S.singleton ChasmObstacle) x y w
 
---evaluateRandPS
---    :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
---evaluateRandPS rid rgen ps w = placeSpotID rid ps evaluatedType
---    $ set (gwWorld . randGen) g w
---  where
---    (evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)
-
 placeWallPoly :: [Point2] -> Wall -> World -> World
-placeWallPoly qs wl w 
+placeWallPoly qs wl w
     | (p : ps) <- orderPolygon qs = foldl' (addPane wl) w $ zip (ps ++ [p]) (p : ps)
     | otherwise = error "tried to place wall poly with too few points"
 
@@ -185,11 +177,10 @@ mvButton :: Point2 -> Float -> Button -> Button
 mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
 
 mvCr :: Point2 -> Float -> Creature -> Creature
-mvCr p rot cr =
-    cr
-        & crPos . _xy .~ p
-        & crOldPos . _xy .~ p
-        & crDir .~ rot
+mvCr p rot =
+    (crPos . _xy .~ p)
+        . (crOldPos . _xy .~ p)
+        . (crDir .~ rot)
 
 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
@@ -227,6 +218,6 @@ placeMachineWalls poly mcid = insertStructureWalls MachinePart baseWall poly mci
     baseWall = defaultMachineWall & wlStructure . wsMachine .~ mcid
 
 mvLS :: Point3 -> Float -> LightSource -> LightSource
-mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
+mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z + startPos
   where
     startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)