Camera position refactor

src/Dodge/Picture/SizeInvariant.hs

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