Window.hs

module UI.Window where

import Animation (changeAnimation, changeFramerate, toggleAnimation)
import Brick (EventM, Extent (..), Location (..), Viewport (..), lookupExtent, lookupViewport)
import Config (getConfigPath, getKeymapPath, setBootPath, setSamplePath)
import Control.Monad (forM_)
import Control.Monad.RWS
import qualified Data.ByteString.Lazy.UTF8 as BL
import Data.List ((!?))
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Text.Zipper (textZipper)
import Docs.Event (copyCodeEvent, evalCodeEvent, gotoLink, gotoStart)
import Editor.Core (esFilePath, esZipper, newEditor)
import Editor.Cursor (moveCursorFileStart, moveCursorPos)
import Editor.Selection (extendSelectionTo)
import Editor.Util (currentCursor, lineNumberWidth)
import Keyboard.Event (selectSound)
import Lens.Micro ((&), (.~), (?~))
import SampleBrowser.Event (sampleBrowserClickAction)
import Session (quitEvent)
import System.File.OsPath as F
import System.OsPath (decodeFS)
import UI.Core

rightClickWindow :: Name -> (Int, Int) -> EventM Name AppState ()
rightClickWindow name (cx, cy) = do
  (mx, my) <- getAbsolutePos (name, parentWindow name) (cx, cy)
  os <- getWindowOptions name
  let opt = OptionWindow (mx, my) name os
  modify $ \as -> as {asOptionWindow = Just opt}

clickOptionWindow :: (Int, Int) -> EventM Name AppState ()
clickOptionWindow (_, my) = do
  mos <- gets asOptionWindow
  case mos of
    Nothing -> return ()
    Just (OptionWindow p name os) -> forM_ (os !? my) (executeOption name p) >> closeOptions

clickWindow :: Name -> (Int, Int) -> EventM Name AppState ()
clickWindow name (cx, cy) = do
  (mx, my) <- getParentCoords name (cx, cy)
  wm <- gets asWindows
  case Map.lookup (parentWindow name) wm of
    Nothing -> return ()
    Just win@(Window _ (sx, sy) _ _ _) -> do
      newWindow <- contentClickAction (name, win) (mx, my)
      modify $ \as -> as {asDragging = Just ((mx, my), name, action), asWindows = Map.insert (parentWindow name) newWindow wm}
      where
        action
          | mx /= cx || my /= cy = Content
          | mx == sx - 1 && my == sy - 1 = ResizeBoth
          | mx == sx - 1 = ResizeRight
          | my == sy - 1 = ResizeBottom
          | mx == 0 || my == 0 = Move
          | otherwise = Content

dragWindow :: Name -> (Int, Int) -> (Int, Int) -> DragAction -> EventM Name AppState ()
dragWindow name (ax, ay) _ Content = do
  wm <- gets asWindows
  case Map.lookup (parentWindow name) wm of
    Just win -> do
      win' <- contentDragAction (name, win) (ax, ay)
      modify $ \as -> as {asWindows = Map.insert (parentWindow name) win' wm}
    Nothing -> return ()
dragWindow name (ax, ay) (lx, ly) Move = do
  wm <- gets asWindows
  modify $ \as -> as {asWindows = Map.adjust (\(Window _ s c h l) -> Window (ax - lx, ay - ly) s c h l) name wm}
dragWindow name (_, ay) _ ResizeBottom = do
  wm <- gets asWindows
  modify $ \as -> as {asWindows = Map.adjust (\(Window (px, py) (sx, _) c h l) -> Window (px, py) (sx, ay - py) c h l) name wm}
dragWindow name (ax, _) _ ResizeRight = do
  wm <- gets asWindows
  modify $ \as -> as {asWindows = Map.adjust (\(Window (px, py) (_, sy) c h l) -> Window (px, py) (ax - px, sy) c h l) name wm}
dragWindow name (ax, ay) _ ResizeBoth = do
  wm <- gets asWindows
  modify $ \as -> as {asWindows = Map.adjust (\(Window (px, py) _ c h l) -> Window (px, py) (ax - px, ay - py) c h l) name wm}

getAbsolutePos :: (Name, Name) -> (Int, Int) -> EventM Name AppState (Int, Int)
getAbsolutePos (name, dragged) c
  | name == dragged = do
      wm <- gets asWindows
      (mx, my) <- getParentCoords name c
      case Map.lookup (parentWindow name) wm of
        Just (Window (px, py) _ _ _ _) -> return (px + mx, py + my)
        Nothing -> return (mx, my)
  | otherwise = do
      wm <- gets asWindows
      (mx, my) <- getParentCoords name c
      doff <- viewportOffset dragged
      off <- viewportOffset name
      case Map.lookup (parentWindow name) wm of
        Just (Window (px, py) _ _ _ _) -> return (px + mx, py + my + doff - off)
        Nothing -> return (mx, my + doff)

viewportOffset :: Name -> EventM Name AppState Int
viewportOffset name = do
  mvp <- lookupViewport name
  return $ maybe 0 (\(VP _ x _ _) -> x) mvp

parentWindow :: Name -> Name
parentWindow (EditorViewport i) = Editor i
parentWindow DocViewport = Documentation
parentWindow (DocLink _) = Documentation
parentWindow (DocCode _) = Documentation
parentWindow SampleBrowserViewport = SampleBrowser
parentWindow EnvBrowserViewport = EnvBrowser
parentWindow x = x

getParentCoords :: Name -> (Int, Int) -> EventM Name AppState (Int, Int)
getParentCoords name (mx, my) = do
  (cx, cy) <- maybe (0, 0) (\(Extent _ (Location u) _) -> u) <$> lookupExtent name
  (px, py) <- maybe (0, 0) (\(Extent _ (Location u) _) -> u) <$> lookupExtent (parentWindow name)
  return (mx + cx - px, my + cy - py)

contentClickAction :: (Name, Window) -> (Int, Int) -> EventM Name AppState Window
contentClickAction (Editor i, Window p s (EditorContent es) h l) (mx, my) = do
  mvp <- lookupViewport (EditorViewport i)
  let ro = maybe 0 (\(VP _ x _ _) -> x) mvp
  return $ Window p s (EditorContent $ moveCursorPos (my + ro - 1, mx - lineNumberWidth es) es) h l
contentClickAction (EditorViewport _, Window p s (EditorContent es) h l) (mx, my) = return $ Window p s (EditorContent $ moveCursorPos (my - 1, mx - lineNumberWidth es) es) h l
contentClickAction (DocLink l, Window p s (DocumentationContent d _ m) h k) _ = gotoLink d l m >>= \(d', f) -> return (Window p s (DocumentationContent d' f m) h k)
contentClickAction (DocCode i, Window p s (DocumentationContent d _ m) h k) _ = evalCodeEvent d i >>= \(_, f) -> return (Window p s (DocumentationContent d f m) h k)
contentClickAction (SampleBrowserViewport, Window p s (SampleBrowserContent sb) h k) pos = sampleBrowserClickAction sb pos >>= \sb' -> return (Window p s (SampleBrowserContent sb') h k)
contentClickAction (_, x) _ = return x

contentDragAction :: (Name, Window) -> (Int, Int) -> EventM Name AppState Window
contentDragAction (EditorViewport _, Window (px, py) s (EditorContent es) h l) (ax, ay) = return $ Window (px, py) s (EditorContent $ extendSelectionTo (currentCursor $ moveCursorPos (ay - py - 1, ax - px - lineNumberWidth es) es) es) h l
contentDragAction (Slider i, Window (px, py) (sx, sy) (SliderContent _) h l) (ax, _) = do
  let new = max 0 $ min 1 $ fromIntegral (ax - px) / fromIntegral sx
  env <- gets asEnvironment
  env' <- liftIO $ updateSlider i new env
  modify (\as -> as {asEnvironment = env'})
  return $ Window (px, py) (sx, sy) (SliderContent new) h l
contentDragAction (_, x) _ = return x

executeOption :: Name -> (Int, Int) -> Option -> EventM Name AppState ()
executeOption name _ Hide = modify (\as -> as {asWindows = Map.adjust (\win -> win {windowHidden = True}) (parentWindow name) $ asWindows as})
executeOption _ _ (Show name) = modify (\as -> as {asWindows = Map.adjust (\win -> win {windowHidden = False}) (parentWindow name) $ asWindows as})
executeOption name _ Close = modify (\as -> as {asWindows = Map.delete (parentWindow name) $ asWindows as})
executeOption _ p AddEditor = addEditorWithFile p Nothing
executeOption _ _ AddSlider = addSlider
executeOption _ _ ToggleAnimation = toggleAnimation
executeOption _ _ ChangeAnimation = changeAnimation
executeOption _ _ ChangeFramerate = changeFramerate
executeOption _ _ SetBootPath = setBootPath
executeOption _ _ SetSamplePath = setSamplePath
executeOption _ _ QuitMill = quitEvent
executeOption name _ ToggleLabel = toggleLabel (parentWindow name)
executeOption (DocCode i) _ Copy = do
  mw <- Map.lookup Documentation <$> gets asWindows
  case mw of
    Just (Window _ _ (DocumentationContent d _ _) _ _) -> copyCodeEvent d i
    _ -> return ()
executeOption _ _ GotoStart = gotoStart
executeOption _ p OpenConfig = openConfig p
executeOption _ p OpenKeymap = openKeymap p
executeOption _ _ SelectAction = selectSound
executeOption _ _ _ = return ()

closeOptions :: EventM Name AppState ()
closeOptions = modify (\as -> as {asOptionWindow = Nothing})

getWindowOptions :: Name -> EventM Name AppState [Option]
getWindowOptions name = case parentWindow name of
  Background -> do
    hs <- gets $ Map.keys . Map.filter windowHidden . asWindows
    return $ AddEditor : AddSlider : OpenConfig : OpenKeymap : map Show hs ++ [QuitMill]
  (Editor _) -> return [Hide, ToggleLabel, Close]
  (Slider _) -> return [Hide, ToggleLabel, Close]
  Animator -> return [ToggleAnimation, ChangeAnimation, ChangeFramerate, Hide, ToggleLabel]
  Status -> return [SetBootPath, Hide, ToggleLabel]
  SampleBrowser -> return [SetSamplePath, Hide, ToggleLabel]
  Keyboard -> return [SelectAction, Hide, ToggleLabel]
  Documentation -> case name of
    DocCode _ -> return [Copy]
    _ -> return [GotoStart, Hide, ToggleLabel]
  _ -> return [Hide, ToggleLabel]

addSlider :: EventM Name AppState ()
addSlider = do
  ss <- gets $ (+ 1) . findMaxSlider . map fst . Map.toList . asWindows
  slider <- newSlider ss
  modify (\as -> as {asWindows = Map.insert (Slider ss) slider $ asWindows as, asActiveWindow = Slider ss})
  where
    findMaxSlider = foldl (\x y -> max x (numbered y)) 0
    numbered (Slider i) = i
    numbered _ = 0

toggleLabel :: Name -> EventM Name AppState ()
toggleLabel name = modify $ \as -> as {asWindows = Map.alter alt name $ asWindows as}
  where
    alt (Just win) = Just win {windowLabel = not $ windowLabel win}
    alt _ = Nothing

addEditorWithFile :: (Int, Int) -> Maybe (FilePath, T.Text) -> EventM Name AppState ()
addEditorWithFile (mx, my) mfile = do
  es <- gets $ (+ 1) . findMaxEditor . map fst . Map.toList . asWindows
  modify (\as -> as {asWindows = Map.insert (Editor es) (Window (mx, my) (40, 20) (EditorContent editor) False False) $ asWindows as, asActiveWindow = Editor es})
  where
    editor = case mfile of
      Just (path, cont) ->
        newEditor
          & esZipper .~ textZipper (T.lines cont) Nothing
          & esFilePath ?~ path
          & moveCursorFileStart
      Nothing -> newEditor
    findMaxEditor = foldl (\x y -> max x (numbered y)) 0
    numbered (Editor i) = i
    numbered _ = 0

openConfig :: (Int, Int) -> EventM Name AppState ()
openConfig (mx, my) = do
  ospath <- liftIO getConfigPath
  c <- liftIO $ F.readFile ospath
  path <- liftIO $ decodeFS ospath
  addEditorWithFile (mx, my) (Just (path, T.pack $ BL.toString c))

openKeymap :: (Int, Int) -> EventM Name AppState ()
openKeymap (mx, my) = do
  ospath <- liftIO getKeymapPath
  c <- liftIO $ F.readFile ospath
  path <- liftIO $ decodeFS ospath
  addEditorWithFile (mx, my) (Just (path, T.pack $ BL.toString c))