content: {-# LANGUAGE BinaryLiterals #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE OverloadedStrings #-}
  module Types
    ( Mode(..)
    , Name(..)
    , Tool(..)
    , AppEvent(..)
    , Action(..)
    , toolName
    , isSelectionMode
  
    , LayerInfo(..)
    , layerName
    , layerVisible
  
    , noStyle
    , setStyle
    , clearStyle
    , toggleStyle
    , hasStyle
  
    , AppState(..)
    , layers
    , currentLayer
    , layerAt
    , layerInfoFor
    , layerOrder
    , layerInfo
    , layerNameEditor
    , selectedLayerIndex
    , drawingOverlay
    , modes
    , currentMode
    , tool
    , drawFgPaletteIndex
    , drawBgPaletteIndex
    , layerListVisible
    , appCanvasSize
    , palette
    , drawCharacter
    , fgPaletteSelectorExtent
    , bgPaletteSelectorExtent
    , toolSelectorExtent
    , boxStyleSelectorExtent
    , styleSelectorExtent
    , canvasExtent
    , dragging
    , canvasSizeWidthEdit
    , canvasSizeHeightEdit
    , canvasSizeFocus
    , canvasOffset
    , canvasPath
    , canvasDirty
    , askToSaveFilenameEdit
    , appEventChannel
    , textEntered
    , textEntryStart
    , boxStyleIndex
    , eraserSize
    , repaintSize
    , restyleSize
    , undoStack
    , redoStack
    , drawStyle
    , saveError
    )
  where
  
  import Data.Bits ((.&.), (.|.), complement)
  import Data.Word (Word8)
  import Data.Maybe (fromJust)
  import Brick (Extent, Location)
  import Brick.BChan (BChan)
  import Brick.Focus
  import Brick.Widgets.Edit (Editor)
  import qualified Data.Text as T
  import qualified Data.Map as M
  import Lens.Micro.Platform
  import qualified Data.Vector as Vec
  import qualified Graphics.Vty as V
  
  import Tart.Canvas
  
  data AppEvent =
      DragFinished Name Location Location
      deriving (Eq)
  
  data Action =
      SetPixels Int [((Int, Int), (Char, V.Attr))]
      | ClearCanvasDirty
      | InsertLayer Canvas Int Int T.Text
      | RemoveLayer Int
      | SelectLayerIndex Int
      | ChangeLayerName Int T.Text
      | MoveLayerBy Int Bool
      | ToggleLayer Int
  
  data Mode = Main
            | CharacterSelect
            | FgPaletteEntrySelect
            | BgPaletteEntrySelect
            | ToolSelect
            | StyleSelect
            | BoxStyleSelect
            | CanvasSizePrompt
            | AskToSave
            | AskForSaveFilename Bool
            | TextEntry
            | RenameLayer
            deriving (Eq, Show)
  
  selectionModes :: [Mode]
  selectionModes =
      [ CharacterSelect
      , FgPaletteEntrySelect
      , BgPaletteEntrySelect
      , ToolSelect
      , StyleSelect
      , BoxStyleSelect
      ]
  
  isSelectionMode :: Mode -> Bool
  isSelectionMode = (`elem` selectionModes)
  
  data Name = Canvas
            | TopHud
            | BottomHud
            | ToolSelector
            | ToolSelectorEntry Tool
            | CharSelector
            | FgSelector
            | BgSelector
            | StyleSelector
            | StyleSelectorEntry V.Style
            | FgPaletteEntry Int
            | BgPaletteEntry Int
            | BoxStyleSelectorEntry Int
            | ResizeCanvas
            | CanvasSizeWidthEdit
            | CanvasSizeHeightEdit
            | AskToSaveFilenameEdit
            | TextEntryCursor
            | BoxStyleSelector
            | IncreaseToolSize
            | DecreaseToolSize
            | SelectLayer Int
            | LayerName
            | LayerNameEditor
            | AddLayer
            | DeleteLayer
            | MoveLayerUp
            | MoveLayerDown
            | ToggleLayerVisible
            deriving (Eq, Show, Ord)
  
  data Tool = Freehand
            | Box
            | Line
            | Repaint
            | Restyle
            | Eyedropper
            | FloodFill
            | Eraser
            | TextString
            deriving (Eq, Show, Ord)
  
  toolName :: Tool -> T.Text
  toolName Freehand   = "Freehand"
  toolName Box        = "Box"
  toolName Line       = "Line"
  toolName Repaint    = "Repaint"
  toolName Restyle    = "Restyle"
  toolName Eraser     = "Eraser"
  toolName Eyedropper = "Eyedropper"
  toolName FloodFill  = "Flood fill"
  toolName TextString = "Text string"
  
  newtype DrawStyle =
      DrawStyle Word8
      deriving (Eq, Show)
  
  setStyle :: V.Style -> V.Style -> V.Style
  setStyle a b = a .|. b
  
  toggleStyle :: V.Style -> V.Style -> V.Style
  toggleStyle a b =
      if hasStyle a b
      then clearStyle a b
      else setStyle a b
  
  hasStyle :: V.Style -> V.Style -> Bool
  hasStyle a b = a .&. b /= 0
  
  clearStyle :: V.Style -> V.Style -> V.Style
  clearStyle old dest = dest .&. complement old
  
  noStyle :: V.Style
  noStyle = 0
  
  data LayerInfo =
      LayerInfo { _layerName :: T.Text
                , _layerVisible :: Bool
                }
  
  makeLenses ''LayerInfo
  
  data AppState =
      AppState { _layers                  :: M.Map Int Canvas
               , _layerOrder              :: [Int]
               , _layerInfo               :: M.Map Int LayerInfo
               , _layerListVisible        :: Bool
               , _drawingOverlay          :: Canvas
               , _selectedLayerIndex      :: Int
               , _appCanvasSize           :: (Int, Int)
               , _modes                   :: [Mode]
               , _drawFgPaletteIndex      :: Int
               , _drawBgPaletteIndex      :: Int
               , _drawStyle               :: V.Style
               , _drawCharacter           :: Char
               , _tool                    :: Tool
               , _palette                 :: Vec.Vector (Maybe V.Color)
               , _fgPaletteSelectorExtent :: Maybe (Extent Name)
               , _bgPaletteSelectorExtent :: Maybe (Extent Name)
               , _toolSelectorExtent      :: Maybe (Extent Name)
               , _boxStyleSelectorExtent  :: Maybe (Extent Name)
               , _styleSelectorExtent     :: Maybe (Extent Name)
               , _canvasExtent            :: Maybe (Extent Name)
               , _dragging                :: Maybe (Name, Location, Location)
               , _layerNameEditor         :: Editor T.Text Name
               , _canvasSizeWidthEdit     :: Editor T.Text Name
               , _canvasSizeHeightEdit    :: Editor T.Text Name
               , _canvasSizeFocus         :: FocusRing Name
               , _canvasOffset            :: Location
               , _canvasPath              :: Maybe FilePath
               , _canvasDirty             :: Bool
               , _askToSaveFilenameEdit   :: Editor T.Text Name
               , _saveError               :: Maybe T.Text
               , _appEventChannel         :: BChan AppEvent
               , _textEntered             :: [(Char, V.Attr)]
               , _textEntryStart          :: (Int, Int)
               , _boxStyleIndex           :: Int
               , _eraserSize              :: Int
               , _repaintSize             :: Int
               , _restyleSize             :: Int
               , _undoStack               :: [[Action]]
               , _redoStack               :: [[Action]]
               }
  
  makeLenses ''AppState
  
  currentLayer :: Lens' AppState Canvas
  currentLayer =
      lens (\s   -> fromJust $ s^.layers.at (s^.selectedLayerIndex))
           (\s c -> s & layers.at (s^.selectedLayerIndex) .~ Just c)
  
  layerAt :: Int -> Lens' AppState Canvas
  layerAt i =
      lens (\s   -> fromJust $ s^.layers.at i)
           (\s c -> s & layers.at i .~ Just c)
  
  layerInfoFor :: Int -> Lens' AppState LayerInfo
  layerInfoFor i =
      lens (\s   -> fromJust $ s^.layerInfo.at i)
           (\s v -> s & layerInfo.at i .~ Just v)
  
  currentMode :: AppState -> Mode
  currentMode s = case _modes s of
      (m:_) -> m
      _ -> error "BUG: currentMode: no modes!"
  