Cleanup: broken pathfinding

2021-11-16 18:05:47 +00:00
parent cb8cbe03a4
commit ebe9ad6b90
42 changed files with 491 additions and 301 deletions
@@ -0,0 +1,120 @@
+module Dodge.Placement.Instance.LightSource where
+import Dodge.Data
+import Dodge.LightSources.Lamp
+import Dodge.LevelGen.Data
+import Dodge.Room.Foreground
+import Geometry
+import Geometry.Vector3D
+import Dodge.Creature.Inanimate
+import Shape.Data
+import Dodge.Default
+import Dodge.RandomHelp 
+import Color
+import Shape
+
+import Control.Lens
+
+-- | mount a light source on a shape
+mntLSOn
+    :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
+    -> Maybe Color  -- ^ describing a possible color override for the shape
+    -> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
+mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
+    = ps0jPushPS (PutForeground . setCol $ shapeF wallp lsp)
+    . pt0 (PutLS $ ls {_lsPos = lsp'})
+  where
+    lsp' = lsp -.-.- V3 x y 1
+    -- hack! perturb the light position
+    V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
+    setCol = maybe id colorSH mcol
+
+
+iShape :: Point2 -> Point3 -> Shape
+iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
+
+lShape :: Point2 -> Point3 -> Shape
+lShape wp (V3 x y z) = thinHighBar z wallposUp turnpos
+        <> thinHighBar z turnpos (V2 x y)    
+  where
+    n = vNormal (wp -.- V2 x y)
+    wallposUp = wp +.+ n
+    turnpos = V2 x y +.+ n
+
+jShape :: Point2 -> Point3 -> Shape
+jShape wallpos (V3 x y z) = thinHighBar z wallposUp turn1
+    <> thinHighBar z turn1 turn2
+    <> thinHighBar z turn2 endpos
+  where
+    n = vNormal (wallpos -.- V2 x y)
+    wallposUp = wallpos +.+ n
+    turnpos = V2 x y +.+ n
+    endpos = V2 x y
+    turn1 = 0.5 *.* (wallposUp +.+ turnpos)
+    turn2 = 0.5 *.* (turnpos +.+ endpos)
+
+liShape :: Point2 -> Point3 -> Shape
+liShape wallpos (V3 x y z) =
+     thinHighBar z wallposUp turnpos
+    <> thinHighBar z turnpos (V2 x y)
+  where
+    n = vNormal (V2 x y -.- wallpos)
+    wallposUp = wallpos +.+ n
+    turnpos = V2 x y +.+ n
+
+aShape :: Point2 -> Point3 -> Shape
+aShape wallpos (V3 x y z) =
+    girder (z+2) 20 10 pout wallpos
+  where
+    pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
+
+vShape :: Point2 -> Point3 -> Shape
+vShape wallpos (V3 x y z) =
+    thinHighBar z wallposUp lxy
+    <> thinHighBar z wallposDown lxy
+  where
+    lxy = V2 x y
+    n = vNormal (wallpos -.- lxy)
+    wallposUp = wallpos +.+ n
+    wallposDown = wallpos -.- n
+
+mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
+mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
+
+mntLSCond :: (Point2 -> Point3 -> Shape) -> (RoomPos -> Maybe PlacementSpot) -> Placement
+mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $ 
+    mntLS shp 0 (V3 0 (-40) 90)
+    & plSpot .~ PSLnk shift (const id) Nothing
+    -- note that this perhaps pushes the vshape light out too far
+
+mntLight :: Point2 -> Point2 -> Placement
+mntLight a b = RandomPlacement $ do
+    shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
+    return $ mntLS shp a (addZ 90 b)
+
+mntLightLnkCond :: (RoomPos -> Maybe PlacementSpot) -> Placement
+mntLightLnkCond f = RandomPlacement $ do
+    shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
+    return $ mntLSCond shp f
+
+unusedLnkToPS :: RoomPos -> Maybe PlacementSpot
+unusedLnkToPS rp = case rp of
+    UnusedLink p a -> Just $ PS p a
+    _ -> Nothing
+
+spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
+spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
+    $ sps0 $ PutForeground $ thinHighBar h a b
+  where
+    V2 x y = 0.5 *.* (a +.+ b)
+
+spanLightI :: Point2 -> Point2 -> Placement
+spanLightI = spanColLightI 0.75 50
+
+extendAway :: Point2 -> Point2 -> Point2
+extendAway p x = p +.+ safeNormalizeV (p -.- x)
+
+putColorLamp :: Point3 -> PSType
+putColorLamp col = PutCrit (colorLamp col 90)
+
+putLamp :: PSType
+putLamp = PutCrit (lamp 90)