Add general smooth scrolling, move camera into world

2023-03-26 20:09:00 +01:00
parent 73e742e1a2
commit 07a1d71039
32 changed files with 154 additions and 131 deletions
@@ -76,8 +76,8 @@ mouseCursorType u
    a = fromMaybe 0 $ do
        cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
        return . toClosestMultiple (pi / 32) $
-            argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
-                - w ^. cWorld . cwCam . camRot
+            argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
+                - w ^. wCam . camRot

 mousePlus :: Picture
 mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
@@ -83,7 +83,7 @@ drawSweep cr w = fromMaybe mempty $ do
    cdir = _crDir cr
    rot = campos ^. camRot
    p = _crPos cr
-    campos = w ^. cWorld . cwCam
+    campos = w ^. wCam
    theinput = w ^. input
    mwp = mouseWorldPos theinput campos

@@ -134,8 +134,8 @@ shiftDraw' fpos fdir fdraw x =

 cullPoint :: Configuration -> World -> Point2 -> Bool
 cullPoint cfig w p
-    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . camBoundBox)
-    | otherwise = dist (w ^. cWorld . cwCam . camCenter) p < (w ^. cWorld . cwCam . camViewDistance)
+    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. wCam . camBoundBox)
+    | otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance)

 extraPics :: Configuration -> Universe -> Picture
 extraPics cfig u =
@@ -185,7 +185,7 @@ debugDraw' cfig w bl = case bl of
    Close_shape_culling -> mempty
    Bound_box_screen -> mempty
    Show_ms_frame -> mempty
-    View_boundaries -> viewBoundaries (w ^. cWorld)
+    View_boundaries -> viewBoundaries w
    Show_bound_box -> drawBoundingBox w
    Show_wall_search_rays -> drawWallSearchRays w
    Show_dda_test -> drawDDATest w
@@ -197,7 +197,7 @@ debugDraw' cfig w bl = case bl of
    Inspect_wall -> drawInspectWalls w
    Cr_awareness -> drawCreatureDisplayTexts w
    Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status -> drawCrInfo cfig (w ^. cWorld)
+    Cr_status -> drawCrInfo cfig w
    Mouse_position -> drawMousePosition w
    Walls_info -> drawWlIDs w
    Pathing -> drawPathing cfig w
@@ -243,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do

 drawWallsNearCursor :: World -> Picture
 drawWallsNearCursor w =
-    setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCam $ _cWorld w)) w
+    setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w
  where
    f wl = color rose $ thickLine 3 [a, b]
      where
@@ -307,13 +307,13 @@ drawFarWallDetect w =
            )
        $ getViewpoints p (_cWorld w)
  where
-    p = w ^. cWorld . cwCam . camViewFrom
+    p = w ^. wCam . camViewFrom

 drawZoneNearPointCursor :: World -> Picture
 drawZoneNearPointCursor w =
    foldMap (drawZoneCol orange 50) ps
  where
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
+    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
    ps = [zoneOfPoint 50 mwp]

 drawDDATest :: World -> Picture
@@ -321,8 +321,8 @@ drawDDATest w =
    foldMap (drawZoneCol orange 50) ps
        <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
  where
-    cvf = w ^. cWorld . cwCam . camViewFrom
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
+    cvf = w ^. wCam . camViewFrom
+    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
    ps = zoneOfSeg 50 cvf mwp

 drawZoneCol :: Color -> Float -> V2 Int -> Picture
@@ -342,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
        setLayer DebugLayer $
            color yellow $
                uncurryV translate p (circle 5)
-                    <> line [w ^. cWorld . cwCam . camViewFrom, p]
+                    <> line [w ^. wCam . camViewFrom, p]

 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
@@ -350,7 +350,7 @@ testPic _ _ = mempty
 drawBoundingBox :: World -> Picture
 drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
  where
-    (x : xs) = w ^. cWorld . cwCam . camBoundBox
+    (x : xs) = w ^. wCam . camBoundBox

 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
@@ -371,11 +371,11 @@ mcSPic mc =
        rotateSP (_mcDir mc) (drawMachine mc)

 soundPic :: Configuration -> World -> Sound -> Picture
-soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
+soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
  where
    p = _soundPos s
    thePic =
-        rotate (w ^. cWorld . cwCam . camRot)
+        rotate (w ^. wCam . camRot)
            . scale theScale theScale
            . centerText
            . soundToOnomato
@@ -391,7 +391,7 @@ drawMousePosition w =
        . text
        $ shortPoint2 mwp
  where
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
+    mwp = mouseWorldPos (w ^. input) (w ^. wCam)

 drawWlIDs :: World -> Picture
 drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
@@ -404,7 +404,7 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
                . text
                $ show $ _wlID wl
      where
-        p = worldPosToScreen (w ^. cWorld . cwCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
+        p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)

 edgeToPic :: [Point2] -> PathEdge -> Picture
 edgeToPic poly pe
@@ -417,7 +417,7 @@ edgeToPic poly pe
 drawPathing :: Configuration -> World -> Picture
 drawPathing cfig w =
    setLayer DebugLayer $
-        foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCam)) . (^?! _3)) (FGL.labEdges gr)
+        foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
            <> foldMap dispInc (graphToIncidence gr)
  where
    dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
@@ -448,23 +448,23 @@ crDisplayInfo cfig cam cr
 fpreShow :: (Show a, Functor f) => String -> f a -> f String
 fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)

-drawCrInfo :: Configuration -> CWorld -> Picture
+drawCrInfo :: Configuration -> World -> Picture
 drawCrInfo cfig w =
    setLayer FixedCoordLayer $
        renderInfoListsAt (2 * hw - 400) 0 cfig cam $
-            mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
+            mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. cWorld . lWorld . creatures
  where
-    cam = w ^. cwCam
+    cam = w ^. wCam
    hw = halfWidth cfig

-viewBoundaries :: CWorld -> Picture
+viewBoundaries :: World -> Picture
 viewBoundaries w =
    setLayer DebugLayer $
        color green (foldMap (polygonWire . _grBound) grs)
-            <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
+            <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p (_cWorld w))
  where
-    p = w ^. cwCam . camViewFrom
-    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
+    p = w ^. wCam . camViewFrom
+    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w)

 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w