content: {-# LANGUAGE OverloadedStrings #-}
  module UI.Main
    ( drawMainUI
    , toolSelectorEntryWidth
    , boxStyleSelectorEntryWidth
    , styleSelectorEntryWidth
    )
  where
  
  import Brick
  import Brick.Widgets.Edit
  import Brick.Widgets.Border
  import Brick.Widgets.Border.Style
  import Brick.Widgets.Center
  import Data.Monoid ((<>))
  import qualified Data.Text as T
  import Data.Maybe (isJust, catMaybes, fromMaybe)
  import qualified Graphics.Vty as V
  import Lens.Micro.Platform
  
  import Types
  import UI.Common
  import Theme
  import State
  import Tart.Canvas
  
  drawMainUI :: AppState -> [Widget Name]
  drawMainUI s =
      catMaybes [ Just $ topHud s
                , if s^.layerListVisible then Just $ layerHud s else Nothing
                , Just $ canvas s
                ]
  
  topHud :: AppState -> Widget Name
  topHud s =
      let fgPal = drawPaletteSelector s True
          bgPal = drawPaletteSelector s False
          stySel = drawStyleSelector s
          toolbarEntries = [ drawToolSelector s
                           , toolHud s
                           , vLimit 1 $ fill ' '
                           , fgPal
                           , bgPal
                           , stySel
                           , drawCanvasSize s
                           ]
          filename = case s^.canvasPath of
              Nothing -> "<unsaved>"
              Just p -> T.pack p
          modified = if not $ s^.canvasDirty then "" else "*"
      in clickable TopHud $
         vBox [ (padLeft (Pad 1) $ hBox $ padRight (Pad 1) <$> toolbarEntries)
              , hBox [hBorder, txt ("[" <> filename <> modified <> "]"), borderElem bsHorizontal]
              ]
  
  layerHud :: AppState -> Widget Name
  layerHud s = translateBy (Location (0, 4)) $
               padBottom (Pad 4) $
               (hLimit 20 $ layerList <=> fill ' ' <=> layerOptions) <+> vBorder
      where
          layerList = vBox $ (hCenter $ withDefAttr headerAttr $ txt "Layers") :
                             (mkEntry <$> entries) <>
                             [addLayerEntry]
          entries = [ ( i
                      , s^.layerInfoFor(i)
                      )
                    | i <- s^.layerOrder
                    ]
          addLayerEntry =
              clickable AddLayer $ hCenter $
                withDefAttr clickableAttr $ txt "Add Layer (C-a)"
          mkEntry (idx, LayerInfo name vis) =
              if RenameLayer `elem` s^.modes && s^.selectedLayerIndex == idx
                 then
                     renderEditor (txt . T.concat) True (s^.layerNameEditor)
                 else
                     let applyAttr = if idx == s^.selectedLayerIndex
                                     then withDefAttr selectedLayerAttr
                                     else id
                         showHiddenStatus = if vis then id else (<+> txt "H")
                     in clickable (if idx == s^.selectedLayerIndex
                                   then LayerName
                                   else SelectLayer idx) $
                        applyAttr $ vLimit 1 $
                        showHiddenStatus $
                        txt name <+> fill ' '
          layerOptions =
              let i = s^.selectedLayerIndex
                  entry n label =
                      clickable n $ vLimit 1 $ withDefAttr clickableAttr $
                                               txt label <+> fill ' '
              in vBox $ catMaybes
                   [ Just $ hBorderWithLabel (txt "Layer Options")
                   , Just $ entry ToggleLayerVisible
                              (if s^.layerInfoFor(i).layerVisible
                               then "Hide (C-v)"
                               else "Show (C-v)")
                   , if i /= head (s^.layerOrder)
                        then Just $ entry MoveLayerUp "Move up (C-u)"
                        else Nothing
                   , if i /= last (s^.layerOrder)
                        then Just $ entry MoveLayerDown "Move down (C-d)"
                        else Nothing
                   , if length (s^.layerOrder) == 1
                        then Nothing
                        else Just $ entry DeleteLayer "Delete (C-x)"
                   ]
  
  toolHud :: AppState -> Widget Name
  toolHud s =
      let toolHuds = [ (Freehand, freehandHud)
                     , (FloodFill, floodfillHud)
                     , (Box, boxHud)
                     , (Line, lineHud)
                     , (Eraser, eraserHud)
                     , (Repaint, repaintHud)
                     , (Restyle, restyleHud)
                     , (Eyedropper, eyedropperHud)
                     ]
      in case lookup (s^.tool) toolHuds of
          Nothing -> emptyWidget
          Just f -> f s
  
  freehandHud :: AppState -> Widget Name
  freehandHud s = drawChar s
  
  lineHud :: AppState -> Widget Name
  lineHud s = drawChar s
  
  eyedropperHud :: AppState -> Widget Name
  eyedropperHud s = drawChar s
  
  floodfillHud :: AppState -> Widget Name
  floodfillHud s = drawChar s
  
  boxStyleSelectorEntryWidth :: Int
  boxStyleSelectorEntryWidth = 18
  
  styleSelectorEntryWidth :: Int
  styleSelectorEntryWidth = 12
  
  boxHud :: AppState -> Widget Name
  boxHud = drawBoxStyleSelector
  
  eraserHud :: AppState -> Widget Name
  eraserHud = drawToolSize
  
  repaintHud :: AppState -> Widget Name
  repaintHud = drawToolSize
  
  restyleHud :: AppState -> Widget Name
  restyleHud = drawToolSize
  
  drawToolSize :: AppState -> Widget Name
  drawToolSize s =
      let inc = clickable IncreaseToolSize $ withDefAttr keybindingAttr $ txt ">>"
          dec = clickable DecreaseToolSize $ withDefAttr keybindingAttr $ txt "<<"
          sz = fromMaybe (error "BUG: current tool has no size") $ toolSize s
      in borderWithLabel (txt "Size") $
         dec <+> (hLimit 5 $ hCenter $ txt $ T.pack $ show sz) <+> inc
  
  drawBoxStyleSelector :: AppState -> Widget Name
  drawBoxStyleSelector s =
      let styleName = fst $ getBoxBorderStyle s
      in clickable BoxStyleSelector $
         borderWithLabel (txt "Box Style") $
         hLimit boxStyleSelectorEntryWidth $
         hCenter $ txt styleName
  
  drawStyleSelector :: AppState -> Widget Name
  drawStyleSelector s =
      clickable StyleSelector $
      borderWithLabel (txt "St" <+> (withDefAttr keybindingAttr $ txt "y") <+> txt "le") $
      hLimit styleSelectorEntryWidth $
      hCenter $ raw $ V.string (V.defAttr `V.withStyle` (s^.drawStyle)) "demo"
  
  drawCanvasSize :: AppState -> Widget Name
  drawCanvasSize s =
      let (width, height) = s^.appCanvasSize
      in clickable ResizeCanvas $
         borderWithLabel (txt "Can" <+> (withDefAttr keybindingAttr (txt "v")) <+> txt "as") $
         hLimit 8 $ hCenter (txt $ T.pack $ show width <> "x" <> show height)
  
  drawChar :: AppState -> Widget Name
  drawChar s =
      clickable CharSelector $
      borderWithLabel ((withDefAttr keybindingAttr $ txt "C") <+> txt "har") $
      padLeftRight 2 $ txt $ T.singleton $ s^.drawCharacter
  
  toolSelectorEntryWidth :: Int
  toolSelectorEntryWidth = 20
  
  drawToolSelector :: AppState -> Widget Name
  drawToolSelector s =
      let Just idx = lookup (s^.tool) tools
      in clickable ToolSelector $
         borderWithLabel ((withDefAttr keybindingAttr $ txt "T") <+> txt "ool") $
         hLimit toolSelectorEntryWidth $
         hCenter $
         (withDefAttr keybindingAttr (txt $ T.pack $ show idx)) <+>
         (txt $ ":" <> toolName (s^.tool))
  
  drawPaletteSelector :: AppState -> Bool -> Widget Name
  drawPaletteSelector s isFg =
      (clickable selName $ borderWithLabel label curColor)
      where
          label = if isFg
                  then (withDefAttr keybindingAttr $ txt "F") <+> txt "G"
                  else (withDefAttr keybindingAttr $ txt "B") <+> txt "G"
          curIdx = if isFg then s^.drawFgPaletteIndex
                           else s^.drawBgPaletteIndex
          selName = if isFg then FgSelector else BgSelector
          curColor = drawPaletteEntry s curIdx 4
  
  canvas :: AppState -> Widget Name
  canvas s =
      let appLayers = concat
              [ if s^.layerInfoFor(idx).layerVisible
                then if shouldUseOverlay s && idx == s^.selectedLayerIndex
                     then [s^.drawingOverlay, s^.layerAt idx]
                     else [s^.layerAt idx]
                else []
              | idx <- s^.layerOrder
              ]
          sz = s^.appCanvasSize
          widthAdjust = if s^.layerListVisible
                        then 10
                        else 0
      in centerAbout (s^.canvasOffset & _2 %~ pred
                                      & _1 %~ (subtract widthAdjust)) $
         updateAttrMap (applyAttrMappings [(borderAttr, fg V.white)]) $
         setAvailableSize (sz & each %~ (+ 2)) $
         border $
         if null appLayers
            then raw $ V.charFill V.defAttr ' ' (sz^._1) (sz^._2)
            else clickable Canvas $
                 raw $ canvasLayersToImage appLayers
  
  shouldUseOverlay :: AppState -> Bool
  shouldUseOverlay s =
      isJust $ s^.dragging
  