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.
- 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.
+3 -1
View File
@@ -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 =
+2 -2
View File
@@ -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'
+4 -3
View File
@@ -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
+7 -3
View File
@@ -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 =