Add lights to buttons, cleanup

src/Dodge/LevelGen/Block.hs

@@ -75,33 +75,31 @@ placeLineBlock
 placeLineBlock basePane blockWidth depth a b w = (,) 0 
     $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
   where 
-    d = dist a b
-    rot = argV (b -.- a)
     psOnLine = divideLineOddNumPoints blockWidth a b
-    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
+    halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
     blockCenPs = snd $ evenOddSplit psOnLine
     numBlocks = length blockCenPs
     is = [0.. numBlocks - 1]
     cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
-    cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
+    cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
     linesAt p = loopPairs $ cornersAt p
-    k = IM.newKey $ _walls w
+    wlid = IM.newKey $ _walls w
     blid = IM.newKey $ _blocks w
     insertBlock i = over blocks $ IM.insert (i+blid) Block 
         {_blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
     insertBlocks = flip (foldr insertBlock) is
-    ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
+    ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
     visibilityAt i 
-        | i == 0             = [ True,True,False,True]
-        | i == numBlocks - 1 = [False,True, True,True]
+        | i == 0             = [False,True,True ,True]
+        | i == numBlocks - 1 = [True ,True,False,True]
         | otherwise          = [False,True,False,True]
     shadowsAt i
         | i == 0             = ksAtI 1
         | i == numBlocks - 1 = ksAtI $ numBlocks - 2
         | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
     makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
-    makePane i visStatus k' ps = basePane
-        {_wlID = k'
+    makePane i visStatus k ps = basePane
+        {_wlID = k
         ,_wlStructure = BlockPart $ i + blid
         ,_wlLine = ps
         ,_wlDraw = visStatus

src/Dodge/LevelGen/Data.hs

@@ -18,6 +18,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutFlIt Item
     | PutPressPlate PressPlate
     | PutBlock [Int] Color [Point2]
+    | PutCoordinate Point2
     | PutLineBlock Wall Float Float Point2 Point2
     | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
     | PutSlideDoor Bool Color (World -> Bool) Point2 Point2 Float
@@ -36,6 +37,7 @@ data Placement = Placement
     { _placementSpot :: PlacementSpot
     , _idPlacement :: Int -> Maybe Placement 
     }
+  | PlacementPos Point3 (Point3 -> Placement)
 
 sPS :: Point2 -> Float -> PSType -> Placement
 sPS p a pt = Placement (PS p a pt) (const Nothing)

src/Dodge/LevelGen/TriggerDoor.hs

@@ -1,6 +1,6 @@
 --{-# LANGUAGE BangPatterns #-}
 module Dodge.LevelGen.TriggerDoor
-    ( putDoor
+    ( placeDoor
     , placeSlideDoor
     --, addButtonDoor
     ) where
@@ -24,14 +24,14 @@ import Data.List
 import Control.Lens
 --import Data.Graph.Inductive hiding ((&))
 import qualified Data.IntSet as IS
-putDoor 
+placeDoor 
     :: Color 
     -> (World -> Bool)      -- ^ Opening condition
     -> [(Point2,Point2)]   -- ^ Door positions, closed to open.
                     -- Bumped out up and down by 9, not widened
     -> World 
     -> (Int,World)
-putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor)
+placeDoor col cond pss w = (drid, addWalls w & doors %~ addDoor)
   where
     drid = IM.newKey $ _doors w
     addDoor = IM.insert drid $ Door
@@ -40,6 +40,7 @@ putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor)
         , _drStatus = DoorInt 0
         , _drTrigger = cond
         , _drMech   = doorMechanismStepwise nsteps drid wlids pss
+        , _drCoord = 0
         }
     nsteps = length pss - 1
     wlids = take 4 [IM.newKey $ _walls w ..]
@@ -112,6 +113,7 @@ placeSlideDoor isPathable col cond a b speed w = (drid, addWalls w & doors %~ ad
         , _drStatus = DoorClosed
         , _drTrigger = cond
         , _drMech   = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
+        , _drCoord = 0
         }
     addWalls w' = foldl' addWall w' $ zip wlids pairs
     addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall