Add shrinkability and cursed items

src/Dodge/Placement/Instance/Turret.hs

@@ -8,7 +8,6 @@ import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.BatteryGuns
 import Dodge.SoundLogic.LoadSound
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 import Geometry
 import ShapePicture
 import Shape

src/Dodge/Placement/Instance/Wall.hs

@@ -23,9 +23,9 @@ lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock StoneBlock [5,20,20] (greyN 0.5)
+        $ PutBlock StoneBlock [5,20,20] baseBlockPane
         $ reverse 
-        $ rectNSWE 10 (-10) (-10) 10
+        $ square 10
     ]
 {-
 Places a line of blocks between two points.
@@ -82,6 +82,17 @@ baseBlockPane = defaultWall
     , _wlDraw = True
     , _wlFireThrough = True
     }
+dirtWall :: Wall
+dirtWall = defaultWall
+    { _wlLine = (V2 0 0,V2 50 0)
+    , _wlID = 0
+    , _wlColor = V4 (150/256) ( 75/256)  0 ( 250/256)
+    , _wlSeen = False
+    , _wlOpacity = Opaque
+    , _wlRotateTo = False
+    , _wlDraw = True
+    , _wlFireThrough = True
+    }
 baseWindowPane :: Wall
 baseWindowPane = defaultWall
     { _wlLine = (V2 0 0,V2 50 0)

src/Dodge/Placement/PlaceSpot.hs

@@ -102,7 +102,7 @@ placeSpotID ps pt w = case pt of
     PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
     PutCoordinate coordp -> placeNewInto coordinates (doShift coordp) w
     PutSlideDoor pathing col f a b spd -> placeSlideDoor pathing col f (doShift a) (doShift b) spd w
-    PutBlock bm (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps bm w
+    PutBlock bm (hp:hps) wl ps' -> placeBlock (map doShift ps') hp wl hps bm w
     PutBlock{} -> error "messed up block placement somehow"
     PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm wdth dpth (doShift a) (doShift b) w
     PutWall { _pwPoly = ps', _pwWall = wl } -> (0,placeWallPoly (map doShift ps') wl w)

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -8,10 +8,8 @@ import Dodge.Data
 import Dodge.Path
 import Dodge.Base
 import Dodge.Zone
-import Dodge.Default.Wall
 import Geometry
 import qualified IntMapHelp as IM
-import Color
 
 import Control.Lens
 import Data.List
@@ -19,16 +17,15 @@ import qualified Data.IntSet as IS
 
 addBlock 
     :: [Point2]     -- ^ Block polygon
+    -> Wall         -- ^ Base Pane
     -> Int          -- ^ First layer of health
-    -> Color 
-    -> Opacity         -- ^ Is the block see through?
     -> [Int]        -- ^ Extra layers of health
     -> BlockMaterial
     -> World 
     -> World
-addBlock (p:ps) hp col opacity hps bm w 
+addBlock (p:ps) wl hp hps bm w 
     | hp <= 0 && null hps = w
-    | hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) bm w
+    | hp <= 0 = addBlock (p:ps) wl (head hps + hp) (tail hps) bm w
     | otherwise = w
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
         & walls  %~ IM.union panes
@@ -40,31 +37,28 @@ addBlock (p:ps) hp col opacity hps bm w
     i = IM.newKey $ _walls w
     is = [i.. i + length lns-1]
     panes = IM.fromList $ zipWith 
-        (\j (a,b) -> (,) j defaultWall 
+        (\j (a,b) -> (,) j wl 
             { _wlLine = (a,b)
             , _wlID = j
-            , _wlColor = col
-            , _wlOpacity = opacity
             , _wlStructure = BlockPart blid
-            , _wlFireThrough = True
             }
         ) is lns
-    wallInZone wl 
-        | uncurry dist (_wlLine wl) <= 2*zoneSize 
-            = insertIMInZone x y wlid wl
-        | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl)) ips
+    wallInZone wl'
+        | uncurry dist (_wlLine wl') <= 2*zoneSize 
+            = insertIMInZone x y wlid wl'
+        | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips
       where 
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
-addBlock _ _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
+addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
-placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> BlockMaterial -> World -> (Int,World)
-placeBlock poly i c opac is bm w 
+placeBlock :: [Point2] -> Int -> Wall -> [Int] -> BlockMaterial -> World -> (Int,World)
+placeBlock poly i wl is bm w 
     = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 
     pairs = loopPairs poly
-    wWithBlock = addBlock poly i c opac is bm w
+    wWithBlock = addBlock poly wl i is bm w
 
 {- | Splits a line into many four cornered blocks. -}
 placeLineBlock 

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -11,7 +11,6 @@ import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 
 import Data.List
 import Control.Lens