Cycle status monitor

[jarmitage]

I made this prototype via GPT (stopPrinting doesn't work!):

import Data.Fixed (mod')
import Text.Printf (printf)
import Control.Concurrent
import Control.Monad (forever, when)

streamGetnowMods :: Double -> Stream -> IO [Double]
streamGetnowMods mod s = do
  let mods = take 6 $ iterate (*2) mod
  result <- streamGetnow s
  return $! map (mod' result) mods

streamGetnowModsString :: Double -> Stream -> IO String
streamGetnowModsString mod s = do
  let mods = take 6 $ iterate (*2) mod
  results <- streamGetnowMods mod s
  cyclePos <- streamGetnow s
  let formattedResults = printf "%.0f: " cyclePos : zipWith (\x y -> printf "%d/%.0f" (floor x + 1) y) results mods
  return $ unwords formattedResults

printEverySecond :: Double -> Stream -> IO ()
printEverySecond mod s = forever $ do
    result <- streamGetnowModsString mod s
    cps <- streamGetcps s
    let delay = floor (1 / cps * 1000000) -- convert cps to microseconds
    putStrLn result
    threadDelay delay

startPrinting :: Double -> Stream -> IO (MVar ())
startPrinting mod s = do
    stopVar <- newEmptyMVar
    _ <- forkIO $ do
        let loop = do
                stopped <- tryTakeMVar stopVar
                Control.Monad.when (stopped == Nothing) $ do
                    printEverySecond mod s
                    loop
        loop
    return stopVar

stopPrinting :: MVar () -> IO ()
stopPrinting stopVar = do
    putMVar stopVar ()
    return ()

It prints out a status line like this:

706:  3/4 3/8 3/16 3/32 3/64 67/128
707:  4/4 4/8 4/16 4/32 4/64 68/128
708:  1/4 5/8 5/16 5/32 5/64 69/128
709:  2/4 6/8 6/16 6/32 6/64 70/128
710:  3/4 7/8 7/16 7/32 7/64 71/128
711:  4/4 8/8 8/16 8/32 8/64 72/128

I made this to help with composition and performance, makes it easier to keep track of things. Note that you don't have to use 4 as the base.

Would be cool to integrate this into an editor as feedback. I don't really know how to do that so just posting here for now!