smoother automatics

app/demo.hs

@@ -5,6 +5,5 @@ cosTest  = funcSeries cos (enumRange 100 (R (-5) 5)) def
 lineTest = funcSeries id  (enumRange 20  (R (-4) 4)) def
 
 main :: IO ()
-main = runPlot def (Just (R (-6) 6)) Nothing $
-            fromAutoSeries [cosTest, lineTest]
+main = runPlotAuto def [cosTest, lineTest]
 

src/Interactive/Plot.hs

@@ -1,8 +1,10 @@
 
 module Interactive.Plot (
     module P
+  , Default(..)
   ) where
 
+import           Data.Default
 import           Interactive.Plot.Core   as P
 import           Interactive.Plot.Run    as P
 import           Interactive.Plot.Series as P

src/Interactive/Plot/Core.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 module Interactive.Plot.Core (
-    Coord(..), Range(..), PointStyle(..), Series(..), Alignment(..), PlotOpts
+    Coord(..), Range(..), PointStyle(..), Series(..), Alignment(..), PlotOpts(..)
   , renderPlot
   , scaleRange, rSize
   , OrdColor(..)
@@ -97,33 +97,52 @@ data Alignment = ALeft
 --                      }
 --                 deriving (Show)
 
-data PlotOpts = PO { poRatio :: Double      -- ^ character width ratio (height to width)
+data PlotOpts = PO { poTermRatio   :: Double            -- ^ character width ratio of terminal (H/W)
+                   , poAspectRatio :: Maybe Double      -- ^ plot aspect ratio (H/W)
+                   , poXRange      :: Maybe (Range Double)
+                   , poYRange      :: Maybe (Range Double)
                    }
 
 instance Default PlotOpts where
-    def = PO { poRatio = 2.1
+    def = PO { poTermRatio   = 2.1
+             , poAspectRatio = Just 1
+             , poXRange      = Nothing
+             , poYRange      = Nothing
              }
 
 
 plotRange
     :: PlotOpts
     -> Coord (Range Int)      -- ^ display region
-    -> Maybe (Range Double)   -- ^ X range
-    -> Maybe (Range Double)   -- ^ Y range
     -> [Series]               -- ^ Points
     -> Coord (Range Double)   -- ^ actual plot axis range
-plotRange PO{..} dr rX rY ss = case (rX, rY) of
-    (Nothing, Nothing) -> pointRange
-    (Just x , Nothing) -> C x (setRangeSize (rSize x * displayRatio) $ cY pointRange)
-    (Nothing, Just y ) -> C (setRangeSize (rSize y / displayRatio) $ cX pointRange) y
-    (Just x , Just y ) -> C x y
+plotRange PO{..} dr ss = case poAspectRatio of
+    Just rA ->
+      let displayRatio = fromIntegral (rSize (cY dr))
+                       / (fromIntegral (rSize (cX dr)) * poTermRatio)
+                       * rA
+      in  case (poXRange, poYRange) of
+            (Nothing, Nothing) -> case compare pointRangeRatio displayRatio of
+              LT -> C (setRangeSize (rSize (cY pointRange) / displayRatio) (cX pointRange))
+                      (cY pointRange)
+              EQ -> pointRange
+              GT -> C (cX pointRange)
+                      (setRangeSize (rSize (cX pointRange) * displayRatio) (cY pointRange))
+            (Just x , Nothing) -> C x (setRangeSize (rSize x * displayRatio) $ cY pointRange)
+            (Nothing, Just y ) -> C (setRangeSize (rSize y / displayRatio) $ cX pointRange) y
+            (Just x , Just y ) -> C x y
+    Nothing -> case (poXRange, poYRange) of
+      (Nothing, Nothing) -> pointRange
+      (Just x , Nothing) -> C x (cY pointRange)
+      (Nothing, Just y ) -> C (cX pointRange) y
+      (Just x , Just y ) -> C x y
   where
-    displayRatio = fromIntegral (rSize (cY dr))
-                 / (fromIntegral (rSize (cX dr)) * poRatio)
     unZero :: Range Double -> Range Double
     unZero r
       | rSize r == 0 = R (subtract 1) (+ 1) <*> r
       | otherwise    = r
+    pointRangeRatio :: Double
+    pointRangeRatio = rSize (cY pointRange) / rSize (cX pointRange)
     pointRange :: Coord (Range Double)
     pointRange = fmap unZero
                . foldl' (liftA2 go) (C (R 0 0) (R 0 0))
@@ -136,14 +155,15 @@ renderPlot
     -> Coord (Range Double)     -- ^ plot axis range
     -> [Series]
     -> [Image]
-renderPlot dr pr ss = concatMap (renderSeries dr pr) ss
-                   ++ renderAxis dr pr
+renderPlot dr pr = overlayAxis dr pr
+                 . concatMap (renderSeries dr pr)
 
-renderAxis
+overlayAxis
     :: Coord (Range Int)        -- ^ display region
     -> Coord (Range Double)     -- ^ plot axis range
+    -> [Image]                  -- ^ thing to overlay over
     -> [Image]
-renderAxis dr pr = foldMap toList axisBounds ++ axisLines
+overlayAxis dr pr is = foldMap toList axisBounds ++ is ++ axisLines
   where
     origin = placeImage dr pr (C ACenter ACenter) (C 0 0) $
                 char defAttr '+'

src/Interactive/Plot/Run.hs

@@ -3,10 +3,12 @@
 
 module Interactive.Plot.Run (
     runPlot
+  , runPlotAuto
   ) where
 
 import           Control.Applicative
 import           Control.Concurrent
+import           Interactive.Plot.Series
 import           Control.Monad
 import           Control.Monad.Trans.Maybe
 import           Data.Foldable
@@ -26,6 +28,7 @@ processEvent = \case
     EvKey (KChar 'c') [MCtrl] -> Just PEQuit
     EvKey (KChar 'q') []      -> Just PEQuit
     EvKey (KChar 'r') []      -> Just PEReset
+    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)
@@ -51,13 +54,17 @@ displayRange o = do
     (wd, ht) <- displayBounds o
     pure $ C (R 0 wd) (R 0 ht)
 
+runPlotAuto
+    :: PlotOpts
+    -> [AutoSeries]
+    -> IO ()
+runPlotAuto po = runPlot po . fromAutoSeries
+
 runPlot
     :: PlotOpts
-    -> Maybe (Range Double)     -- ^ x range
-    -> Maybe (Range Double)     -- ^ y range
     -> [Series]
     -> IO ()
-runPlot po rX rY ss = do
+runPlot po ss = do
     vty   <- mkVty =<< standardIOConfig
     psRef <- newIORef =<< initPS vty
     peChan <- newChan
@@ -70,7 +77,7 @@ runPlot po rX rY ss = do
     initPS :: Vty -> IO PlotState
     initPS vty = do
       dr    <- displayRange $ outputIface vty
-      pure PlotState { psRange    = plotRange po dr rX rY ss
+      pure PlotState { psRange    = plotRange po dr ss
                      , psSerieses = ss
                      }
     plotLoop