Refactor window size, update selection cursor on new screen

appDodge/Main.hs

@@ -38,8 +38,8 @@ main :: IO ()
 main = do
     -- load the config to get the window size and position
     con <- loadDodgeConfig
-    let sizex = floor $ _windowX con
+    let sizex = _windowX con
-        sizey = floor $ _windowY con
+        sizey = _windowY con
         posx = _windowPosX con
         posy = _windowPosY con
     setupConLoop'

bench/Bench.hs

@@ -19,7 +19,7 @@ main = do
 --    fs <- replicateM 500 (randomRIO (1,20))
     defaultMain
         [ bgroup "polyToTris tests"
-            [ bench "polyToTris 5" $ nf ( polyToTris) ps1          
+            [ bench "polyToTris 5" $ nf polyToTris ps1          
             , bench "polyToTris 10" $ nf polyToTris ps2          
             , bench "polyToTris 50" $ nf polyToTris ps3          
             --, bench "polyToTris 500" $ nf polyToTris ps4          

src/Data/Preload/Render.hs

@@ -45,7 +45,7 @@ data RenderData = RenderData
     , _fboShadow :: (FBO, (TO, TO))
     , _rboBaseBloom :: GLuint -- RenderbufferObject id
     , _matUBO :: GLuint -- BufferObject id
-    , _orthonormalMatUBO :: GLuint -- BufferObject id
+--    , _orthonormalMatUBO :: GLuint -- BufferObject id
     , _lightsUBO :: GLuint -- BufferObject id
     , _vboWindows :: VBO
     , _vboShapes :: VBO

src/Dodge/Base.hs

@@ -8,14 +8,12 @@ module Dodge.Base
     , module Dodge.Base.Arithmetic
     , module Dodge.Base.You
     , module Dodge.Base.NewID
-    , module Dodge.Base.WinScale
     , module Dodge.Base.Window
     , module Dodge.Base.Coordinate
     , module Dodge.Base.Collide
     , module Dodge.Base.CardinalPoint
     , module Dodge.Base.Wall
     ) where
-import Dodge.Base.WinScale
 import Dodge.Base.Wall
 import Dodge.Base.Arithmetic
 import Dodge.Base.NewID

src/Dodge/Base/Collide.hs

@@ -132,7 +132,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
 {-# INLINE allVisibleWalls #-}
 allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 15
   where
-    vPos = w ^. cWorld . camPos . camViewFrom
+    vPos = w ^. cWorld . cwCamPos . camViewFrom
 
 overlapCircWalls ::
     Point2 ->

src/Dodge/Base/Coordinate.hs

@@ -5,9 +5,7 @@ module Dodge.Base.Coordinate (
 ) where
 
 import Control.Lens
-import Dodge.Base.WinScale
 import Dodge.Data.CamPos
-import Dodge.Data.Config
 import Dodge.Data.HUD
 import Dodge.Data.Input
 import Geometry
@@ -33,8 +31,8 @@ worldPosToScreen cam =
 {- | Transform coordinates from the map position to screen
 coordinates.
 -}
-cartePosToScreen :: Configuration -> HUD -> Point2 -> Point2
+cartePosToScreen :: HUD -> Point2 -> Point2
-cartePosToScreen cfig thehud = doWindowScale cfig . doRotate . doZoom . doTranslate
+cartePosToScreen thehud = doRotate . doZoom . doTranslate
   where
     doTranslate p = p -.- (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
     doZoom p = (thehud ^. carteZoom) *.* p

src/Dodge/Base/WinScale.hs

@@ -1,12 +0,0 @@
-module Dodge.Base.WinScale where
-
-import Dodge.Data.Config
-import Geometry
-import Picture
-
-winScale :: Configuration -> Picture -> Picture
-{-# INLINE winScale #-}
-winScale cfig = scale (1 / _windowX cfig) (1 / _windowY cfig)
-
-doWindowScale :: Configuration -> Point2 -> Point2
-doWindowScale cfig (V2 x y) = V2 (x / _windowX cfig) (y / _windowY cfig)

src/Dodge/Base/Window.hs

@@ -45,8 +45,8 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
     bl = theTransform (V2 (- hw) (- hh))
 
 halfWidth, halfHeight :: Configuration -> Float
-halfWidth w = _windowX w / 2
+halfWidth = (0.5 *) .  windowXFloat
-halfHeight w = _windowY w / 2
+halfHeight = (0.5 *) .  windowYFloat
 
 -- | A box of the size of the screen in screen centered coordinates
 screenBox :: Configuration -> [Point2]

src/Dodge/Bullet.hs

@@ -82,7 +82,7 @@ useAmmoParams it cr w =
             return $ FlechetteTrajectory tpos
         BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
             tpos <- cr ^? crTargeting . ctPos . _Just
-            return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . camPos))
+            return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos))
 
 bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
 bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)

src/Dodge/Config/Update.hs

@@ -19,7 +19,7 @@ Write the current world configuration to disk as a json file.
 -}
 saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
 saveConfig cfig f x = do
-    putStrLn "Saving config to data/dodge.config.json"
+--    putStrLn "Saving config to data/dodge.config.json"
     BS.writeFile "data/dodge.config.json" $
         AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
     f x

src/Dodge/Creature/Action/Blink.hs

@@ -26,7 +26,7 @@ blinkActionMousePos cr w =
         & inverseShockwaveAt cpos 40 2 2
   where
     cid = _crID cr
-    p1 = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     cpos = _crPos cr
     --p2 = bouncePoint (const True) 1 cpos p1 w
     p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
@@ -70,7 +70,7 @@ unsafeBlinkAction cr w
         wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
         return (isLHS mwp `uncurry` _wlLine wl)
     cid = _crID cr
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     cpos = _crPos cr
 
 blinkShockwave ::
@@ -96,7 +96,7 @@ blinkActionFail cr w =
     distR = 120
     distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
     cid = _crID cr
-    p1 = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     cpos = _crPos cr
     p2 = bouncePoint (const True) 1 cpos p1 w
     r = 1.5 * _crRad cr

src/Dodge/Creature/Picture/Awareness.hs

@@ -28,8 +28,8 @@ creatureDisplayText w cr =
             cr
   where
     lw = w ^. cWorld . lWorld
-    campos = w ^. cWorld . camPos . camViewFrom
+    campos = w ^. cWorld . cwCamPos . camViewFrom
-    theScale = 0.15 / (w ^. cWorld . camPos . camZoom)
+    theScale = 0.15 / (w ^. cWorld . cwCamPos . camZoom)
     cpos = _crPos cr
     v = cpos -.- campos
     (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v

src/Dodge/Creature/YourControl.hs

@@ -75,15 +75,15 @@ wasdWithAiming w speed cr
         | otherwise = crMvForward speed
     theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
     movDir = wasdDir w
-    dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
+    dir = fmap ((w ^. cWorld . cwCamPos . camRot) +) (safeArgV movDir)
-    movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
+    movAbs = rotateV (w ^. cWorld . cwCamPos . camRot) $ normalizeV movDir
     isAiming = _posture (_crStance cr) == Aiming
     mouseDir = fromMaybe 
-        (argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) )
+        (argV (_mousePos (_input w)) + (w ^. cWorld . cwCamPos . camRot) )
         $ do
             itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
             _ <- cr ^? crInv . ix itRef . itScope . scopePos
-            return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
+            return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- _crPos cr
 
 aimTurn :: Float -> Creature -> Creature
 aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
@@ -120,7 +120,7 @@ pressedMBEffectsNoInventory pkeys w
     | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
     | isDown SDL.ButtonLeft && inTopInv = useLeftItem 0 w
     | isDown SDL.ButtonMiddle =
-        w & cWorld . camPos . camRot -~ rotation
+        w & cWorld . cwCamPos . camRot -~ rotation
             & input . clickMousePos .~ _mousePos (_input w)
     | otherwise = w
   where

src/Dodge/Data/CWorld.hs

@@ -24,7 +24,7 @@ import Data.Graph.Inductive
 
 data CWorld = CWorld
     { _lWorld :: LWorld
-    , _camPos :: CamPos
+    , _cwCamPos :: CamPos
     , _cwGen :: CWGen
     , _cClock :: Int
     , _pastWorlds :: [LWorld]

src/Dodge/Data/Config.hs

@@ -46,8 +46,8 @@ data Configuration = Configuration
     , _graphics_world_resolution :: ResFactor
     , _graphics_overlay_resolution :: ResFactor
     , _graphics_num_shadow_casters :: NumShadowCasters
-    , _windowX :: Float
+    , _windowX :: Int
-    , _windowY :: Float
+    , _windowY :: Int
     , _windowPosX :: Int
     , _windowPosY :: Int
     , _gameplay_rotate_to_wall :: Bool
@@ -56,6 +56,11 @@ data Configuration = Configuration
     }
     deriving (Show)
 
+windowXFloat :: Configuration -> Float
+windowXFloat = fromIntegral . _windowX
+windowYFloat :: Configuration -> Float
+windowYFloat = fromIntegral . _windowY
+
 data DebugBool
     = Show_ms_frame
     | Show_debug
@@ -85,7 +90,7 @@ data DebugBool
     | Show_path_between
     deriving (Eq, Ord, Bounded, Enum, Show)
 
-data ResFactor = FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
+data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
     deriving (Show, Eq, Ord, Enum, Bounded)
 
 data ShadowRendering 
@@ -99,13 +104,22 @@ data ShadowRendering
 data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
     deriving (Show, Eq, Ord, Enum, Bounded)
 
-resFactorNum :: ResFactor -> Int
+applyResFactor :: ResFactor -> Int -> Int
-resFactorNum rf = case rf of
+applyResFactor  rf = case rf of
-    FullRes -> 1
+    DoubleRes -> (2*)
-    HalfRes -> 2
+    FullRes -> id
-    QuarterRes -> 4
+    HalfRes -> (`div` 2)
-    EighthRes -> 8
+    QuarterRes -> (`div` 4)
-    SixteenthRes -> 16
+    EighthRes -> (`div` 8)
+    SixteenthRes -> (`div` 16)
+
+--resFactorNum :: ResFactor -> Int
+--resFactorNum rf = case rf of
+--    FullRes -> 1
+--    HalfRes -> 2
+--    QuarterRes -> 4
+--    EighthRes -> 8
+--    SixteenthRes -> 16
 
 defaultConfig :: Configuration
 defaultConfig =

src/Dodge/Data/Input.hs

@@ -14,7 +14,7 @@ data PressType = InitialPress
   deriving (Eq,Show)
 
 data Input = Input
-    { _mousePos :: Point2
+    { _mousePos :: Point2 -- in pixels, from the center of the screen
     , _mouseMoving :: Bool
     , _pressedKeys :: M.Map Scancode PressType
     , _mouseButtons :: M.Map MouseButton Bool -- shortpress False, repeatpress True

src/Dodge/Data/Universe.hs

@@ -66,6 +66,7 @@ data ScreenLayer
         , _scSelectionList :: SelectionList (Universe -> Universe,Universe->Universe)
         , _scAvailableLines :: Int
         , _scListDisplayParams :: ListDisplayParams
+        , _scDisplayTime :: Int
         }
     | InputScreen
         { _scInput :: String

src/Dodge/Debug/Picture.hs

@@ -39,11 +39,11 @@ lineOnScreenCone cfig w p1 p2 =
         || pointInPolygon p2 sp
         || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where
-    sp' = screenPolygon cfig (w ^. cWorld . camPos)
+    sp' = screenPolygon cfig (w ^. cWorld . cwCamPos)
-    vp = w ^. cWorld . camPos . camViewFrom
+    vp = w ^. cWorld . cwCamPos . camViewFrom
     sp
         | pointInPolygon vp sp' = sp'
-        | otherwise = orderPolygon ((w ^. cWorld . camPos . camViewFrom) : sp')
+        | otherwise = orderPolygon ((w ^. cWorld . cwCamPos . camViewFrom) : sp')
     sps = zip sp (tail sp ++ [head sp])
 
 pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool
@@ -56,13 +56,13 @@ drawWallFace cfig w wall
   where
     (x, y) = _wlLine wall
     points = extendConeToScreenEdge cfig w sightFrom (x, y)
-    sightFrom = w ^. cWorld . camPos . camViewFrom
+    sightFrom = w ^. cWorld . cwCamPos . 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 ^. cWorld . camPos)
+    scpoly = reverse $ screenPolygon cfig (w ^. cWorld . cwCamPos)
     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 ^. cWorld . camPos)
+        $ screenPolygon cfig (w ^. cWorld . cwCamPos)

src/Dodge/Default/World.hs

@@ -77,7 +77,7 @@ defaultCWCam =
 defaultCWorld :: CWorld
 defaultCWorld =
     CWorld
-        { _camPos = defaultCWCam
+        { _cwCamPos = defaultCWCam
         , _lWorld = defaultLWorld
         , _cwGen = defaultCWGen
         , _cClock = 0

src/Dodge/Event.hs

@@ -20,8 +20,8 @@ import qualified Data.Text as T
 import Dodge.Concurrent
 import Dodge.Data.Universe
 import Dodge.Event.Input
-import Preload.Update
 import LensHelp
+import Preload.Update
 import SDL
 
 handleEvent :: Event -> Universe -> Universe
@@ -48,14 +48,10 @@ handleWindowMoveEvent mev =
   where
     P (V2 x y) = windowMovedEventPosition mev
 
--- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.
-
 -- using a sideeffect here for the io change seems to work better, more testing
 -- later may be a good idea
 handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Universe
-handleResizeEvent sev u =
+handleResizeEvent sev = uvIOEffects %~ ((updatePreload . updateconfig) >=>)
-    u
-        & uvIOEffects %~ ( (updatePreload . updateconfig) >=>)
   where
     updateconfig = (uvConfig . windowX .~ fromIntegral x) . (uvConfig . windowY .~ fromIntegral y)
     V2 x y = windowSizeChangedEventSize sev

src/Dodge/Event/Input.hs

@@ -36,8 +36,8 @@ handleMouseMotionEvent mmev cfig =
     P (V2 x y) = mouseMotionEventPos mmev
     themousepos =
         V2
-            (fromIntegral x - 0.5 * _windowX cfig)
+            (fromIntegral x - 0.5 * windowXFloat cfig)
-            (0.5 * _windowY cfig - fromIntegral y)
+            (0.5 * windowYFloat cfig - fromIntegral y)
 
 handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input
 handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y

src/Dodge/HeldUse.hs

@@ -349,7 +349,7 @@ useMod hm = case hm of
     directedTelPos _ cr w = (p, a)
       where
         p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
-        a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- p)
+        a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- p)
     moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
     modcrpos x cr =
         cr & crDir %~ tweenAngles x (_crOldDir cr)
@@ -513,7 +513,7 @@ shootTeslaArc it cr w =
 useForceFieldGun :: Item -> Creature -> World -> World
 useForceFieldGun itm cr w = fromMaybe w $ do
     a <- cr ^? crTargeting . ctPos . _Just
-    let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
         b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
         wlline = (a, b)
     return $

src/Dodge/Initialisation.hs

@@ -16,7 +16,7 @@ splashScreen =
 initialWorld :: World
 initialWorld =
     defaultWorld
-        & cWorld . camPos . camZoom .~ 10
+        & cWorld . cwCamPos . 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/BatteryGuns.hs

@@ -149,7 +149,7 @@ circleLaser it cr w
     | otherwise = w
   where
     cpos = _crPos cr
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
     dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
     phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
@@ -169,7 +169,7 @@ shootDualLaser it cr w =
     gap = _dbGap . _itParams $ it
     posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
     posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     mwp'
         | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
         | otherwise = mwp

src/Dodge/Item/Weapon/TriggerType.hs

@@ -589,7 +589,7 @@ torqueBefore torque feff item cr w
             w
                 & randGen .~ g
                 & cWorld . lWorld . creatures . ix cid . crDir +~ rot
-                & cWorld . camPos . camRot +~ rot
+                & cWorld . cwCamPos . camRot +~ rot
     | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr
@@ -610,7 +610,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
             w
                 & randGen .~ g
                 & cWorld . lWorld . creatures . ix cid . crDir +~ rot'
-                & cWorld . camPos . camRot +~ rot'
+                & cWorld . cwCamPos . camRot +~ rot'
     | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
   where
     cid = _crID cr
@@ -623,7 +623,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 . camPos . camRot) (+ rot) $ feff item cr w
+    | cid == 0 = set randGen g $ over (cWorld . cwCamPos . 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
@@ -661,7 +661,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 . camPos . camRot) (+ rot) w
+    | cid == 0 = set randGen g $ over (cWorld . cwCamPos . camRot) (+ rot) w
     | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr
@@ -708,12 +708,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
                 & crPos %~ (+.+ pos)
                 & crDir .~ thedir pos
     thedir pos
-        | dist (mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) (_crPos cr) < aimingMuzzlePos cr item =
+        | dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)) (_crPos cr) < aimingMuzzlePos cr item =
             argV
                 ( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
                     -.- (_crPos cr +.+ pos)
                 )
-        | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- (_crPos cr +.+ pos))
+        | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- (_crPos cr +.+ pos))
 
 duplicateItem :: (Item -> [Item]) -> ChainEffect
 duplicateItem fit eff itm cr w = foldr f w (fit itm)

src/Dodge/Layout.hs

@@ -57,7 +57,7 @@ generateLevelFromRoomList gr' w =
 
 
 randomCompass :: World -> World
-randomCompass w = w & cWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
+randomCompass w = w & cWorld . cwCamPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
 
 -- note the order of traversal of the rooms is important
 -- hence the reverse

src/Dodge/Luse.hs

@@ -113,7 +113,7 @@ boostPoint x cr w = case mayp2 of
   where
     cpos = _crPos cr
     r = 1.5 * _crRad cr
-    p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- cpos)
+    p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos)
     mayp2 = bouncePoint (const True) 1 cpos p1 w
 
 addBoostShockwave ::

src/Dodge/Menu/Loading.hs

@@ -14,4 +14,5 @@ loadingScreen str = OptionScreen
     , _scSelectionList = defaultSelectionList
     , _scAvailableLines = 0
     , _scListDisplayParams = optionListDisplayParams
+    , _scDisplayTime = 0
     }

src/Dodge/Menu/Option.hs

@@ -1,14 +1,11 @@
 module Dodge.Menu.Option where
 
 import Control.Applicative
---import Dodge.ScodeToChar
-import Dodge.Default.SelectionList
 import Data.Maybe
---import Dodge.WindowLayout
-
 import Dodge.Data.CardinalPoint
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
+import Dodge.Default.SelectionList
 import Dodge.SelectionList
 import LensHelp
 import Padding
@@ -36,6 +33,7 @@ initializeOptionMenu title ops pmo u =
         , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops pmo
         , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
         , _scListDisplayParams = optionListDisplayParams
+        , _scDisplayTime = 0
         }
 
 -- BO = Bottom Option
@@ -69,8 +67,12 @@ makeOptionsSelectionList maxlines mselpos u mos pmo =
         , _slSelPos = mselpos
         }
 
-optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption 
+optionsToSelections ::
-    -> [SelectionItem (Universe -> Universe,Universe -> Universe)]
+    Int ->
+    Universe ->
+    [MenuOption] ->
+    PositionedMenuOption ->
+    [SelectionItem (Universe -> Universe, Universe -> Universe)]
 optionsToSelections maxlines u allops pmo = case pmo of
     NoPositionedMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops
     TopMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops)
@@ -106,8 +108,8 @@ colStrToSelItem (col, str) =
         { _siPictures = [str]
         , _siHeight = 1
         , _siIsSelectable = True
-        --, _siWidth = length str
+        , --, _siWidth = length str
-        , _siColor = col
+          _siColor = col
         , _siOffX = 0
         , _siPayload = id
         }
@@ -117,15 +119,18 @@ optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s
     _ -> 0
 
-menuOptionToSelectionItem :: Universe -> Int -> MenuOption 
+menuOptionToSelectionItem ::
-    -> SelectionItem (Universe -> Universe,Universe -> Universe)
+    Universe ->
+    Int ->
+    MenuOption ->
+    SelectionItem (Universe -> Universe, Universe -> Universe)
 menuOptionToSelectionItem w padAmount mo =
     SelectionItem
         { _siPictures = [optionText]
         , _siHeight = 1
         , _siIsSelectable = isselectable
-        --, _siWidth = length optionText
+        , --, _siWidth = length optionText
-        , _siColor = thecol
+          _siColor = thecol
         , _siOffX = 0
         , _siPayload = (f, g)
         }

src/Dodge/Picture/SizeInvariant.hs

@@ -70,16 +70,16 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
         , setLayer DebugLayer . color white . setDepth 20 $ arrowPic
         ]
   where
-    winps = screenPolygon cfig (w ^. camPos)
+    winps = screenPolygon cfig (w ^. cwCamPos)
-    bords = screenPolygonBord xbord ybord cfig (w ^. camPos)
+    bords = screenPolygonBord xbord ybord cfig (w ^. cwCamPos)
     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 ^. camPos . camCenter
+    campos = w ^. cwCamPos . camCenter
-    theScale = 1 / (w ^. camPos . camZoom)
+    theScale = 1 / (w ^. cwCamPos . camZoom)
 
 --absClamp ::
 --    -- | clamping value, assumed positive

src/Dodge/Projectile/Update.hs

@@ -97,7 +97,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
         | SDL.ButtonRight `M.member` _mouseButtons (_input w)
             && w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem
                 == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
-            = (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w))
+            = (w ^. cWorld . cwCamPos . camRot) + argV (_mousePos (_input w))
         | otherwise = _prjDir pj
 
 doThrust :: Proj -> World -> World

src/Dodge/Render.hs

@@ -48,13 +48,13 @@ doDrawing' win pdata u = do
     checkGLError
     let w = _uvWorld u
         cfig = _uvConfig u
-        rot = w ^. cWorld . camPos . camRot
+        rot = w ^. cWorld . cwCamPos . camRot
-        camzoom = w ^. cWorld . camPos . camZoom
+        camzoom = w ^. cWorld . cwCamPos . camZoom
-        trans = w ^. cWorld . camPos . camCenter
+        trans = w ^. cWorld . cwCamPos . camCenter
-        wins = V2 (_windowX cfig) (_windowY cfig)
+        wins = V2 (windowXFloat cfig) (windowYFloat cfig)
         (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
-        lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
+        lightPoints = lightsToRender cfig (w ^. cWorld . cwCamPos) (w ^. cWorld . lWorld)
-        viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
+        viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCamPos . camViewFrom
         shadV = _pictureShaders pdata
         nFls = w ^. cWorld . numberFloorVerxs
     -- bind as much data into vbos as feasible at this point
@@ -116,10 +116,11 @@ doDrawing' win pdata u = do
     glEnable GL_BLEND
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     setViewport _graphics_overlay_resolution cfig
-    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. orthonormalMatUBO)
+    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
+    withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig))
+        $ \ptr -> glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
     renderLayer FixedCoordLayer shadV layerCounts
     -- set the coordinate uniform ready for drawing elements using world coordinates
-    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
     withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr ->
         glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
     renderLayer DebugLayer shadV layerCounts

src/Dodge/Render/HUD.hs

@@ -41,7 +41,7 @@ drawHUD cfig w = case w ^. hud . hudElement of
             <> drawSubInventory subinv cfig w
 
 drawHP :: Configuration -> World -> Picture
-drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
+drawHP cfig w = dShadCol white $ displayHP 0 cfig w
 
 
 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
@@ -265,7 +265,7 @@ eqPosText ep = case ep of
     OnSpecial -> "EQUIPPED"
 
 combineCounts :: Configuration -> World -> [Int] -> Picture
-combineCounts cfig w = winScale cfig . foldMap f . group
+combineCounts cfig w = foldMap f . group
   where
     f (i : is) = fromMaybe mempty $ do
         _ <- yourInv w ^? ix i . itUse . useAmount
@@ -277,8 +277,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col =
-    winScale cfig
+        foldMap f
-        . foldMap f
   where
     f j = fromMaybe mempty $ do
         sss <- w ^? hud . hudElement . diSections
@@ -302,8 +301,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 
 invHead :: Configuration -> String -> Picture
 invHead cfig =
-    winScale cfig
+        translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
-        . translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
         . dShadCol white
         . scale 0.4 0.4
         . text
@@ -314,7 +312,7 @@ drawCarte cfig w =
         renderListAt 0 0 cfig locs :
        -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
        --     ++ 
-        mapOverlay cfig w
+        mapOverlay w
             ++ [mainListCursor white iPos cfig]
   where
     iPos = w ^. cWorld . lWorld . selLocation
@@ -330,17 +328,17 @@ drawCarte cfig w =
 --    h :: String -> Point2 -> Point2
 --    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
-mapOverlay :: Configuration -> World -> [Picture]
+mapOverlay :: World -> [Picture]
-mapOverlay cfig w =
+mapOverlay w =
     (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
-    [foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
+    [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
   where
     --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
 
     lw = w ^. cWorld . lWorld
 
-drawMapWall :: Configuration -> HUD -> Wall -> Picture
+drawMapWall :: HUD -> Wall -> Picture
-drawMapWall cfig thehud wl = color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
+drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
   where
     t = normalizeV (y -.- x)
     n2 = 20 *.* vNormal t
@@ -420,8 +418,7 @@ openCursorAt ::
     Configuration ->
     Picture
 openCursorAt wth col xoff yoff yint w =
-    winScale w
+        translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
-        . translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
         $ lineCol
             [ (V2 wth 12.5, withAlpha 0 col)
             , (V2 0 12.5, col)

src/Dodge/Render/InfoBox.hs

@@ -14,7 +14,7 @@ import Picture
 renderInfoListAt :: Float -> Float -> Configuration -> CamPos -> (Point2, [String]) -> Picture
 renderInfoListAt x y cfig cam (p, ss) =
     renderListAt x y cfig (zip ss (repeat white))
-        <> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
+        <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
         <> listCursorNSW x y cfig 0 0 white 19 (length ss)
   where
     hw = halfWidth cfig

src/Dodge/Render/Label.hs

@@ -1,25 +1,22 @@
-module Dodge.Render.Label
+module Dodge.Render.Label where
-    where
+
-import Dodge.Base.Coordinate
-import Dodge.ShortShow
-import Dodge.Base.WinScale
-import Picture
 import Dodge.Data.Universe
+import Dodge.ShortShow
 import Geometry
+import Picture
 
-drawLabCrossCol :: Configuration -> CamPos -> Color -> Point2 -> Picture
+drawLabCrossCol :: Color -> Point2 -> Picture
-drawLabCrossCol cfig w col p = drawCrossCol col p
+drawLabCrossCol col p =
-    <> drawPointLabel cfig w p
+    drawCrossCol col p
+        <> drawPointLabel p
 
-drawPointLabel :: Configuration -> CamPos -> Point2 -> Picture 
+drawPointLabel :: Point2 -> Picture
-drawPointLabel cfig w p =
+drawPointLabel p =
-    setLayer FixedCoordLayer . winScale cfig
+    setLayer DebugLayer
-        . uncurryV translate p'
+        . uncurryV translate p
         . scale 0.1 0.1
         . text
         $ shortPoint2 p
-  where
-    p' = worldPosToScreen w p
 
 drawCrossCol :: Color -> Point2 -> Picture
 drawCrossCol col p = setLayer DebugLayer . color col . uncurryV translate p $ crossPic 5

src/Dodge/Render/List.hs

@@ -1,19 +1,20 @@
 module Dodge.Render.List where
 
 --import Picture.Text
-import Dodge.Inventory
+
 --import Data.Foldable
-import Dodge.SelectionList
+
 import Data.Maybe
-import Dodge.Base.WinScale
 import Dodge.Base.Window
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
+import Dodge.Inventory
+import Dodge.SelectionList
 import Geometry
+import LensHelp
 import ListHelp
 import Picture
-import LensHelp
 
 drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionList ldps cfig sl =
@@ -31,6 +32,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures sl = concatMap f $ getShownItems sl
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
+
 --f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
 
 drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
@@ -116,8 +118,7 @@ listCursorChooseBorderScale ::
     Int ->
     Picture
 listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
-    winScale cfig
+    translate
-        . translate
         (15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
         (halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
@@ -160,8 +161,7 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
 
 fillScreenText :: Configuration -> String -> Picture
 fillScreenText cfig str =
-    winScale cfig
+    scale wscale hscale
-        . scale wscale hscale
         . centerText
         $ str
   where
@@ -172,8 +172,7 @@ fillScreenText cfig str =
 
 fillWidthText :: Configuration -> String -> Picture
 fillWidthText cfig str =
-    winScale cfig
+    scale thescale thescale
-        . scale thescale thescale
         . centerText
         $ str
   where
@@ -182,8 +181,7 @@ fillWidthText cfig str =
 
 listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
 listTextPictureAt xoff yoff cfig yint =
-    winScale cfig
+    translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
-        . translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
         . scale 0.1 0.1
   where
     hw = halfWidth cfig
@@ -191,8 +189,7 @@ listTextPictureAt xoff yoff cfig yint =
 
 listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
 listTextPictureAtScale ygap s xoff yoff cfig yint =
-    winScale cfig
+    translate (xoff + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
-        . translate (xoff + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
         . scale (s * 0.1) (s * 0.1)
   where
     hw = halfWidth cfig

src/Dodge/Render/MenuScreen.hs

@@ -3,7 +3,6 @@ module Dodge.Render.MenuScreen (
     drawMenuScreen,
 ) where
 
-import Dodge.Base.WinScale
 import Dodge.Data.SelectionList
 import Dodge.Render.List
 import Dodge.Base.Window
@@ -46,10 +45,10 @@ drawOptions ldps cfig title sl =
         ]
 
 darkenBackground :: Configuration -> Picture
-darkenBackground cfig = winScale cfig . color (withAlpha 0.5 black) . polygon . reverse . screenBox $ cfig
+darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
 drawTitle :: Configuration -> String -> Picture
-drawTitle cfig = winScale cfig . translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
+drawTitle cfig =  translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
   where
     hh = halfHeight cfig
     hw = halfWidth cfig

src/Dodge/Render/Picture.hs

@@ -3,31 +3,35 @@ module Dodge.Render.Picture (
 ) where
 
 import Control.Lens
-import Dodge.Base.WinScale
+import Data.Maybe
+import Dodge.Base.Coordinate
 import Dodge.Base.Window
 import Dodge.Data.Universe
 import Dodge.Render.HUD
 import Dodge.Render.List
 import Dodge.Render.MenuScreen
 import Geometry
+import HelpNum
 import Picture
 
 fixedCoordPictures :: Universe -> Picture
-fixedCoordPictures u = drawMenuOrHUD cfig u 
+fixedCoordPictures u =
+    drawMenuOrHUD cfig u
         <> drawConcurrentMessage u
-    <> customMouseCursor cfig (u ^. uvWorld . input)
+        <> customMouseCursor u
         <> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u))
         <> displayFrameTicks u
   where
     cfig = _uvConfig u
 
 displayFrameTicks :: Universe -> Picture
-displayFrameTicks u =   if (debugOn Show_ms_frame $ _uvConfig u) then
+displayFrameTicks u =
-         ( setDepth (-1)
+    if debugOn Show_ms_frame $ _uvConfig u
-                . translate (-0.5) (-0.8)
+        then
-                . scale 0.0005 0.0005
+            setDepth (-1)
+                . translate (-10) (- halfHeight (_uvConfig u) + 6)
+                . scale 0.2 0.2
                 $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
-            )
         else mempty
 
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
@@ -49,7 +53,7 @@ drawConcurrentMessage :: Universe -> Picture
 drawConcurrentMessage u =
     stackPicturesAt
         (halfWidth cfig)
-        (_windowY cfig - 50)
+        (windowYFloat cfig - 50)
         cfig
         (map (centerText . f) $ u ^.. uvSideEffects . each)
   where
@@ -57,9 +61,26 @@ drawConcurrentMessage u =
     f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
     f x = _ceString x ++ " QUEUED"
 
-customMouseCursor :: Configuration -> Input -> Picture
+customMouseCursor :: Universe -> Picture
-customMouseCursor cfig inp =
+customMouseCursor u =
-    winScale cfig
+    uncurryV translate (u ^. uvWorld . input . mousePos)
-        . uncurryV translate (_mousePos inp)
         . color white
-        $ pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
+        $ mouseCursorType u
+
+mouseCursorType :: Universe -> Picture
+mouseCursorType u
+    | null (u ^. uvScreenLayers) = rotate a (drawPlus 5)
+    | otherwise = mousePlus
+  where
+    w = u ^. uvWorld
+    a = fromMaybe 0 $ do
+        cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
+        return . toClosestMultiple (pi / 32) $
+            argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos)
+                - w ^. cWorld . cwCamPos . camRot
+
+mousePlus :: Picture
+mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
+
+drawPlus :: Float -> Picture
+drawPlus x = pictures [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]

src/Dodge/Render/ShapePicture.hs

@@ -53,7 +53,7 @@ worldSPic cfig u =
         <> foldup floorItemSPic (filtOn _flItPos _floorItems)
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup mcSPic (filtOn _mcPos _machines)
-        <> aimDelaySweep cfig w
+        <> aimDelaySweep w
         <> anyTargeting cfig w
   where
     w = _uvWorld u
@@ -61,22 +61,21 @@ worldSPic cfig u =
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
 
-aimDelaySweep :: Configuration -> World -> SPic
+aimDelaySweep :: World -> SPic
-aimDelaySweep cfig w = fromMaybe mempty $ do
+aimDelaySweep w = fromMaybe mempty $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
     aimstatus <- cr ^? crStance . posture
     guard (aimstatus == Aiming)
-    return $ noShape $ drawSweep cr cfig w
+    return $ noShape $ drawSweep cr w
 
-drawSweep :: Creature -> Configuration -> World -> Picture
+drawSweep :: Creature -> World -> Picture
-drawSweep cr cfig w = fromMaybe mempty $ do
+drawSweep cr w = fromMaybe mempty $ do
     a <- safeArgV (mwp -.- p)
     let a'
             | a - cdir > pi = cdir + 2 * pi
             | a - cdir < - pi = cdir - 2 * pi
             | otherwise = cdir
     return $
-        winScale cfig $
             setLayer FixedCoordLayer $
                 uncurryV translate (worldPosToScreen campos p) $
                     arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
@@ -84,7 +83,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do
     cdir = _crDir cr
     rot = campos ^. camRot
     p = _crPos cr
-    campos = w ^. cWorld . camPos
+    campos = w ^. cWorld . cwCamPos
     theinput = w ^. input
     mwp = mouseWorldPos theinput campos
 
@@ -135,8 +134,8 @@ shiftDraw' fpos fdir fdraw x =
 
 cullPoint :: Configuration -> World -> Point2 -> Bool
 cullPoint cfig w p
-    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . camPos . camBoundBox)
+    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCamPos . camBoundBox)
-    | otherwise = dist (w ^. cWorld . camPos . camCenter) p < (w ^. cWorld . camPos . camViewDistance)
+    | otherwise = dist (w ^. cWorld . cwCamPos . camCenter) p < (w ^. cWorld . cwCamPos . camViewDistance)
 
 extraPics :: Configuration -> Universe -> Picture
 extraPics cfig u =
@@ -199,24 +198,23 @@ debugDraw' cfig w bl = case bl of
     Cr_awareness -> drawCreatureDisplayTexts w
     Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
     Cr_status -> drawCrInfo cfig (w ^. cWorld)
-    Mouse_position -> drawMousePosition cfig w
+    Mouse_position -> drawMousePosition w
-    Walls_info -> drawWlIDs cfig w
+    Walls_info -> drawWlIDs w
     Pathing -> drawPathing cfig w
     Show_nodes_near_select -> undefined --drawNodesNearSelect w
     Show_path_between -> drawPathBetween w
-    Collision_test -> drawCollisionTest cfig w
+    Collision_test -> drawCollisionTest w
 
-drawCollisionTest :: Configuration -> World -> Picture
+drawCollisionTest :: World -> Picture
-drawCollisionTest cfig w =
+drawCollisionTest w =
     setLayer DebugLayer (color orange $ line [a, b])
         <> foldMap (drawCross . fst) (crHit a b w)
         <> foldMap (drawCross . _crPos) (crsNearSeg a b w)
         <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
         <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
-        <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b)
+        <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b)
   where
     (a, b) = _lrLine (_input w)
-    cam = w ^. cWorld . camPos
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
@@ -245,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do
 
 drawWallsNearCursor :: World -> Picture
 drawWallsNearCursor w =
-    setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_camPos $ _cWorld w)) w
+    setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCamPos $ _cWorld w)) w
   where
     f wl = color rose $ thickLine 3 [a, b]
       where
@@ -309,13 +307,13 @@ drawFarWallDetect w =
             )
         $ getViewpoints p (_cWorld w)
   where
-    p = w ^. cWorld . camPos . camViewFrom
+    p = w ^. cWorld . cwCamPos . camViewFrom
 
 drawZoneNearPointCursor :: World -> Picture
 drawZoneNearPointCursor w =
     foldMap (drawZoneCol orange 50) ps
   where
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     ps = [zoneOfPoint 50 mwp]
 
 drawDDATest :: World -> Picture
@@ -323,8 +321,8 @@ drawDDATest w =
     foldMap (drawZoneCol orange 50) ps
         <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
   where
-    cvf = w ^. cWorld . camPos . camViewFrom
+    cvf = w ^. cWorld . cwCamPos . camViewFrom
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     ps = zoneOfSeg 50 cvf mwp
 
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
@@ -344,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
         setLayer DebugLayer $
             color yellow $
                 uncurryV translate p (circle 5)
-                    <> line [w ^. cWorld . camPos . camViewFrom, p]
+                    <> line [w ^. cWorld . cwCamPos . camViewFrom, p]
 
 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
@@ -352,7 +350,7 @@ testPic _ _ = mempty
 drawBoundingBox :: World -> Picture
 drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
   where
-    (x : xs) = w ^. cWorld . camPos . camBoundBox
+    (x : xs) = w ^. cWorld . cwCamPos . camBoundBox
 
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
@@ -377,7 +375,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
   where
     p = _soundPos s
     thePic =
-        rotate (w ^. cWorld . camPos . camRot)
+        rotate (w ^. cWorld . cwCamPos . camRot)
             . scale theScale theScale
             . centerText
             . soundToOnomato
@@ -385,31 +383,28 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
     theScale = 0.15 * f (_soundVolume s * 0.0001)
     f x = 1 - 0.5 * (1 - x)
 
-drawMousePosition :: Configuration -> World -> Picture
+drawMousePosition :: World -> Picture
-drawMousePosition cfig w =
+drawMousePosition w =
     setLayer FixedCoordLayer
-        . winScale cfig
+        . uncurryV translate (w ^. input . mousePos)
-        . uncurryV translate p
         . scale 0.1 0.1
         . text
         $ shortPoint2 mwp
   where
-    p = worldPosToScreen (w ^. cWorld . camPos) mwp
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
 
-drawWlIDs :: Configuration -> World -> Picture
+drawWlIDs :: World -> Picture
-drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
+drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
   where
     f wl
         | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
         | otherwise =
-            winScale cfig
+                uncurryV translate p
-                . uncurryV translate p
                 . scale 0.1 0.1
                 . text
                 $ show $ _wlID wl
       where
-        p = worldPosToScreen (w ^. cWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
+        p = worldPosToScreen (w ^. cWorld . cwCamPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
 
 edgeToPic :: [Point2] -> PathEdge -> Picture
 edgeToPic poly pe
@@ -422,7 +417,7 @@ edgeToPic poly pe
 drawPathing :: Configuration -> World -> Picture
 drawPathing cfig w =
     setLayer DebugLayer $
-        foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . camPos)) . (^?! _3)) (FGL.labEdges gr)
+        foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCamPos)) . (^?! _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
@@ -459,7 +454,7 @@ drawCrInfo cfig w =
         renderInfoListsAt (2 * hw - 400) 0 cfig cam $
             mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
   where
-    cam = w ^. camPos
+    cam = w ^. cwCamPos
     hw = halfWidth cfig
 
 viewBoundaries :: CWorld -> Picture
@@ -468,7 +463,7 @@ viewBoundaries w =
         color green (foldMap (polygonWire . _grBound) grs)
             <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
   where
-    p = w ^. camPos . camViewFrom
+    p = w ^. cwCamPos . camViewFrom
     grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
 
 viewClipBounds :: Configuration -> World -> Picture

src/Dodge/SelectionList.hs

@@ -12,7 +12,7 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
   where
     vgap = ldps ^. ldpVerticalGap
     itmHeight = 10 * ldps ^. ldpScale + vgap
-    dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot)
+    dToBot = fromIntegral (cfig ^. windowY) - (ldps ^. ldpPosY + dFromScreenBot)
     dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
 
 getShownItems :: SelectionList a -> [SelectionItem a]

src/Dodge/SoundLogic.hs

@@ -163,9 +163,9 @@ soundAngle p w
             . radToDeg
             . normalizeAngle
             . (+ pi)
-            $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . camPos . camRot)
+            $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCamPos . camRot)
   where
-    earPos = w ^. cWorld . camPos . camViewFrom
+    earPos = w ^. cWorld . cwCamPos . camViewFrom
 
 {- | Uses the first free origin from a list.
 Does nothing if all origins are already creating sounds.

src/Dodge/Targeting.hs

@@ -49,7 +49,7 @@ targetRBCreatureUp cr w
             . filter (canseepos . _crPos)
             $ crsNearCirc mwp 40 w
     canseepos p = hasLOS (_crPos cr) p w
-    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
     updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
     posFromMaybeID Nothing = Nothing
     posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
@@ -61,7 +61,7 @@ targetRBCreatureUp cr w
 targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
 targetCursorUpdate w ct =
     ct
-        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
         & ctActive .~ True
             & ctType ?~ TargetCursor
 
@@ -69,7 +69,7 @@ targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
 targetRBPressUpdate w t
     | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
         t
-            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just
+            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)) Just
             & ctActive .~ True
             & ctType ?~ TargetRBPress
     | otherwise =
@@ -100,7 +100,7 @@ targetLaserUpdate cr w t
   where
     (mp, _) = reflectLaserAlong 0.2 sp ep w
     sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
-    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- sp)
+    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- sp)
     addLaserPic =
         cWorld . lWorld . lasers
             .:~ LaserStart

src/Dodge/Targeting/Draw.hs

@@ -23,31 +23,27 @@ targetSimpleDraw :: Creature -> Configuration -> World -> Picture
 targetSimpleDraw = targetDraw activeTargetCursorPic
 
 targetDistanceDraw :: Creature -> Configuration -> World -> Picture
-targetDistanceDraw cr cfig w = fromMaybe mempty $ do
+targetDistanceDraw cr _ w = fromMaybe mempty $ do
     p <- cr ^? crTargeting . ctPos . _Just
     let p1 = worldPosToScreen cam p
-        mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+        mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
         p2 = worldPosToScreen cam mwp
         thecol = if dist p mwp > 100 then red else white
-    return $
+    return .
-        winScale cfig $
             setLayer FixedCoordLayer $
                 color thecol $
                     line [p1, p2]
                         <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
   where
-    cam = w ^. cWorld . camPos
+    cam = w ^. cWorld . cwCamPos
 
 targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
-targetDraw f cr cfig w = fromMaybe mempty $ do
+targetDraw f cr _ _ = fromMaybe mempty $ do
     p <- cr ^? crTargeting . ctPos . _Just
-    return $
+    return .
-        winScale cfig $
+            setLayer DebugLayer $
-            setLayer FixedCoordLayer $
                 color white $
-                    uncurryV translate (worldPosToScreen cam p) f
+                    uncurryV translate p f
-  where
-    cam = w ^. cWorld . camPos
 
 activeTargetCursorPic :: Picture
 activeTargetCursorPic =

src/Dodge/TestString.hs

@@ -1,5 +1,9 @@
 module Dodge.TestString where
 
+import HelpNum
+import Dodge.Base.Coordinate
+import Geometry.Vector
+import Data.Maybe
 import Dodge.Render.Lights
 import Data.Aeson (ToJSON)
 import Data.ByteString.Lazy.Char8 (unpack)
@@ -11,12 +15,21 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . camPos) 
+testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCamPos) 
         (u ^. uvWorld . cWorld . lWorld)
+        , show a
+        , show $ u ^. uvWorld . input . mousePos
         , show $ u ^. uvConfig . windowX
         , show $ u ^. uvConfig . windowY
         , show $ u ^. uvWorld . input . scrollTestInt
         ]
+  where
+    w = u ^. uvWorld
+    a = fromMaybe 0 $ do 
+        cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
+        return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos)
+            - w ^. cWorld . cwCamPos . camRot
+
     --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
 --    [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
 

src/Dodge/Update.hs

@@ -281,7 +281,7 @@ zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
 
 updateWorldSelect' :: World -> World
-updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . camPos)) w
+updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCamPos)) w
 
 updateWorldSelect :: CamPos -> Input -> Input
 updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of

src/Dodge/Update/Camera.hs

@@ -29,8 +29,8 @@ updateCamera :: Configuration -> World -> World
 updateCamera cfig w =
     w
         & updateBounds cfig
-        & over (cWorld . camPos) (setViewDistance cfig)
+        & over (cWorld . cwCamPos) (setViewDistance cfig)
-        & cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w)
+        & 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' > 0.01 = w & cWorld . cwCamPos . camRot +~ 0.01
-        | b - b' < negate 0.01 = w & cWorld . camPos . 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 . cwCamPos . camBoundDist .~ bdists
-        & cWorld . camPos . camBoundBox
+        & cWorld . cwCamPos . camBoundBox
-            .~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e)
+            .~ 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} ->
+    screen -> optionScreenUpdate screen
-        optionScreenUpdate screen mop ldps sellist
 
 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 =
+optionScreenUpdate screen u =
-    refreshOptionsSelectionList
+    (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 
+mouseOverSelectionList ::
-    -> SelectionList a -> Universe -> Universe
+    ListDisplayParams ->
-mouseOverSelectionList ldps sl u
+    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}

src/Dodge/WindowSize.hs

@@ -5,4 +5,4 @@ import Dodge.Data.Config
 getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a,a)
 getWindowSize f cfig = (g _windowX, g _windowY)
   where
-    g h = fromIntegral $ round (h cfig) `div` resFactorNum (f cfig)
+    g h = fromIntegral $ applyResFactor (f cfig) (h cfig)

src/Dodge/WorldEffect.hs

@@ -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 . camPos . camRot) (+ rot) w
+    | cid == 0 = set randGen g $ over (cWorld . cwCamPos . 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/WorldEvent/Cloud.hs

@@ -73,4 +73,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
 spawnSmokeAtCursor :: World -> World
 spawnSmokeAtCursor w = shellTrailCloud 400 100 (V3 x y 20) w
   where
-    V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
+    V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)

src/Dodge/Zone/Size.hs

@@ -1,10 +1,4 @@
 module Dodge.Zone.Size where
 
---pnZoneSize :: Float
---pnZoneSize = 100
-
 clZoneSize :: Float
 clZoneSize = 20
-
---peZoneSize :: Float
---peZoneSize = 50

src/Framebuffer/Update.hs

@@ -7,6 +7,7 @@ module Framebuffer.Update (
     sizeFBOs,
 ) where
 
+import Dodge.WindowSize
 import Control.Lens
 import Control.Monad
 import Data.Preload.Render
@@ -31,36 +32,50 @@ sizeFBOs cfig rdata =
                 GL_NEAREST
                 GL_NEAREST
                 GL_RGBA8
-                GL_RGBA16F
+                GL_RGBA16F -- i am not sure if this should not be GL_RGBA32F
                 GL_RGBA16F
             )
             rdata
             [fboBase, fboCloud]
-            >>= flip
+            >>= foldUpdateFBOTO
-                ( uncurry
+                _graphics_world_resolution
-                    updateFBOTO
-                    (getWindowSize _graphics_world_resolution cfig)
                 GL_NEAREST
                 GL_NEAREST
                 GL_RGBA8
-                )
+                [fboLighting]
-                fboLighting
+            >>= foldUpdateFBOTO
-            >>= ffoldM
+                _graphics_world_resolution
-                ( uncurry
-                    updateFBOTO
-                    (getWindowSize _graphics_world_resolution cfig)
                 GL_LINEAR_MIPMAP_LINEAR
                 GL_LINEAR
                 GL_RGBA16F
-                )
                 [fboBloom, fboPos]
-            >>= ffoldM
+            >>= foldUpdateFBOTO
-                (uncurry updateFBOTO (getWindowSize _graphics_overlay_resolution cfig) GL_LINEAR GL_NEAREST GL_RGBA8)
+                _graphics_overlay_resolution
+                GL_LINEAR
+                GL_NEAREST
+                GL_RGBA8
                 [fbo2, fbo3, fboOverlay]
-            >>= ffoldM
+            >>= foldUpdateFBOTO
-                (uncurry updateFBOTO (getWindowSize _graphics_downsize_resolution cfig) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
+                _graphics_downsize_resolution
+                GL_LINEAR_MIPMAP_LINEAR
+                GL_LINEAR
+                GL_RGBA16F
                 [fboHalf1, fboHalf2, fboHalf3]
             >>= resizeShadowFBO' cfig
+  where
+    updateFBOTO' f =
+        uncurry
+            updateFBOTO
+            (getWindowSize f cfig)
+    foldUpdateFBOTO f minfilt magfilt format l =
+        ffoldM
+            ( updateFBOTO'
+                f
+                minfilt
+                magfilt
+                format
+            )
+            l
 
 ffoldM ::
     (Foldable t, Monad m) =>
@@ -254,7 +269,7 @@ initializeTexture2DArray fbo attachpoint x y z minfilt magfilt informat = do
     glNamedFramebufferTexture (_unFBO fbo) attachpoint to1 0
     return to1
 
-getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a, a)
+--getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a, a)
-getWindowSize f cfig = (g _windowX, g _windowY)
+--getWindowSize f cfig = (g _windowX, g _windowY)
-  where
+ -- where
-    g h = fromIntegral $ round (h cfig) `div` resFactorNum (f cfig)
+  --  g h = fromIntegral $ h cfig `div` resFactorNum (f cfig)

src/MatrixHelper.hs

@@ -1,6 +1,7 @@
 module MatrixHelper
     ( perspectiveMatrixb
     , isoMatrix
+    , scaleMatrix
     ) where
 import Geometry.Data
 
@@ -52,6 +53,9 @@ perMat x = V4
     (V4 0 0 1 0)
     (V4 0 0 x 1)
 
+scaleMatrix :: Float -> Float -> [V4 Float]
+scaleMatrix x = vToL . scaleMat . V2 x
+
 scaleMat :: Point2 -> V4 (V4 Float)
 scaleMat (V2 x y) = V4
     (V4 x 0 0 0)

src/Picture/Base.hs

@@ -25,6 +25,7 @@ module Picture.Base (
     line,
     lineCol,
     text,
+    drawText,
     centerText,
     stackText,
     pictures,
@@ -200,10 +201,14 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
 
 text :: String -> Picture
 {-# INLINE text #-}
-text = map f . stringToList
+text = translate (-50) (-100) . drawText (-10)
+
+drawText :: Float -> String -> [Verx]
+drawText gap = map f . stringToList gap
   where
     f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum
 
+
 line :: [Point2] -> Picture
 {-# INLINE line #-}
 line = thickLine 1
@@ -291,18 +296,18 @@ overCol :: (Point4 -> Point4) -> Verx -> Verx
 overCol f vx = vx{_vxCol = f (_vxCol vx)}
 
 -- no premature optimisation, consider changing to use texture arrays
-stringToList :: String -> [(Point3, Point4, Point3)]
+stringToList :: Float -> String -> [(Point3, Point4, Point3)]
 {-# INLINE stringToList #-}
-stringToList = concatMap (uncurry charToTuple) . zip [0, 0.9 * dimText ..]
+stringToList gap = concatMap (uncurry charToTuple) . zip [0, 100 + gap ..]
-  where
-    dimText = 100
 
 charToTuple :: Float -> Char -> [(Point3, Point4, Point3)]
 {-# INLINE charToTuple #-}
 charToTuple xoff c = [f 0 0, f 1 0, f 1 1, f 0 0, f 1 1, f 0 1]
   where
-    f x y = (V3 (xoff - 50 + x * 100) (100 - y * 200) 0, white, V3 x y offset)
+    f x y = (V3 (xoff + x * 100) (y * 200) 0, white, V3 x (1 - y) charnum)
-    offset = fromIntegral (fromEnum c) - 32
+    -- textures in opengl have origins at the lower left, my char array has its
+    -- origin at the upper left
+    charnum = fromIntegral (fromEnum c) - 32
 
 --charToTuple' :: Float -> Char -> [(Point3, Point4, Point3)]
 --{-# INLINE charToTuple' #-}

src/Preload/Render.hs

@@ -7,8 +7,6 @@ module Preload.Render (
 
 import Shader.AuxAddition
 import Shape.Data
-import Geometry.Data
-import MatrixHelper
 import GLHelp
 import Control.Lens
 import Control.Monad
@@ -36,9 +34,9 @@ preloadRender = do
     glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
     glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
     
-    orthonormalUBO <- mglCreate glCreateBuffers
+--    orthonormalUBO <- mglCreate glCreateBuffers
-    withArray (isoMatrix 0 1 (V2 0 0) (V2 1 1)) $ \ptr ->
+--    withArray idMat $ \ptr ->
-        glNamedBufferStorage orthonormalUBO 64 ptr 0
+--        glNamedBufferStorage orthonormalUBO 64 ptr 0
 
     lightsubo <- mglCreate glCreateBuffers
     glNamedBufferData lightsubo 640 nullPtr GL_STREAM_DRAW
@@ -190,7 +188,7 @@ preloadRender = do
             , _fboOverlay = fbooverlay
             , _rboBaseBloom = rboBaseBloomName
             , _matUBO = theUBO
-            , _orthonormalMatUBO = orthonormalUBO
+--            , _orthonormalMatUBO = orthonormalUBO
             , _lightsUBO = lightsubo
             , _vboWindows = winvbo
             , _vboShapes = shVBO