From d74d4fd5ccaa81a8b94bcb916adeb5ec17cd019b Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Tue, 11 Aug 2020 12:22:56 +0200
Subject: [PATCH] use fixed number of digits in infobar

---
 src/app/MetaBrush/UI/Coordinates.hs |  6 ++++--
 src/app/MetaBrush/UI/InfoBar.hs     | 31 ++++++++++++++++++++---------
 2 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/src/app/MetaBrush/UI/Coordinates.hs b/src/app/MetaBrush/UI/Coordinates.hs
index 3f212cf..7bd6f16 100644
--- a/src/app/MetaBrush/UI/Coordinates.hs
+++ b/src/app/MetaBrush/UI/Coordinates.hs
@@ -62,6 +62,8 @@ import MetaBrush.UI.InfoBar
 --
 --   * On a scroll event, modifies the viewport coordinates as required.
 --   * On a scroll event or a mouse motion event, updates the info bar coordinate display.
+--
+-- TODO: also update on change of document.
 keepViewportCoordinatesUpdated
   :: STM.TVar ( Maybe Int )
   -> STM.TVar ( IntMap Document )
@@ -141,9 +143,9 @@ keepViewportCoordinatesUpdated
                     newZoomFactor :: Double
                     newZoomFactor
                       | dy > 0
-                      = max 0.0078125 ( oldZoomFactor / 2 )
+                      = max 0.0078125 ( oldZoomFactor / sqrt 2 )
                       | otherwise
-                      = oldZoomFactor * 2
+                      = min 256 ( oldZoomFactor * sqrt 2 )
                     newCenter :: Point2D Double
                     newCenter
                       = ( 1 - oldZoomFactor / newZoomFactor ) *^ ( oldCenter --> mousePos :: Vector2D Double )
diff --git a/src/app/MetaBrush/UI/InfoBar.hs b/src/app/MetaBrush/UI/InfoBar.hs
index 2302c95..51534c3 100644
--- a/src/app/MetaBrush/UI/InfoBar.hs
+++ b/src/app/MetaBrush/UI/InfoBar.hs
@@ -13,10 +13,14 @@ module MetaBrush.UI.InfoBar
   where
 
 -- base
+import Control.Arrow
+  ( second )
 import Control.Monad
   ( void )
 import Data.Foldable
   ( for_ )
+import Numeric
+  ( showFFloat )
 
 -- gi-cairo-connector
 import qualified GI.Cairo.Render.Connector as Cairo
@@ -34,7 +38,7 @@ import qualified Data.Text as Text
 
 -- MetaBrush
 import Math.Vector2D
-  ( Point2D(..), Vector2D(..) )
+  ( Point2D(..) )
 import MetaBrush.Asset.Colours
   ( Colours )
 import MetaBrush.Asset.Cursor
@@ -87,7 +91,7 @@ createInfoBar colours infoBar = do
   -- Magnifier
 
   magnifierArea <- GTK.drawingAreaNew
-  zoomText <- GTK.labelNew ( Just "100%" )
+  zoomText <- GTK.labelNew ( Just "  100.00%" )
 
   GTK.boxPackStart zoomBox magnifierArea True True 0
   GTK.boxPackStart zoomBox zoomText      True True 0
@@ -102,7 +106,7 @@ createInfoBar colours infoBar = do
   -- Cursor position
 
   cursorPosArea <- GTK.drawingAreaNew
-  cursorPosText <- GTK.labelNew ( Just "x:  50.00 px\ny:  50.00 px" )
+  cursorPosText <- GTK.labelNew ( Just "x:      0.00\ny:      0.00" )
 
   GTK.boxPackStart cursorPosBox cursorPosArea False False 0
   GTK.boxPackStart cursorPosBox cursorPosText False False 0
@@ -117,7 +121,7 @@ createInfoBar colours infoBar = do
   -- Top left position
 
   topLeftPosArea <- GTK.drawingAreaNew
-  topLeftPosText <- GTK.labelNew ( Just "x:   0.00 px\ny:   0.00 px" )
+  topLeftPosText <- GTK.labelNew ( Just "x:      0.00\ny:      0.00" )
 
   GTK.boxPackStart topLeftPosBox topLeftPosArea False False 0
   GTK.boxPackStart topLeftPosBox topLeftPosText False False 0
@@ -130,7 +134,7 @@ createInfoBar colours infoBar = do
   -- Bottom right position
 
   botRightPosArea <- GTK.drawingAreaNew
-  botRightPosText <- GTK.labelNew ( Just "x: 100.00 px\ny: 100.00 px" )
+  botRightPosText <- GTK.labelNew ( Just "x:      0.000\ny:      0.00" )
 
   GTK.boxPackStart botRightPosBox botRightPosArea False False 0
   GTK.boxPackStart botRightPosBox botRightPosText False False 0
@@ -162,8 +166,17 @@ updateInfoBar
     , botRightPos = Point2D  r  b
     }
   ) = do
-    GTK.labelSetText        zoomText $ Text.pack ( show ( 100 * zoom ) <> "%" )
-    GTK.labelSetText   cursorPosText $ Text.pack ( "x: " <> show mx <> "\ny: " <> show my )
-    GTK.labelSetText  topLeftPosText $ Text.pack ( "x: " <> show  l <> "\ny: " <> show  t )
-    GTK.labelSetText botRightPosText $ Text.pack ( "x: " <> show  r <> "\ny: " <> show  b )
+    GTK.labelSetText        zoomText $ Text.pack ( fixed 5 2 ( 100 * zoom ) <> "%" )
+    GTK.labelSetText   cursorPosText $ Text.pack ( "x: " <> fixed 6 2 mx <> "\ny: " <> fixed 6 2 my )
+    GTK.labelSetText  topLeftPosText $ Text.pack ( "x: " <> fixed 6 2  l <> "\ny: " <> fixed 6 2  t )
+    GTK.labelSetText botRightPosText $ Text.pack ( "x: " <> fixed 6 2  r <> "\ny: " <> fixed 6 2  b )
 
+fixed :: Int -> Int -> Double -> String
+fixed digitsBefore digitsAfter x = case second tail . break ( == '.' ) $ showFFloat ( Just digitsAfter ) x "" of
+  ( as, bs ) ->
+    let
+      l, r :: Int
+      l = length as
+      r = length bs
+    in
+      replicate ( digitsBefore - l ) ' ' <> as <> "." <> bs <> replicate ( digitsAfter - r ) '0'