Draw.hs

{- HLINT ignore "Use tuple-section" -}
module UI.Draw where

import Animation (drawAnimationWindow)
import Brick hiding (on)
import Brick.Widgets.Border
import Brick.Widgets.Border.Style (BorderStyle (..), unicodeRounded)
import qualified Data.Map as Map
import Data.Version (showVersion)
import Docs.Draw (drawDoc)
import Editor.Core (OutputType (..), esPopup)
import Editor.Draw
import EnvBrowser.Draw (drawEnvBrowser)
import Keyboard.Draw (drawKeyboard)
import Lens.Micro
import Paths_zwirn (version)
import SampleBrowser.Draw (drawSampleBrowser)
import UI.Attributes (attrError)
import UI.Core

drawUI :: AppState -> [Widget Name]
drawUI as = opt ++ concatMap (drawWindow as active) (activeToFront (asWindows as)) ++ [background]
  where
    active = asActiveWindow as
    opt = maybe [] drawOptionWindow $ asOptionWindow as
    activeToFront wm = case Map.lookup active wm of
      Just win -> (active, win) : Map.toList (Map.delete active wm)
      Nothing -> Map.toList wm

drawWindow :: AppState -> Name -> (Name, Window) -> [Widget Name]
drawWindow _ _ (_, Window _ _ _ True _) = []
drawWindow _ active (name, Window pos size (StatusContent ver bpm cps cyc load voices peak schedule samples) _ l) = withWindow (active == name) l name pos size (drawStatus size (ver, bpm, cps, cyc, load, voices, peak, schedule, samples)) Nothing
drawWindow _ active (name, Window pos size (EditorContent es) _ l) = withWindow (active == name) l name pos size (drawEditor (active == name) (name, size, es)) (Just $ drawPopup $ es ^. esPopup)
drawWindow _ active (name, Window pos size (OutputContent os) _ l) = withWindow (active == name) l name pos size (drawOutput size os) Nothing
drawWindow _ active (name, Window pos size (SliderContent s) _ l) = withWindow (active == name) l name pos size (drawSlider size s) Nothing
drawWindow as active (name, Window pos size (AnimationContent a _) _ l) = withWindow (active == name) l name pos size (drawAnimationWindow as size a) Nothing
drawWindow _ active (name, Window pos size (DocumentationContent d c _) _ l) = withWindow (active == name) l name pos size (drawDoc size d c) Nothing
drawWindow _ active (name, Window pos size (SampleBrowserContent s) _ l) = withWindow (active == name) l name pos size (drawSampleBrowser size s) Nothing
drawWindow _ active (name, Window pos size (EnvBrowserContent s) _ l) = withWindow (active == name) l name pos size (drawEnvBrowser size s) Nothing
drawWindow _ active (name, Window pos size (KeyboardContent s) _ l) = withWindow (active == name) l name pos size (drawKeyboard size s) Nothing

withWindow :: Bool -> Bool -> Name -> (Int, Int) -> (Int, Int) -> Widget Name -> Maybe (Widget Name) -> [Widget Name]
withWindow active labeled name pos size win mpop =
  pop
    ++ [ translateBy
           (Location pos)
           $ clickable name
           $ withBorderStyle borderStyle
           $ hLimit (fst size)
           $ vLimit (snd size)
           $ labeledBorder
             win
       ]
  where
    labeledBorder = if labeled then borderWithLabel (str $ show name) else border
    borderStyle = if active then unicodeDouble else unicodeRounded
    pop = case mpop of
      Just p ->
        [ translateBy
            (Location pos)
            $ clickable name
            $ hLimit (fst size - 1)
            $ vLimit (snd size - 1) p
        ]
      Nothing -> []

drawStatus :: (Int, Int) -> (String, Double, Double, Int, Double, (Int, Int), Int, Int, Double) -> Widget Name
drawStatus (_, sy) (ver, bpm, cps, cyc, load, (voices, mx), peak, schedule, samples) =
  vBox $
    [ hBox [str $ "zwirn " <> showVersion version, fill ' '],
      hBox [str $ "doux " <> ver, fill ' '],
      hBox [str $ "tempo: " <> show ((fromIntegral (floor (bpm * 10 ^ (2 :: Int)) :: Int) :: Double) / 10 ^ (2 :: Int)) <> " bpm", fill ' '],
      hBox [str $ "       " <> show ((fromIntegral (floor (cps * 10 ^ (4 :: Int)) :: Int) :: Double) / 10 ^ (4 :: Int)) <> " cps", fill ' '],
      hBox [str $ "cycle: " <> show cyc, fill ' '],
      hBox [str $ "load: " <> show ((fromIntegral (floor (load * 10 ^ (2 :: Int)) :: Int) :: Double) / 10 ^ (2 :: Int)) <> "%", fill ' '],
      hBox [str $ "voices: " <> show voices <> "/" <> show mx, fill ' '],
      hBox [str $ "peak: " <> show peak, fill ' '],
      hBox [str $ "schedule: " <> show schedule, fill ' '],
      hBox [str $ "samples: " <> show ((fromIntegral (floor (samples * 10 ^ (2 :: Int)) :: Int) :: Double) / 10 ^ (2 :: Int)) <> "MB", fill ' ']
    ]
      ++ rest
  where
    rest = replicate (max 0 (sy - 8)) $ fill ' '

drawOutput :: (Int, Int) -> [(OutputType, String)] -> Widget Name
drawOutput (sx, sy) os = vBox $ map styled split ++ rest
  where
    rest = replicate (max 0 (sy - length split)) $ fill ' '
    splitLine (t, s) = if length s > sx - 2 then let (x, y) = splitAt (sx - 2) s in (t, x) : splitLine (t, y) else [(t, s)]
    split = concatMap splitLine $ concatMap (\(x, y) -> map (\b -> (x, b)) $ lines $ replaceTabs y) os
    styled (OutputError, o) = hBox [withAttr attrError $ str o, fill ' ']
    styled (OutputInfo, o) = hBox [str o, fill ' ']
    replaceTabs = concatMap (\c -> if c == '\t' then "    " else [c])

background :: Widget Name
background = clickable Background $ fill ' '

unicodeDouble :: BorderStyle
unicodeDouble =
  BorderStyle
    { bsCornerTL = '╔',
      bsCornerTR = '╗',
      bsCornerBR = '╝',
      bsCornerBL = '╚',
      bsIntersectFull = '╬',
      bsIntersectL = '╠',
      bsIntersectR = '╣',
      bsIntersectT = '╦',
      bsIntersectB = '╩',
      bsHorizontal = '═',
      bsVertical = '║'
    }

drawSlider :: (Int, Int) -> Double -> Widget Name
drawSlider (w, _) s = str (replicate filled '▓' <> "▒" <> replicate not_filled '░') <=> fill ' '
  where
    width = w - 3
    filled = (floor $ fromIntegral width * s) :: Int
    not_filled = width - filled

drawOptionWindow :: OptionWindow -> [Widget Name]
drawOptionWindow (OptionWindow _ _ []) = []
drawOptionWindow (OptionWindow pos _ os) =
  return
    $ translateBy
      (Location pos)
    $ border
    $ clickable OptionWin
    $ vBox
    $ map (str . show) os