justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Camera position refactor

Browse Source
This commit is contained in:
justin
2022-10-28 15:32:46 +01:00
parent 27fe1c7a96
commit 2e7cd0aec2
24 changed files with 184 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+1 -1
View File
@@ -140,7 +140,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
where
vPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
vPos = w ^. cWorld . lWorld . camPos . camViewFrom
--allVisibleWalls :: World -> StreamOf (Point2,Wall)
--{-# INLINE allVisibleWalls #-}
src/Dodge/Base/Coordinate.hs
+7 -7
View File
@@ -23,11 +23,11 @@ import Control.Lens
-}
worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w =
rotateV (negate $ cam ^. cwcRot)
. ((cam ^. cwcZoom) *.*)
. (-.- (cam ^. cwcCenter))
rotateV (negate $ cam ^. camRot)
. ((cam ^. camZoom) *.*)
. (-.- (cam ^. camCenter))
where
cam = w ^. cWorld . lWorld . cwCam
cam = w ^. cWorld . lWorld . camPos
{- | Transform coordinates from the map position to screen
coordinates.
@@ -46,10 +46,10 @@ cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
-- | The mouse position in world coordinates.
mouseWorldPos :: World -> Point2
mouseWorldPos w =
(cam ^. cwcCenter)
+.+ (1 / (cam ^. cwcZoom)) *.* rotateV (cam ^. cwcRot) (_mousePos w)
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos w)
where
cam = w ^. cWorld . lWorld . cwCam
cam = w ^. cWorld . lWorld . camPos
---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2
src/Dodge/Base/Window.hs
+9 -8
View File
@@ -7,19 +7,20 @@ module Dodge.Base.Window (
screenBox,
) where
import Dodge.Data.Universe
import Dodge.Data.CamPos
import Dodge.Data.Config
import Geometry
import Control.Lens
-- | A box covering the screen in world coordinates
screenPolygon :: Configuration -> World -> [Point2]
screenPolygon :: Configuration -> CamPos -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
where
scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)
scRot = rotateV (w ^. camRot)
scZoom p
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
| (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p
| otherwise = p
scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)
scTran p = p +.+ (w ^. camCenter)
-- | A box covering the screen in world coordinates, with a x and y border
screenPolygonBord ::
@@ -28,16 +29,16 @@ screenPolygonBord ::
-- | Y border
Float ->
Configuration ->
World ->
CamPos ->
[Point2]
screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
where
hw = halfWidth cfig - xbord
hh = halfHeight cfig - ybord
scZoom p
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
| (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p
| otherwise = p
theTransform = (+.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) . scZoom
theTransform = (+.+ (w ^. camCenter)) . rotateV (w ^. camRot) . scZoom
tr = theTransform (V2 hw hh)
tl = theTransform (V2 (- hw) hh)
br = theTransform (V2 hw (- hh))
src/Dodge/Creature/Picture/Awareness.hs
+2 -2
View File
@@ -27,8 +27,8 @@ creatureDisplayText w cr =
w
cr
where
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
theScale = 0.15 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
campos = w ^. cWorld . lWorld . camPos . camViewFrom
theScale = 0.15 / (w ^. cWorld . lWorld . camPos . camZoom)
cpos = _crPos cr
v = cpos -.- campos
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
src/Dodge/Creature/YourControl.hs
+3 -3
View File
@@ -57,12 +57,12 @@ wasdWithAiming w speed cr
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
movDir = wasdDir w
dir = (w ^. cWorld . lWorld . cwCam . cwcRot) + argV movDir
movAbs = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ normalizeV movDir
dir = (w ^. cWorld . lWorld . camPos . camRot) + argV movDir
movAbs = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
_ -> argV (_mousePos w) + (w ^. cWorld . lWorld . cwCam . cwcRot)
_ -> argV (_mousePos w) + (w ^. cWorld . lWorld . camPos . camRot)
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
src/Dodge/CullBox.hs
+4 -4
View File
@@ -12,7 +12,7 @@ import Geometry
findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
findBoundDists cfig w
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . cwCam . cwcCenter) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . camPos . camCenter) w
where
hw = halfWidth cfig
hh = halfHeight cfig
@@ -20,9 +20,9 @@ findBoundDists cfig w
updateBounds :: Universe -> Universe
updateBounds uv =
uv
& uvWorld . cWorld . lWorld . cwCam . cwcBoundDist .~ bdists
& uvWorld . cWorld . lWorld . cwCam . cwcBoundBox
.~ map ((+.+ w ^. cWorld . lWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
& uvWorld . cWorld . lWorld . camPos . camBoundDist .~ bdists
& uvWorld . cWorld . lWorld . camPos . camBoundBox
.~ map ((+.+ w ^. cWorld . lWorld . camPos . camCenter) . rotateV (w ^. cWorld . lWorld . camPos . camRot)) (rectNSWE n s w' e)
where
w = _uvWorld uv
cfig = _uvConfig uv
src/Dodge/Data/CamPos.hs
+28
View File
@@ -0,0 +1,28 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CamPos where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data CamPos = CamPos
{ _camCenter :: Point2
, _camRot :: Float
, _camZoom :: Float -- smaller values zoom out
, _camItemZoom :: Float
, _camDefaultZoom :: Float
, _camViewFrom :: Point2
, _camViewDistance :: Float
, _camBoundBox :: [Point2]
, _camBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
makeLenses ''CamPos
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''CamPos ]
src/Dodge/Data/LWorld.hs
+3 -14
View File
@@ -45,8 +45,10 @@ module Dodge.Data.LWorld (
module Dodge.Data.TractorBeam,
module Dodge.Data.Wall,
module Dodge.Data.WorldEffect,
module Dodge.Data.CamPos
) where
import Dodge.Data.CamPos
import Data.Set (Set)
import Control.Lens
import Data.Aeson
@@ -98,7 +100,7 @@ import qualified IntMapHelp as IM
import Picture.Data
data LWorld = LWorld
{ _cwCam :: CWCam
{ _camPos :: CamPos
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
@@ -159,17 +161,6 @@ data LWorld = LWorld
, _distortions :: [Distortion]
, _lClock :: Int
}
data CWCam = CWCam
{ _cwcCenter :: Point2
, _cwcRot :: Float
, _cwcZoom :: Float -- smaller values zoom out
, _cwcItemZoom :: Float
, _cwcDefaultZoom :: Float
, _cwcViewFrom :: Point2
, _cwcViewDistance :: Float
, _cwcBoundBox :: [Point2]
, _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
, _lightBeams :: [Beam]
@@ -178,12 +169,10 @@ data WorldBeams = WorldBeams
}
makeLenses ''LWorld
makeLenses ''CWCam
makeLenses ''WorldBeams
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''WorldBeams
, ''CWCam
, ''LWorld
]
src/Dodge/Debug/Picture.hs
+11 -11
View File
@@ -17,14 +17,14 @@ printRotPoint r p =
. uncurryV translate p
$ pictures [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: Configuration -> World -> [Point2]
outsideScreenPolygon :: Configuration -> CamPos -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
where
scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)
scRot = rotateV (w ^. camRot)
scZoom p
| (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p
| (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)
scTran p = p +.+ (w ^. camCenter)
tr = f 3 3
tl = f (-3) 3
br = f 3 (-3)
@@ -39,14 +39,14 @@ lineOnScreenCone cfig w p1 p2 =
|| pointInPolygon p2 sp
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig w
vp = w ^. cWorld . lWorld . cwCam . cwcViewFrom
sp' = screenPolygon cfig (w ^. cWorld . lWorld . camPos)
vp = w ^. cWorld . lWorld . camPos . camViewFrom
sp
| pointInPolygon vp sp' = sp'
| otherwise = orderPolygon ((w ^. cWorld . lWorld . cwCam . cwcViewFrom) : sp')
| otherwise = orderPolygon ((w ^. cWorld . lWorld . camPos . camViewFrom) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> World -> Point2 -> Bool
pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool
pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
drawWallFace :: Configuration -> World -> Wall -> Picture
@@ -56,13 +56,13 @@ drawWallFace cfig w wall
where
(x, y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x, y)
sightFrom = w ^. cWorld . lWorld . cwCam . cwcViewFrom
sightFrom = w ^. cWorld . lWorld . camPos . camViewFrom
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
where
borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y]
scpoly = reverse $ screenPolygon cfig w
scpoly = reverse $ screenPolygon cfig (w ^. cWorld . lWorld . camPos)
cornerPs = filter (pointIsInCone c (x, y)) scpoly
wallScreenIntersect =
mapMaybe (uncurry $ intersectSegSeg y ((2 *.* y) -.- x))
@@ -77,4 +77,4 @@ intersectLinefromScreen cfig w a b =
listToMaybe
. mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
. loopPairs
$ screenPolygon cfig w
$ screenPolygon cfig (w ^. cWorld . lWorld . camPos)
src/Dodge/Default/World.hs
+12 -12
View File
@@ -43,18 +43,18 @@ defaultCWGen =
, _cwgRoomClipping = []
}
defaultCWCam :: CWCam
defaultCWCam :: CamPos
defaultCWCam =
CWCam
{ _cwcCenter = V2 0 0
, _cwcRot = 0
, _cwcZoom = 1
, _cwcDefaultZoom = 1
, _cwcViewFrom = V2 0 0
, _cwcViewDistance = 1000
, _cwcItemZoom = 1
, _cwcBoundBox = square 100
, _cwcBoundDist = (100, -100, 100, -100)
CamPos
{ _camCenter = V2 0 0
, _camRot = 0
, _camZoom = 1
, _camDefaultZoom = 1
, _camViewFrom = V2 0 0
, _camViewDistance = 1000
, _camItemZoom = 1
, _camBoundBox = square 100
, _camBoundDist = (100, -100, 100, -100)
}
defaultCWorld :: CWorld
@@ -70,7 +70,7 @@ defaultCWorld =
defaultLWorld :: LWorld
defaultLWorld =
LWorld
{ _cwCam = defaultCWCam
{ _camPos = defaultCWCam
, _magnets = IM.empty
, _modifications = IM.empty
, _creatures = IM.empty
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -16,7 +16,7 @@ splashScreen =
initialWorld :: World
initialWorld =
defaultWorld
& cWorld . lWorld . cwCam . cwcZoom .~ 10
& cWorld . lWorld . camPos . camZoom .~ 10
& cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)]
& cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
[MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
src/Dodge/Item/Weapon/TriggerType.hs
+4 -4
View File
@@ -579,7 +579,7 @@ torqueBefore torque feff item cr w
w
& randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& cWorld . lWorld . cwCam . cwcRot +~ rot
& cWorld . lWorld . camPos . camRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
@@ -600,7 +600,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
w
& randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot'
& cWorld . lWorld . cwCam . cwcRot +~ rot'
& cWorld . lWorld . camPos . camRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
where
cid = _crID cr
@@ -613,7 +613,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
withTorqueAfter :: ChainEffect
withTorqueAfter feff item cr w
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) $ feff item cr w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
where
cid = _crID cr
@@ -651,7 +651,7 @@ sideEffectOnFrame i sf f it cr w =
torqueSideEffect :: Float -> Item -> Creature -> World -> World
torqueSideEffect torque _ cr w
| cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
src/Dodge/Layout.hs
+1 -1
View File
@@ -58,7 +58,7 @@ fromEdgeTuple :: (Int,Int,PathEdge) -> PathEdgeNodes
fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe
randomCompass :: World -> World
randomCompass w = w & cWorld . lWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
randomCompass w = w & cWorld . lWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
putFloorTiles :: GenWorld -> GenWorld
putFloorTiles gw = gw & gwWorld . cWorld . lWorld . floorTiles .~ floorsFromGenWorld gw
src/Dodge/Picture/SizeInvariant.hs
+58 -55
View File
@@ -1,55 +1,58 @@
module Dodge.Picture.SizeInvariant where
module Dodge.Picture.SizeInvariant
( fixedSizePicClampArrow
) where
import Control.Lens
import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.Data.LWorld
import Dodge.Data.Config
import Geometry
import Picture
fixedSizePicAt ::
Picture ->
Point2 ->
World ->
Picture
fixedSizePicAt pic p w =
setLayer DebugLayer
. setDepth 20
. translate x y
. scale theScale theScale
$ pic
where
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
v = p -.- campos
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
(V2 x y) = campos +.+ v
--fixedSizePicAt ::
-- Picture ->
-- Point2 ->
-- CamPos ->
-- Picture
--fixedSizePicAt pic p w =
-- setLayer DebugLayer
-- . setDepth 20
-- . translate x y
-- . scale theScale theScale
-- $ pic
-- where
-- campos = w ^. camViewFrom
-- v = p -.- campos
-- theScale = 1 / (w ^. camZoom)
-- (V2 x y) = campos +.+ v
fixedSizePicClamp ::
-- | horizontal border
Int ->
-- | vertical border
Int ->
Picture ->
Point2 ->
Configuration ->
World ->
Picture
fixedSizePicClamp xbord ybord pic p cfig w =
setLayer DebugLayer
. setDepth 20
. translate x y
. scale theScale theScale
$ pic
where
r = negate $ w ^. cWorld . lWorld . cwCam . cwcRot
z = w ^. cWorld . lWorld . cwCam . cwcZoom
campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
v = p -.- campos
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
(V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
(V2 xr yr) = rotateV r v
xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr
--fixedSizePicClamp ::
-- -- | horizontal border
-- Int ->
-- -- | vertical border
-- Int ->
-- Picture ->
-- Point2 ->
-- Configuration ->
-- CamPos ->
-- Picture
--fixedSizePicClamp xbord ybord pic p cfig w =
-- setLayer DebugLayer
-- . setDepth 20
-- . translate x y
-- . scale theScale theScale
-- $ pic
-- where
-- r = negate $ w ^. camRot
-- z = w ^. camZoom
-- campos = w ^. camViewFrom
-- v = p -.- campos
-- theScale = 1 / (w ^. camZoom)
-- (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
-- (V2 xr yr) = rotateV r v
-- xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
-- yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr
fixedSizePicClampArrow ::
-- | horizontal border
@@ -59,7 +62,7 @@ fixedSizePicClampArrow ::
Picture ->
Point2 ->
Configuration ->
World ->
LWorld ->
Picture
fixedSizePicClampArrow xbord ybord pic p cfig w =
pictures
@@ -67,20 +70,20 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
, setLayer DebugLayer . color white . setDepth 20 $ arrowPic
]
where
winps = screenPolygon cfig w
bords = screenPolygonBord xbord ybord cfig w
winps = screenPolygon cfig (w ^. camPos)
bords = screenPolygonBord xbord ybord cfig (w ^. camPos)
borderPoint = intersectSegPolyFirst campos p bords
windowPoint = intersectSegPolyFirst campos p winps
arrowPic = case borderPoint of
Nothing -> blank
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
(V2 x y) = fromMaybe p borderPoint
campos = w ^. cWorld . lWorld . cwCam . cwcCenter
theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
campos = w ^. camPos . camCenter
theScale = 1 / (w ^. camPos . camZoom)
absClamp ::
-- | clamping value, assumed positive
Float ->
Float ->
Float
absClamp maxVal = max (negate maxVal) . min maxVal
--absClamp ::
-- -- | clamping value, assumed positive
-- Float ->
-- Float ->
-- Float
--absClamp maxVal = max (negate maxVal) . min maxVal
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -97,7 +97,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
= (w ^. cWorld . lWorld . cwCam . cwcRot) + argV (_mousePos w)
= (w ^. cWorld . lWorld . camPos . camRot) + argV (_mousePos w)
| otherwise = _prjDir pj
doThrust :: Proj -> World -> World
src/Dodge/Render.hs
+4 -4
View File
@@ -32,14 +32,14 @@ doDrawing pdata u = do
sTicks <- SDL.ticks
let w = _uvWorld u
cfig = _uvConfig u
rot = w ^. cWorld . lWorld . cwCam . cwcRot
camzoom = w ^. cWorld . lWorld . cwCam . cwcZoom
trans = w ^. cWorld . lWorld . cwCam . cwcCenter
rot = w ^. cWorld . lWorld . camPos . camRot
camzoom = w ^. cWorld . lWorld . camPos . camZoom
trans = w ^. cWorld . lWorld . camPos . camCenter
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
(wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
lightPoints = lightsToRender cfig w
viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . cwCam . cwcViewFrom
viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . camPos . camViewFrom
viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata
lwShad = _lightingWallShadShader pdata
src/Dodge/Render/Lights.hs
+2 -2
View File
@@ -15,8 +15,8 @@ lightsToRender cfig w =
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = w ^. cWorld . lWorld . cwCam . cwcBoundBox
cpos = w ^. cWorld . lWorld . cwCam . cwcCenter
cbox = w ^. cWorld . lWorld . camPos . camBoundBox
cpos = w ^. cWorld . lWorld . camPos . camCenter
getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
src/Dodge/Render/ShapePicture.hs
+10 -10
View File
@@ -116,8 +116,8 @@ shiftDraw' fpos fdir fdraw x =
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . cwCam . cwcBoundBox)
| otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . camPos . camBoundBox)
| otherwise = dist (w ^. cWorld . lWorld . camPos . camCenter) p < (w ^. cWorld . lWorld . camPos . camViewDistance)
extraPics :: Configuration -> World -> Picture
extraPics cfig w =
@@ -278,7 +278,7 @@ drawFarWallDetect w =
$ getViewpoints p w
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = w ^. cWorld . lWorld . cwCam . cwcViewFrom
p = w ^. cWorld . lWorld . camPos . camViewFrom
drawDDATest :: World -> Picture
drawDDATest w =
@@ -289,7 +289,7 @@ drawDDATest w =
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom
cvf = w ^. cWorld . lWorld . camPos . camViewFrom
mwp = mouseWorldPos w
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg 50 cvf mwp
@@ -316,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p]
<> line [w ^. cWorld . lWorld . camPos . camViewFrom , p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -332,7 +332,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox
(x : xs) = w ^. cWorld . lWorld . camPos . camBoundBox
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -356,11 +356,11 @@ mcSPic mc =
rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld . lWorld)
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . lWorld . cwCam . cwcRot)
rotate (w ^. cWorld . lWorld . camPos . camRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -404,7 +404,7 @@ edgeToPic poly pe
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . lWorld . camPos)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
@@ -430,7 +430,7 @@ crDisplayInfo cfig w cr
| otherwise = Nothing
where
ap = _crActionPlan cr
crOnScreen = pointOnScreen cfig w $ _crPos cr
crOnScreen = pointOnScreen cfig (w ^. cWorld . lWorld . camPos) $ _crPos cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
src/Dodge/SoundLogic.hs
+2 -2
View File
@@ -212,9 +212,9 @@ soundAngle p w
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . cwCam . cwcRot)
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . camPos . camRot)
where
earPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
earPos = w ^. cWorld . lWorld . camPos . camViewFrom
{- | Uses the first free origin from a list.
Does nothing if all origins are already creating sounds.
src/Dodge/Update/Camera.hs
+17 -17
View File
@@ -41,11 +41,11 @@ updateCamera uv =
moveZoomCamera :: Universe -> Universe
moveZoomCamera uv =
uv
& uvWorld . cWorld . lWorld . cwCam . cwcCenter .~ newcen
& uvWorld . cWorld . lWorld . cwCam . cwcViewFrom .~ newvf
& uvWorld . cWorld . lWorld . cwCam . cwcZoom .~ newzoom
& uvWorld . cWorld . lWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom
& uvWorld . cWorld . lWorld . cwCam . cwcItemZoom .~ newItemZoom
& uvWorld . cWorld . lWorld . camPos . camCenter .~ newcen
& uvWorld . cWorld . lWorld . camPos . camViewFrom .~ newvf
& uvWorld . cWorld . lWorld . camPos . camZoom .~ newzoom
& uvWorld . cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom
& uvWorld . cWorld . lWorld . camPos . camItemZoom .~ newItemZoom
where
cfig = _uvConfig uv
w = _uvWorld uv
@@ -60,23 +60,23 @@ moveZoomCamera uv =
guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
offset = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
newzoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs
_ -> newDefaultZoom * newItemZoom
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs
_ -> changeZoom (w ^. cWorld . lWorld . cwCam . cwcDefaultZoom) idealDefaultZoom
_ -> changeZoom (w ^. cWorld . lWorld . camPos . camDefaultZoom) idealDefaultZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming (you w)
zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (w ^. cWorld . lWorld . cwCam . cwcItemZoom) idealItemZoom
newItemZoom = changeZoom (w ^. cWorld . lWorld . camPos . camItemZoom) idealItemZoom
changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
| otherwise = idealZoom
wallZoom = min4 (w ^. cWorld . lWorld . cwCam . cwcBoundDist)
wallZoom = min4 (w ^. cWorld . lWorld . camPos . camBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w
@@ -131,7 +131,7 @@ zoomInLongGun w
ycr = you w
Just currentZoom = wp ^? itScope . scopeZoom
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
mousep = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ _mousePos w
mousep = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ _mousePos w
zoomOutLongGun :: World -> World
zoomOutLongGun w
@@ -168,11 +168,11 @@ rotateToOverlappingWall w =
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . cwCam . cwcRot)
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . camPos . camRot)
where
rotateUsing a
| b - b' > 0.01 = w & cWorld . lWorld . cwCam . cwcRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . lWorld . cwCam . cwcRot -~ 0.01
| b - b' > 0.01 = w & cWorld . lWorld . camPos . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . lWorld . camPos . camRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
@@ -182,7 +182,7 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^.
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w =
w
& cWorld . lWorld . cwCam . cwcRot +~ x
& cWorld . lWorld . camPos . camRot +~ x
& cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0))
. itScope
. scopePos
@@ -218,8 +218,8 @@ clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> World -> World
setViewDistance cfig w =
w & cWorld . lWorld . cwCam . cwcViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . cwCam . cwcZoom)
w & cWorld . lWorld . camPos . camViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . camPos . camZoom)
getViewpoints :: Point2 -> World -> [Point2]
{-# INLINE getViewpoints #-}
@@ -241,7 +241,7 @@ farWallDistDirection p w =
boundPoints $
map f $ getViewpoints p w
where
f q = (rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q))
f q = (rotateV (negate (w ^. cWorld . lWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -31,7 +31,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
(_, EquipOptions{}) -> scrollRBOption y w
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . lWorld . cwCam . cwcZoom +~ y
| lbDown -> w & cWorld . lWorld . camPos . camZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory (TweakInventory mi)
src/Dodge/Update/UsingInput.hs
+1 -1
View File
@@ -60,7 +60,7 @@ pressedMBEffectsNoInventory pkeys w
w & hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle =
w & cWorld . lWorld . cwCam . cwcRot -~ rotation
w & cWorld . lWorld . camPos . camRot -~ rotation
& clickMousePos .~ _mousePos w
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
| cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
(rot, g) = randomR (- x, x) $ _randGen w
src/Dodge/Zoning/World.hs
+1 -1
View File
@@ -11,7 +11,7 @@ zoneOfSight s w =
, b <- [minimum ys .. maximum ys]
]
where
(xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . cwCam . cwcBoundBox
(xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . camPos . camBoundBox
sizeZoneOfPoint (V2 x y) = (f x, f y)
where
f = floor . (/ s)