Refactor window size, update selection cursor on new screen

This commit is contained in:
2023-03-25 09:27:27 +00:00
parent 20c05be23f
commit ea0c942887
57 changed files with 346 additions and 310 deletions
+12 -12
View File
@@ -29,8 +29,8 @@ updateCamera :: Configuration -> World -> World
updateCamera cfig w =
w
& updateBounds cfig
& over (cWorld . camPos) (setViewDistance cfig)
& cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w)
& over (cWorld . cwCamPos) (setViewDistance cfig)
& cWorld . cwCamPos %~ moveZoomCamera cfig (w ^. input) (you w)
& updateScopeZoom
& rotateCamera cfig
@@ -98,7 +98,7 @@ updateScopeZoom' i w
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
resetscope otherAtt = otherAtt
mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
mp = rotateV (w ^. cWorld . cwCamPos . camRot) $ _mousePos (_input w)
doScopeZoom :: Point2 -> Scope -> Scope
doScopeZoom mp sc = case sc ^? scopeZoomChange of
@@ -163,11 +163,11 @@ rotateToOverlappingWall w =
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . camPos . camRot)
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCamPos . camRot)
where
rotateUsing a
| b - b' > 0.01 = w & cWorld . camPos . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . camPos . camRot -~ 0.01
| b - b' > 0.01 = w & cWorld . cwCamPos . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cwCamPos . camRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
@@ -177,7 +177,7 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cW
rotateCameraBy :: Float -> CWorld -> CWorld
rotateCameraBy x w =
w
& camPos . camRot +~ x
& cwCamPos . camRot +~ x
& rotateanyscope
where
rotateanyscope = fromMaybe id $ do
@@ -218,7 +218,7 @@ farWallDistDirection p w =
boundPoints $
map f $ getViewpoints p (_cWorld w)
where
f q = (rotateV (negate (w ^. cWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
f q = (rotateV (negate (w ^. cWorld . cwCamPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
@@ -226,7 +226,7 @@ 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 . camPos . camCenter) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camViewFrom) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCamPos . camViewFrom) w
where
hw = halfWidth cfig
hh = halfHeight cfig
@@ -234,8 +234,8 @@ findBoundDists cfig w
updateBounds :: Configuration -> World -> World
updateBounds cfig w =
w
& cWorld . camPos . camBoundDist .~ bdists
& cWorld . camPos . camBoundBox
.~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e)
& cWorld . cwCamPos . camBoundDist .~ bdists
& cWorld . cwCamPos . camBoundBox
.~ map ((+.+ w ^. cWorld . cwCamPos . camCenter) . rotateV (w ^. cWorld . cwCamPos . camRot)) (rectNSWE n s w' e)
where
bdists@(n, s, e, w') = findBoundDists cfig w