From 32744d7cb38894d93662a8f1851485ec3db4746e Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 28 Oct 2022 21:22:44 +0100 Subject: [PATCH] More camera refactor --- src/Dodge/Base/Coordinate.hs | 6 ++---- src/Dodge/Render/InfoBox.hs | 4 +++- src/Dodge/Render/Label.hs | 4 ++-- src/Dodge/Render/ShapePicture.hs | 7 ++++--- src/Dodge/Targeting/Draw.hs | 10 +++++++--- 5 files changed, 18 insertions(+), 13 deletions(-) diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 83b03790b..6d077761a 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -21,13 +21,11 @@ import Control.Lens - These have to be scaled according to the size of the window to get actual screen positions. - This allows for line thicknesses etc to correspond to pixel sizes. -} -worldPosToScreen :: World -> Point2 -> Point2 -worldPosToScreen w = +worldPosToScreen :: CamPos -> Point2 -> Point2 +worldPosToScreen cam = rotateV (negate $ cam ^. camRot) . ((cam ^. camZoom) *.*) . (-.- (cam ^. camCenter)) - where - cam = w ^. cWorld . lWorld . camPos {- | Transform coordinates from the map position to screen coordinates. diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index c8040e99c..497d9a503 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -1,5 +1,6 @@ module Dodge.Render.InfoBox where +import Control.Lens import Dodge.Base import Dodge.Data.Universe import Dodge.Render.Connectors @@ -10,11 +11,12 @@ import Picture renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2, [String]) -> Picture renderInfoListAt x y cfig w (p, ss) = renderListAt x y cfig (zip ss (repeat white)) - <> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen w p)) + <> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p)) <> listCursorNSW x y cfig 0 white 19 (length ss) where hw = halfWidth cfig hh = halfHeight cfig + cam = w ^. cWorld . lWorld . camPos renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2, [String])] -> Picture renderInfoListsAt x y cfig w = diff --git a/src/Dodge/Render/Label.hs b/src/Dodge/Render/Label.hs index 33a53fcce..aa71df9a1 100644 --- a/src/Dodge/Render/Label.hs +++ b/src/Dodge/Render/Label.hs @@ -7,11 +7,11 @@ import Picture import Dodge.Data.Universe import Geometry -drawLabCrossCol :: Configuration -> World -> Color -> Point2 -> Picture +drawLabCrossCol :: Configuration -> CamPos -> Color -> Point2 -> Picture drawLabCrossCol cfig w col p = drawCrossCol col p <> drawPointLabel cfig w p -drawPointLabel :: Configuration -> World -> Point2 -> Picture +drawPointLabel :: Configuration -> CamPos -> Point2 -> Picture drawPointLabel cfig w p = setLayer FixedCoordLayer . winScale cfig . uncurryV translate p' diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 223e99e6c..baa1cf150 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -192,9 +192,10 @@ drawCollisionTest cfig w = -- <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b) <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b) <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b) - <> foldMap (drawLabCrossCol cfig w blue) (xIntercepts crZoneSize a b) + <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b) where (a, b) = _lrLine w + cam = w ^. cWorld . lWorld . camPos drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) @@ -376,7 +377,7 @@ drawMousePosition cfig w = . text $ shortPoint2 mwp where - p = worldPosToScreen w mwp + p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp mwp = mouseWorldPos w drawWlIDs :: Configuration -> World -> Picture @@ -391,7 +392,7 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . . text $ show $ _wlID wl where - p = worldPosToScreen w $ 0.5 *.* uncurry (+.+) (_wlLine wl) + p = worldPosToScreen (w ^. cWorld . lWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl) edgeToPic :: [Point2] -> PathEdge -> Picture edgeToPic poly pe diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index d932f029f..e5674dac3 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -22,9 +22,9 @@ targetSimpleDraw = targetDraw $ const activeTargetCursorPic targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do p <- itm ^? itTargeting . tgPos . _Just - let p1 = worldPosToScreen w p + let p1 = worldPosToScreen cam p mwp = mouseWorldPos w - p2 = worldPosToScreen w mwp + p2 = worldPosToScreen cam mwp thecol = if dist p mwp > 100 then red else white return $ winScale cfig $ @@ -32,6 +32,8 @@ targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do color thecol $ line [p1, p2] <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) + where + cam = w ^. cWorld . lWorld . camPos targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture targetDraw f it _ cfig w = fromMaybe mempty $ do @@ -40,8 +42,10 @@ targetDraw f it _ cfig w = fromMaybe mempty $ do winScale cfig $ setLayer FixedCoordLayer $ color white $ - uncurryV translate (worldPosToScreen w p) $ + uncurryV translate (worldPosToScreen cam p) $ f it + where + cam = w ^. cWorld . lWorld . camPos activeTargetCursorPic :: Picture activeTargetCursorPic =