@@ -6,6 +6,7 @@ module Example.CPU where
66import Control.Exception
77import Control.Monad.Fix
88import Control.Monad.IO.Class
9+import Data.Ratio
910import Data.Time
1011import Data.Word
1112import qualified Data.Text as T
@@ -112,38 +113,77 @@ cpuStats = do
112113 Just get' -> Just (sumStats get' nonIdleStats, sumStats get' idleStats)
113114 active <- foldDyn cpuPercentStep ((0, 0), 0) cpuStat
114115 let pct = fmap snd active
115− title = current $ ffor pct $ \x -> " CPU Usage: " <> T.pack (printf "%3.0f" $ x * 100) <> "% "
116− boxTitle (pure doubleBoxStyle) title $ col $ do
116+ chart pct
117+
118+chart
119+ :: ( MonadFix m
120+ , MonadFocus t m
121+ , MonadLayout t m
122+ , MonadNodeId m
123+ , ImageWriter t m
124+ , HasVtyInput t m
125+ , HasVtyWidgetCtx t m
126+ , HasDisplaySize t m
127+ )
128+ => Dynamic t (Ratio Word64) -> m ()
129+chart pct = do
130+ let title = ffor pct $ \x -> mconcat
131+ [ " CPU Usage: "
132+ , T.pack (printf "%3d" $ (ceiling $ x * 100 :: Int))
133+ , "% "
134+ ]
135+ boxTitle (pure doubleBoxStyle) (current title) $ col $ do
117136 grout flex blank
118137 dh <- displayHeight
119− let h :: Dynamic t Int = ceiling <$> ((*) <$> (fromIntegral <$> dh) <*> pct)
120− tile (fixed h) $ fill '█'
138+ let heights = calcRowHeights <$> dh <*> pct
139+ tile (fixed 1) $ fill $ current $ eighthBlocks . snd <$> heights
140+ tile (fixed $ fst <$> heights) $ fill $ pure '█'
141+ where
142+ -- Calculate number of full rows, height of partial row
143+ calcRowHeights :: Int -> Ratio Word64 -> (Int, Int)
144+ calcRowHeights h r =
145+ let (full, leftovers) = divMod (numerator r * fromIntegral h) (denominator r)
146+ partial = ceiling $ 8 * (leftovers % denominator r)
147+ in (fromIntegral full, partial)
148+
149+eighthBlocks :: (Eq a, Num a, Ord a) => a -> Char
150+eighthBlocks n =
151+ if
152+ | n <= 0 -> ' '
153+ | n == 1 -> '▁'
154+ | n == 2 -> '▂'
155+ | n == 3 -> '▃'
156+ | n == 4 -> '▄'
157+ | n == 5 -> '▅'
158+ | n == 6 -> '▆'
159+ | n == 7 -> '▇'
160+ | otherwise -> '█'
121161
122162-- | Determine the current percentage usage according to this algorithm:
123163--
124164-- PrevIdle = previdle + previowait
125165-- Idle = idle + iowait
126−--
166+--
127167-- PrevNonIdle = prevuser + prevnice + prevsystem + previrq + prevsoftirq + prevsteal
128168-- NonIdle = user + nice + system + irq + softirq + steal
129−--
169+--
130170-- PrevTotal = PrevIdle + PrevNonIdle
131171-- Total = Idle + NonIdle
132−--
172+--
133173-- totald = Total - PrevTotal
134174-- idled = Idle - PrevIdle
135−--
175+--
136176-- CPU_Percentage = (totald - idled)/totald
137177--
138178-- Source: https://stackoverflow.com/questions/23367857/accurate-calculation-of-cpu-usage-given-in-percentage-in-linux
139179cpuPercentStep
140180 :: (Word64, Word64) -- Current active, Current idle
141− -> ((Word64, Word64), Double) -- (Previous idle, Previous total), previous percent
142− -> ((Word64, Word64), Double) -- (New idle, new total), percent
181+ -> ((Word64, Word64), Ratio Word64) -- (Previous idle, Previous total), previous percent
182+ -> ((Word64, Word64), Ratio Word64) -- (New idle, new total), percent
143183cpuPercentStep (nonidle, idle) ((previdle, prevtotal), _) =
144184 let total = idle + nonidle
145185 idled = idle - previdle
146186 totald = total - prevtotal
147187 in ( (idle, total)
148− , (fromIntegral $ totald - idled) / fromIntegral totald
188+ , (totald - idled) % totald
149189 )