module LambdaSound.Plot (plot, plotPart) where

import Data.Massiv.Array qualified as M
import Data.Text (Text, append, pack)
import Data.Text.IO qualified as T
import LambdaSound.Sound
import LambdaSound.Sampling (sampleSound)
import Data.Coerce (coerce)
import System.Console.ANSI

-- | Plots a sound in the terminal
plot :: Sound T Pulse -> IO ()
plot :: Sound 'T Pulse -> IO ()
plot Sound 'T Pulse
sound = (Duration, Duration) -> Sound 'T Pulse -> IO ()
plotPart (Duration
0, Sound 'T Pulse -> Duration
forall a. Sound 'T a -> Duration
getDuration Sound 'T Pulse
sound) Sound 'T Pulse
sound

-- | Plots part of a sound in the terminal
plotPart :: (Duration, Duration) -> Sound T Pulse -> IO ()
plotPart :: (Duration, Duration) -> Sound 'T Pulse -> IO ()
plotPart (Duration
lD, Duration
rD) Sound 'T Pulse
sound = do 
  Ix1
cols <- Ix1 -> ((Ix1, Ix1) -> Ix1) -> Maybe (Ix1, Ix1) -> Ix1
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ix1
80 (Ix1, Ix1) -> Ix1
forall a b. (a, b) -> b
snd (Maybe (Ix1, Ix1) -> Ix1) -> IO (Maybe (Ix1, Ix1)) -> IO Ix1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Ix1, Ix1))
getTerminalSize
  let hz :: Hz
hz = Duration -> Hz
forall a b. Coercible a b => a -> b
coerce (Duration -> Hz) -> Duration -> Hz
forall a b. (a -> b) -> a -> b
$ Ix1 -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ix1
cols Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* (Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ (Duration
rD Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
lD))
      soundPart :: Sound 'T Pulse
soundPart = Duration -> Sound 'T Pulse -> Sound 'T Pulse
forall a. Duration -> Sound 'T a -> Sound 'T a
takeSound (Duration
rD Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
lD) (Sound 'T Pulse -> Sound 'T Pulse)
-> Sound 'T Pulse -> Sound 'T Pulse
forall a b. (a -> b) -> a -> b
$ Duration -> Sound 'T Pulse -> Sound 'T Pulse
forall a. Duration -> Sound 'T a -> Sound 'T a
dropSound Duration
lD Sound 'T Pulse
sound
  Text
txt <- Ix1 -> Vector S Pulse -> Text
tabulateSamples Ix1
10 (Vector S Pulse -> Text) -> IO (Vector S Pulse) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hz -> Sound 'T Pulse -> IO (Vector S Pulse)
sampleSound Hz
hz Sound 'T Pulse
soundPart
  Text -> IO ()
T.putStrLn Text
txt

tabulateSamples :: Int -> M.Vector M.S Pulse -> Text
tabulateSamples :: Ix1 -> Vector S Pulse -> Text
tabulateSamples Ix1
rows Vector S Pulse
samples =
  let maxSample :: Pulse
maxSample = Vector S Pulse -> Pulse
forall r ix e.
(HasCallStack, Shape r ix, Source r e, Ord e) =>
Array r ix e -> e
M.maximum' Vector S Pulse
samples
      minSample :: Pulse
minSample = Vector S Pulse -> Pulse
forall r ix e.
(HasCallStack, Shape r ix, Source r e, Ord e) =>
Array r ix e -> e
M.minimum' Vector S Pulse
samples
      preparedSamples :: Vector S Pulse
preparedSamples = Array D Ix1 Pulse -> Vector S Pulse
forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute (Array D Ix1 Pulse -> Vector S Pulse)
-> Array D Ix1 Pulse -> Vector S Pulse
forall a b. (a -> b) -> a -> b
$ (Pulse -> Pulse) -> Vector S Pulse -> Array D Ix1 Pulse
forall ix r e' e.
(Index ix, Source r e') =>
(e' -> e) -> Array r ix e' -> Array D ix e
M.map (\Pulse
s -> (Pulse
s Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
minSample) Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ (Pulse
maxSample Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
minSample) Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Ix1 -> Pulse
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ix1
rows) Vector S Pulse
samples
   in (Ix1 -> Text) -> [Ix1] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Vector S Pulse -> Ix1 -> Text
drawRow Vector S Pulse
preparedSamples) [Ix1
0 .. Ix1
rows]
  where
    drawRow :: M.Vector M.S Pulse -> Int -> Text
    drawRow :: Vector S Pulse -> Ix1 -> Text
drawRow Vector S Pulse
preparedSamples Ix1
r =
      Text -> Text -> Text
append (String -> Text
pack String
"\n") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
        String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
          Array D Ix1 Char -> String
forall ix r e. (Index ix, Source r e) => Array r ix e -> [e]
M.toList (Array D Ix1 Char -> String) -> Array D Ix1 Char -> String
forall a b. (a -> b) -> a -> b
$
            (Pulse -> Char) -> Vector S Pulse -> Array D Ix1 Char
forall ix r e' e.
(Index ix, Source r e') =>
(e' -> e) -> Array r ix e' -> Array D ix e
M.map
              ( \Pulse
p ->
                  let x :: Pulse
x = Pulse
p Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Ix1 -> Pulse
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ix1
r
                   in if Pulse
x Pulse -> Pulse -> Bool
forall a. Ord a => a -> a -> Bool
>= Pulse
0 Bool -> Bool -> Bool
&& Pulse
x Pulse -> Pulse -> Bool
forall a. Ord a => a -> a -> Bool
< Pulse
1 
                        then
                          if Pulse
x Pulse -> Pulse -> Bool
forall a. Ord a => a -> a -> Bool
< (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ Pulse
3)
                            then Char
topDot
                            else
                              if Pulse
x Pulse -> Pulse -> Bool
forall a. Ord a => a -> a -> Bool
< (Pulse
2 Pulse -> Pulse -> Pulse
forall a. Fractional a => a -> a -> a
/ Pulse
3)
                                then Char
middleDot
                                else Char
bottomDot
                        else Char
' '
              )
              Vector S Pulse
preparedSamples
    topDot :: Char
topDot = Char
'˙'
    middleDot :: Char
middleDot = Char
'·'
    bottomDot :: Char
bottomDot = Char
'.'