More camera refactor

This commit is contained in:
2022-10-28 21:22:44 +01:00
parent 2e7cd0aec2
commit 32744d7cb3
5 changed files with 18 additions and 13 deletions
+2 -4
View File
@@ -21,13 +21,11 @@ import Control.Lens
- These have to be scaled according to the size of the window to get actual screen positions. - 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. - This allows for line thicknesses etc to correspond to pixel sizes.
-} -}
worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen :: CamPos -> Point2 -> Point2
worldPosToScreen w = worldPosToScreen cam =
rotateV (negate $ cam ^. camRot) rotateV (negate $ cam ^. camRot)
. ((cam ^. camZoom) *.*) . ((cam ^. camZoom) *.*)
. (-.- (cam ^. camCenter)) . (-.- (cam ^. camCenter))
where
cam = w ^. cWorld . lWorld . camPos
{- | Transform coordinates from the map position to screen {- | Transform coordinates from the map position to screen
coordinates. coordinates.
+3 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Render.InfoBox where module Dodge.Render.InfoBox where
import Control.Lens
import Dodge.Base import Dodge.Base
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Render.Connectors import Dodge.Render.Connectors
@@ -10,11 +11,12 @@ import Picture
renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2, [String]) -> Picture renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2, [String]) -> Picture
renderInfoListAt x y cfig w (p, ss) = renderInfoListAt x y cfig w (p, ss) =
renderListAt x y cfig (zip ss (repeat white)) 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) <> listCursorNSW x y cfig 0 white 19 (length ss)
where where
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
cam = w ^. cWorld . lWorld . camPos
renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2, [String])] -> Picture renderInfoListsAt :: Float -> Float -> Configuration -> World -> [(Point2, [String])] -> Picture
renderInfoListsAt x y cfig w = renderInfoListsAt x y cfig w =
+2 -2
View File
@@ -7,11 +7,11 @@ import Picture
import Dodge.Data.Universe import Dodge.Data.Universe
import Geometry import Geometry
drawLabCrossCol :: Configuration -> World -> Color -> Point2 -> Picture drawLabCrossCol :: Configuration -> CamPos -> Color -> Point2 -> Picture
drawLabCrossCol cfig w col p = drawCrossCol col p drawLabCrossCol cfig w col p = drawCrossCol col p
<> drawPointLabel cfig w p <> drawPointLabel cfig w p
drawPointLabel :: Configuration -> World -> Point2 -> Picture drawPointLabel :: Configuration -> CamPos -> Point2 -> Picture
drawPointLabel cfig w p = drawPointLabel cfig w p =
setLayer FixedCoordLayer . winScale cfig setLayer FixedCoordLayer . winScale cfig
. uncurryV translate p' . uncurryV translate p'
+4 -3
View File
@@ -192,9 +192,10 @@ drawCollisionTest cfig w =
-- <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b) -- <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b)
<> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b) <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
<> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' 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 where
(a, b) = _lrLine w (a, b) = _lrLine w
cam = w ^. cWorld . lWorld . camPos
drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
@@ -376,7 +377,7 @@ drawMousePosition cfig w =
. text . text
$ shortPoint2 mwp $ shortPoint2 mwp
where where
p = worldPosToScreen w mwp p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp
mwp = mouseWorldPos w mwp = mouseWorldPos w
drawWlIDs :: Configuration -> World -> Picture drawWlIDs :: Configuration -> World -> Picture
@@ -391,7 +392,7 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld .
. text . text
$ show $ _wlID wl $ show $ _wlID wl
where 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 :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe edgeToPic poly pe
+7 -3
View File
@@ -22,9 +22,9 @@ targetSimpleDraw = targetDraw $ const activeTargetCursorPic
targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
p <- itm ^? itTargeting . tgPos . _Just p <- itm ^? itTargeting . tgPos . _Just
let p1 = worldPosToScreen w p let p1 = worldPosToScreen cam p
mwp = mouseWorldPos w mwp = mouseWorldPos w
p2 = worldPosToScreen w mwp p2 = worldPosToScreen cam mwp
thecol = if dist p mwp > 100 then red else white thecol = if dist p mwp > 100 then red else white
return $ return $
winScale cfig $ winScale cfig $
@@ -32,6 +32,8 @@ targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
color thecol $ color thecol $
line [p1, p2] line [p1, p2]
<> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) <> 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 :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
targetDraw f it _ cfig w = fromMaybe mempty $ do targetDraw f it _ cfig w = fromMaybe mempty $ do
@@ -40,8 +42,10 @@ targetDraw f it _ cfig w = fromMaybe mempty $ do
winScale cfig $ winScale cfig $
setLayer FixedCoordLayer $ setLayer FixedCoordLayer $
color white $ color white $
uncurryV translate (worldPosToScreen w p) $ uncurryV translate (worldPosToScreen cam p) $
f it f it
where
cam = w ^. cWorld . lWorld . camPos
activeTargetCursorPic :: Picture activeTargetCursorPic :: Picture
activeTargetCursorPic = activeTargetCursorPic =