Event.hs

module Keyboard.Event where

import Brick (BrickEvent (..), EventM, gets, modify)
import Control.Monad.IO.Class (MonadIO (..))
import Data.List (elemIndex)
import qualified Data.Map as Map
import qualified Data.Text as T
import Graphics.UI.TinyFileDialogs (inputBox)
import qualified Graphics.Vty as V
import UI.Core (AppState (..), Content (..), Keyboard (..), Name (..), Window (..))
import Zwirn.Language.Compiler (Environment, compilerInterpreterWithBlock, runCI)

handleKeyboardEvent :: Keyboard -> BrickEvent Name e -> EventM Name AppState Keyboard
handleKeyboardEvent k (VtyEvent (V.EvKey (V.KChar c) _)) = keyboardAction k c >> return k
handleKeyboardEvent k _ = return k

jankoMidi :: Char -> Maybe Int
jankoMidi c
  | c `elem` row1 = lookupIndex c row1 58
  | c `elem` rowQ = lookupIndex c rowQ 59
  | c `elem` rowA = lookupIndex c rowA 60
  | c `elem` rowZ = lookupIndex c rowZ 61
  | otherwise = Nothing
  where
    row1 = "1234567890-="
    rowQ = "qwertyuiop[]"
    rowA = "asdfghjkl;'"
    rowZ = "zxcvbnm,./"
    lookupIndex key row base = (\x -> base + x * 2) <$> elemIndex key row

keyboardAction :: Keyboard -> Char -> EventM Name AppState ()
keyboardAction (KeyB Nothing) _ = return ()
keyboardAction (KeyB (Just sd)) c = do
  env <- gets asEnvironment
  case jankoMidi c of
    Just n -> liftIO $ evalSoundOnce sd n env
    Nothing -> return ()

evalSoundOnce :: T.Text -> Int -> Environment -> IO ()
evalSoundOnce func num env = do
  _ <- runCI env (compilerInterpreterWithBlock 0 (func <> " " <> T.show num))
  return ()

selectSound :: EventM Name AppState ()
selectSound = do
  msound <- liftIO (inputBox "" "Select a function to trigger events" (Just "(\\x -> once $ sinus # note x)"))
  let alt (Just (Window x y (KeyboardContent _) z l)) = Just $ Window x y (KeyboardContent (KeyB msound)) z l
      alt _ = Nothing
  modify $ \as -> as {asWindows = Map.alter alt Keyboard $ asWindows as}