packages feed

tart-0.4: programs/Events/Main.hs

module Events.Main
  ( handleMainEvent
  , handleAttrEvent
  )
where

import Brick
import Control.Monad (when, void)
import Data.Char (isDigit)
import Data.Maybe (isJust)
import qualified Graphics.Vty as V
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import Lens.Micro.Platform
import Data.Text.Encoding (decodeUtf8)

import Types
import Draw
import State
import Events.Common

handleMainEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent e = do
    result <- handleCommonEvent e
    case result of
        True -> return ()
        False -> do
            result2 <- handleAttrEvent e
            case result2 of
                True -> return ()
                False -> handleEvent e

handleAttrEvent :: BrickEvent Name AppEvent -> EventM Name AppState Bool
handleAttrEvent (MouseDown FgSelector _ _ _) = do
    beginFgPaletteSelect
    return True
handleAttrEvent (MouseDown BgSelector _ _ _) = do
    beginBgPaletteSelect
    return True
handleAttrEvent (MouseDown StyleSelector _ _ _) = do
    beginStyleSelect
    return True
handleAttrEvent _ =
    return False

handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent (VtyEvent (V.EvPaste bytes)) =
    pasteTextAtPoint (0, 0) (decodeUtf8 bytes)
handleEvent (AppEvent (DragFinished n _ _)) =
    handleDragFinished n
handleEvent (VtyEvent (V.EvMouseDown _ _ V.BScrollUp _)) =
    increaseToolSize
handleEvent (VtyEvent (V.EvMouseDown _ _ V.BScrollDown _)) =
    decreaseToolSize
handleEvent (MouseDown _ V.BScrollUp _ _) =
    increaseToolSize
handleEvent (MouseDown _ V.BScrollDown _ _) =
    decreaseToolSize
handleEvent (MouseDown Canvas _ _ (Location l)) =
    drawWithCurrentTool l
handleEvent (MouseDown n _ _ _) =
    case n of
        LayerName           -> beginLayerRename
        DeleteLayer         -> deleteSelectedLayer
        MoveLayerUp         -> moveCurrentLayerUp
        MoveLayerDown       -> moveCurrentLayerDown
        ResizeCanvas        -> beginCanvasSizePrompt
        ToggleLayerVisible  -> toggleCurrentLayer
        ToolSelector        -> beginToolSelect
        IncreaseToolSize    -> increaseToolSize
        DecreaseToolSize    -> decreaseToolSize
        BoxStyleSelector    -> beginBoxStyleSelect
        SelectLayer idx     -> void $ selectLayer idx
        AddLayer            -> addLayer
        CharSelector        -> whenTool charTools beginCharacterSelect
        _                   -> return ()
handleEvent (VtyEvent (V.EvKey (V.KChar 'q') [])) =
    quit True
handleEvent (VtyEvent e) =
    case e of
        _ | isStyleKey e                       -> toggleStyleFromKey e
        (EvKey (KChar 'l') [MCtrl])            -> toggleLayerList
        (EvKey (KChar 'w') [])                 -> canvasMoveDown
        (EvKey (KChar 's') [])                 -> canvasMoveUp
        (EvKey (KChar 'a') [])                 -> canvasMoveLeft
        (EvKey (KChar 'd') [])                 -> canvasMoveRight
        (EvKey (KChar 'y') [])                 -> beginStyleSelect
        (EvKey (KChar 'v') [])                 -> beginCanvasSizePrompt
        (EvKey (KChar 's') [MCtrl])            -> askForSaveFilename False
        (EvKey (KChar 'r') [MCtrl])            -> beginLayerRename
        (EvKey (KChar 'x') [MCtrl])            -> deleteSelectedLayer
        (EvKey (KChar 'n') [MCtrl])            -> selectNextLayer
        (EvKey (KChar 'p') [MCtrl])            -> selectPrevLayer
        (EvKey (KChar 'u') [MCtrl])            -> moveCurrentLayerUp
        (EvKey (KChar 'd') [MCtrl])            -> moveCurrentLayerDown
        (EvKey (KChar 'v') [MCtrl])            -> toggleCurrentLayer
        (EvKey (KChar 'C') [])                 -> recenterCanvas
        (EvKey (KChar '>') [])                 -> increaseToolSize
        (EvKey (KChar '<') [])                 -> decreaseToolSize
        (EvKey KEsc [])                        -> do
                                                    drg <- use dragging
                                                    when (isJust drg) cancelDragging
        (EvKey (KChar c) []) | isDigit c       -> setToolByChar c
        (EvKey (KChar 'c') [])                 -> whenTool charTools beginCharacterSelect
        (EvKey (KChar '+') [])                 -> increaseCanvasSize
        (EvKey (KChar '-') [])                 -> decreaseCanvasSize
        (EvKey (KChar 'a') [MCtrl])            -> addLayer
        (EvKey (KChar 'u') [])                 -> undo
        (EvKey (KChar 'r') [])                 -> redo
        _                                      -> return ()
handleEvent _ = return ()