Refactor window size, update selection cursor on new screen

src/Dodge/Update/Camera.hs

@@ -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

src/Dodge/Update/Input/ScreenLayer.hs

@@ -17,8 +17,7 @@ import SDL
 updateUseInputOnScreen :: ScreenLayer -> Universe -> Universe
 updateUseInputOnScreen sl = case sl of
     InputScreen thetext _ -> doInputScreenInput thetext
-    screen@OptionScreen{_scPositionedMenuOption = mop, _scSelectionList = sellist, _scListDisplayParams = ldps} ->
-        optionScreenUpdate screen mop ldps sellist
+    screen -> optionScreenUpdate screen
 
 doInputScreenInput :: String -> Universe -> Universe
 doInputScreenInput s u =
@@ -36,19 +35,20 @@ doInputScreenInput s u =
 
 optionScreenUpdate ::
     ScreenLayer ->
-    PositionedMenuOption ->
-    ListDisplayParams ->
-    SelectionList (Universe -> Universe,Universe -> Universe) ->
     Universe ->
     Universe
-optionScreenUpdate screen mop ldps sl u =
-    refreshOptionsSelectionList
+optionScreenUpdate screen u =
+    (uvScreenLayers . ix 0 . scDisplayTime +~ 1)
+        . refreshOptionsSelectionList
         . optionScreenDefaultEffect mop
         . mouseClickOptionsList screen
-        . mouseOverSelectionList ldps sl
+        . mouseOverSelectionList ldps screen
         . menuWheelEvents
         . over (uvScreenLayers . _head) (setSelectionListRestriction (u ^. uvConfig))
         $ u
+  where
+    mop = _scPositionedMenuOption screen
+    ldps = _scListDisplayParams screen
 
 optionScreenDefaultEffect :: PositionedMenuOption -> Universe -> Universe
 optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
@@ -71,18 +71,22 @@ mouseClickOptionsList screen u = fromMaybe u $ do
                 return $ f u
             _ -> u
 
-mouseOverSelectionList :: ListDisplayParams 
-    -> SelectionList a -> Universe -> Universe
-mouseOverSelectionList ldps sl u
+mouseOverSelectionList ::
+    ListDisplayParams ->
+    ScreenLayer ->
+    Universe ->
+    Universe
+mouseOverSelectionList ldps screen u
     | x > xl && x < xr
         && ylower == yupper
-        && mmoving
+        && (mmoving || (_scDisplayTime screen == 0))
         && ylower >= 0
         && ylower < ymax
         && isselectable =
         u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
     | otherwise = u
   where
+    sl = _scSelectionList screen
     isselectable =
         fromMaybe False $
             u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
@@ -91,7 +95,6 @@ mouseOverSelectionList ldps sl u
     ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
     yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
     xl = _ldpPosX ldps - hw
-    --xr = xl + _ldpScale ldps * 15 * 9
     xr = xl + _ldpScale ldps * 26 * 9
     V2 x y = u ^. uvWorld . input . mousePos
     cfig = u ^. uvConfig

src/Dodge/Update/Scroll.hs

@@ -30,7 +30,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
             (_, EquipOptions{}) -> w & rbOptions %~ scrollRBOption yi
             (Nothing, _) -> closeObjScrollDir y w
             (Just f, _) -> doHeldScroll f y (you w) w
-        | lbDown -> w & cWorld . camPos . camZoom +~ y
+        | lbDown -> w & cWorld . cwCamPos . camZoom +~ y
         | invKeyDown -> changeSwapSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
     DisplayInventory {_subInventory = ExamineInventory mi}