commit aspect ratio

mstksg · Jul 20, 2018 · 38583cd · 38583cd
1 parent ada4df3
commit 38583cd
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 4 deletions.
diff --git a/src/Interactive/Plot/Core.hs b/src/Interactive/Plot/Core.hs
@@ -149,10 +149,10 @@ plotRange PO{..} dr ss = case _poAspectRatio of
       in  case (_poXRange, _poYRange) of
             (Nothing, Nothing) -> case compare pointRangeRatio displayRatio of
               LT -> pointRange
-                      & cX . rSize .~ pointRange ^. cY . rSize / displayRatio
+                      & cY . rSize .~ pointRange ^. cX . rSize * displayRatio
               EQ -> pointRange
               GT -> pointRange
-                      & cY . rSize .~ pointRange ^. cX . rSize * displayRatio
+                      & cX . rSize .~ pointRange ^. cY . rSize / displayRatio
             (Just x , Nothing) -> pointRange
                                     & cX .~ x
                                     & cY . rSize .~ x ^. rSize * displayRatio

diff --git a/src/Interactive/Plot/Run.hs b/src/Interactive/Plot/Run.hs
@@ -20,6 +20,7 @@ import           Lens.Micro
 data PEvent = PEQuit
             | PEZoom   Double
             | PEPan    (Coord Double)
+            | PEAspect (Coord Double)
             | PEResize (Coord Int)
             | PEReset
 
@@ -32,8 +33,8 @@ processEvent = \case
     EvKey (KChar 'R') []      -> Just PEReset
     EvKey (KChar '=') []      -> Just $ PEZoom (sqrt 0.5)
     EvKey (KChar '+') []      -> Just $ PEZoom (sqrt 0.5)
-    EvKey (KChar '-') []      -> Just $ PEZoom (sqrt 2)
-    EvKey (KChar '_') []      -> Just $ PEZoom (sqrt 2)
+    EvKey (KChar '-') []      -> Just $ PEZoom (sqrt 2  )
+    EvKey (KChar '_') []      -> Just $ PEZoom (sqrt 2  )
     EvKey (KChar 'h') []      -> Just $ PEPan  (C (-0.2) 0     )
     EvKey (KChar 'j') []      -> Just $ PEPan  (C 0      (-0.2))
     EvKey (KChar 'k') []      -> Just $ PEPan  (C 0      0.2   )
@@ -42,6 +43,10 @@ processEvent = \case
     EvKey KDown       []      -> Just $ PEPan  (C 0      (-0.2))
     EvKey KUp         []      -> Just $ PEPan  (C 0      0.2   )
     EvKey KRight      []      -> Just $ PEPan  (C 0.2    0     )
+    EvKey (KChar 'v') []      -> Just $ PEAspect (C 1          (sqrt 2  ))
+    EvKey (KChar '^') []      -> Just $ PEAspect (C 1          (sqrt 0.5))
+    EvKey (KChar '<') []      -> Just $ PEAspect (C (sqrt 2  ) 1         )
+    EvKey (KChar '>') []      -> Just $ PEAspect (C (sqrt 0.5) 1         )
     EvResize ht wd            -> Just $ PEResize (C ht wd)
     _                         -> Nothing
 
@@ -110,6 +115,11 @@ runPlot po ss = do
           writeIORef psRef $
             ps & psRange %~ (<*>) (panner <$> d)
           pure True
+        PEAspect d -> do
+          let scaler s = fmap (* s)
+          writeIORef psRef $
+            ps & psRange %~ (<*>) (scaler <$> d)
+          pure True
         PEResize newDim -> do
           let oldDim = _rSize <$> dr
               newRange = do