This commit is contained in:
2021-11-28 22:38:26 +00:00
parent 8c5777a1af
commit 8832a73d86
9 changed files with 21 additions and 24 deletions
+4 -6
View File
@@ -6,6 +6,7 @@ Consider splitting. -}
module Dodge.Base module Dodge.Base
where where
import Dodge.Data import Dodge.Data
import Dodge.WinScale
import Dodge.Zone import Dodge.Zone
--import Dodge.Zone.Data --import Dodge.Zone.Data
import Dodge.Base.Window import Dodge.Base.Window
@@ -458,8 +459,8 @@ worldPosToScreenNorm cfig w = doWindowScale . doRotate . doZoom . doTranslate
doZoom p = _cameraZoom w *.* p doZoom p = _cameraZoom w *.* p
doRotate p = rotateV (negate $ _cameraRot w) p doRotate p = rotateV (negate $ _cameraRot w) p
doWindowScale (V2 x y) = V2 doWindowScale (V2 x y) = V2
( x * 2 / getWindowX cfig) ( x * 2 / _windowX cfig)
( y * 2 / getWindowY cfig) ( y * 2 / _windowY cfig)
{- | Transform world coordinates to scaled screen coordinates. {- | Transform world coordinates to scaled screen coordinates.
- These have to be according to the size of the window to get actual screen positions. - These have to be 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.-}
@@ -472,14 +473,11 @@ worldPosToScreen w = doRotate . doZoom . doTranslate
{- | Transform coordinates from the map position to screen {- | Transform coordinates from the map position to screen
coordinates. -} coordinates. -}
cartePosToScreen :: Configuration -> World -> Point2 -> Point2 cartePosToScreen :: Configuration -> World -> Point2 -> Point2
cartePosToScreen cfig w = doWindowScale . doRotate . doZoom . doTranslate cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
where where
doTranslate p = p -.- _carteCenter w doTranslate p = p -.- _carteCenter w
doZoom p = _carteZoom w *.* p doZoom p = _carteZoom w *.* p
doRotate p = rotateV (negate $ _carteRot w) p doRotate p = rotateV (negate $ _carteRot w) p
doWindowScale (V2 x y) = V2
( x * 2 / getWindowX cfig)
( y * 2 / getWindowY cfig)
{- | The mouse position in world coordinates. -} {- | The mouse position in world coordinates. -}
mouseWorldPos :: World -> Point2 mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
+2 -8
View File
@@ -4,8 +4,6 @@ module Dodge.Base.Window
, halfHeight , halfHeight
, screenPolygon , screenPolygon
, screenPolygonBord , screenPolygonBord
, getWindowX
, getWindowY
, screenBox , screenBox
) )
where where
@@ -46,12 +44,8 @@ screenPolygonBord xbord ybord cfig w = [tr,tl,bl,br]
bl = theTransform (V2 (-hw) (-hh)) bl = theTransform (V2 (-hw) (-hh))
halfWidth,halfHeight :: Configuration -> Float halfWidth,halfHeight :: Configuration -> Float
halfWidth w = getWindowX w / 2 halfWidth w = _windowX w / 2
halfHeight w = getWindowY w / 2 halfHeight w = _windowY w / 2
getWindowX ,getWindowY :: Configuration -> Float
getWindowX = _windowX
getWindowY = _windowY
-- | A box of the size of the screen in screen centered coordinates -- | A box of the size of the screen in screen centered coordinates
screenBox :: Configuration -> [Point2] screenBox :: Configuration -> [Point2]
screenBox w = rectNSEW hh (-hh) hw (-hw) screenBox w = rectNSEW hh (-hh) hw (-hw)
+2 -2
View File
@@ -51,8 +51,8 @@ handleEvent e = case eventPayload e of
handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
(fromIntegral x - 0.5*getWindowX cfig) (fromIntegral x - 0.5*_windowX cfig)
(0.5*getWindowY cfig - fromIntegral y) (0.5*_windowY cfig - fromIntegral y)
where where
cfig = _config u cfig = _config u
w = _uvWorld u w = _uvWorld u
+1 -1
View File
@@ -180,7 +180,7 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
updateFramebufferSize :: Universe -> Universe updateFramebufferSize :: Universe -> Universe
updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
where where
(x,y) = (round $ getWindowX cfig, round $ getWindowY cfig) (x,y) = (round $ _windowX cfig, round $ _windowY cfig)
cfig = _config u cfig = _config u
divRes = u ^. config . resolution_factor divRes = u ^. config . resolution_factor
+4 -3
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD
) )
where where
import Dodge.Data import Dodge.Data
import Dodge.WinScale
import Dodge.Base import Dodge.Base
import Dodge.Base.Window import Dodge.Base.Window
import Dodge.Inventory import Dodge.Inventory
@@ -129,11 +130,11 @@ drawLocations cfig w = pictures $
locTexts = map fst locs locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2] displayListEndCoords :: Configuration -> [String] -> [Point2]
displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..] displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1..]
where where
f :: Int -> Point2 f :: Int -> Point2
f i = V2 ( 15 - halfWidth w ) ( 2.5 + halfHeight w - (20 * fromIntegral i)) f i = V2 ( 15 - halfWidth cfig ) ( 2.5 + halfHeight cfig - (20 * fromIntegral i))
g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w) --g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w)
h :: String -> Point2 -> Point2 h :: String -> Point2 -> Point2
h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
+1 -1
View File
@@ -19,7 +19,7 @@ fixedCoordPictures w = case _menuLayers w of
] ]
(lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay (lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay
where where
scaler = setDepth (-1) . scale (2 / getWindowX cfig) (2 / getWindowY cfig) scaler = setDepth (-1) . winScale cfig
cfig = _config w cfig = _config w
customMouseCursor :: Configuration -> World -> Picture customMouseCursor :: Configuration -> World -> Picture
+1 -1
View File
@@ -35,7 +35,7 @@ worldSPic cfig w =
where where
filtOn f g = IM.filter (pointIsClose . f) (g w) filtOn f g = IM.filter (pointIsClose . f) (g w)
pointIsClose p = dist camCen p < winSize pointIsClose p = dist camCen p < winSize
winSize = 30 + max (getWindowX cfig) (getWindowY cfig) winSize = 30 + max (_windowX cfig) (_windowY cfig)
camCen = _cameraCenter w camCen = _cameraCenter w
extraShapes :: World -> Shape extraShapes :: World -> Shape
+4
View File
@@ -1,7 +1,11 @@
module Dodge.WinScale where module Dodge.WinScale where
import Dodge.Config.Data import Dodge.Config.Data
import Geometry
import Picture import Picture
winScale :: Configuration -> Picture -> Picture winScale :: Configuration -> Picture -> Picture
{-# INLINE winScale #-} {-# INLINE winScale #-}
winScale cfig = scale (2 / _windowX cfig) (2 / _windowY cfig) winScale cfig = scale (2 / _windowX cfig) (2 / _windowY cfig)
doWindowScale :: Configuration -> Point2 -> Point2
doWindowScale cfig (V2 x y) = V2 ( x * 2 / _windowX cfig) ( y * 2 / _windowY cfig)
+2 -2
View File
@@ -97,7 +97,7 @@ wallsDoubleScreen cfig w
_ -> IM.empty _ -> IM.empty
(x,y) = zoneOfPoint $ _cameraCenter w (x,y) = zoneOfPoint $ _cameraCenter w
n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2 n = ceiling (wh / (_cameraZoom w * zoneSize)) * 2
wh = max (getWindowX cfig) (getWindowY cfig) wh = max (_windowX cfig) (_windowY cfig)
xs = [x - n .. x + n] xs = [x - n .. x + n]
ys = [y - n .. y + n] ys = [y - n .. y + n]
@@ -114,7 +114,7 @@ wallsOnScreen cfig w
_ -> IM.empty _ -> IM.empty
(x,y) = zoneOfPoint $ _cameraCenter w (x,y) = zoneOfPoint $ _cameraCenter w
n = ceiling (wh / (_cameraZoom w * zoneSize)) n = ceiling (wh / (_cameraZoom w * zoneSize))
wh = max (getWindowX cfig) (getWindowY cfig) wh = max (_windowX cfig) (_windowY cfig)
xs = [x - n .. x + n] xs = [x - n .. x + n]
ys = [y - n .. y + n] ys = [y - n .. y + n]