More camera refactor
This commit is contained in:
@@ -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.
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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'
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
Reference in New Issue
Block a user