module Events.Main ( handleMainEvent , handleAttrEvent ) where import Brick import Data.Char (isDigit) import Data.Maybe (isJust) import qualified Graphics.Vty as V import Lens.Micro.Platform import Data.Text.Encoding (decodeUtf8) import Types import Draw import State import Events.Common handleMainEvent :: AppState -> BrickEvent Name AppEvent -> EventM Name (Next AppState) handleMainEvent s e = do result <- handleCommonEvent s e case result of Just s' -> continue s' Nothing -> do result2 <- handleAttrEvent s e case result2 of Just s'' -> continue s'' Nothing -> handleEvent s e handleAttrEvent :: AppState -> BrickEvent Name AppEvent -> EventM Name (Maybe AppState) handleAttrEvent s (MouseDown FgSelector _ _ _) = return $ Just $ beginFgPaletteSelect s handleAttrEvent s (MouseDown BgSelector _ _ _) = return $ Just $ beginBgPaletteSelect s handleAttrEvent s (MouseDown StyleSelector _ _ _) = return $ Just $ beginStyleSelect s handleAttrEvent _ _ = return Nothing handleEvent :: AppState -> BrickEvent Name AppEvent -> EventM Name (Next AppState) handleEvent s (VtyEvent (V.EvPaste bytes)) = continue =<< pasteTextAtPoint (0, 0) s (decodeUtf8 bytes) handleEvent s (AppEvent (DragFinished n _ _)) = continue =<< handleDragFinished s n handleEvent s (VtyEvent (V.EvMouseDown _ _ V.BScrollUp _)) = continue $ increaseToolSize s handleEvent s (VtyEvent (V.EvMouseDown _ _ V.BScrollDown _)) = continue $ decreaseToolSize s handleEvent s (MouseDown _ V.BScrollUp _ _) = continue $ increaseToolSize s handleEvent s (MouseDown _ V.BScrollDown _ _) = continue $ decreaseToolSize s handleEvent s (MouseDown Canvas _ _ (Location l)) = continue =<< drawWithCurrentTool l s handleEvent s (MouseDown n _ _ _) = continue =<< case n of LayerName -> return $ beginLayerRename s DeleteLayer -> return $ deleteSelectedLayer s MoveLayerUp -> return $ moveCurrentLayerUp s MoveLayerDown -> return $ moveCurrentLayerDown s ResizeCanvas -> return $ beginCanvasSizePrompt s ToggleLayerVisible -> return $ toggleCurrentLayer s ToolSelector -> return $ beginToolSelect s IncreaseToolSize -> return $ increaseToolSize s DecreaseToolSize -> return $ decreaseToolSize s BoxStyleSelector -> return $ beginBoxStyleSelect s SelectLayer idx -> return $ selectLayer idx s AddLayer -> addLayer s CharSelector -> return $ whenTool s charTools beginCharacterSelect _ -> return s handleEvent s (VtyEvent (V.EvKey (V.KChar 'q') [])) = quit True s handleEvent s (VtyEvent e) = continue =<< case e of _ | isStyleKey e -> return $ toggleStyleFromKey e s (V.EvKey (V.KChar 'l') [V.MCtrl]) -> return $ toggleLayerList s (V.EvKey (V.KChar 'w') []) -> return $ canvasMoveDown s (V.EvKey (V.KChar 's') []) -> return $ canvasMoveUp s (V.EvKey (V.KChar 'a') []) -> return $ canvasMoveLeft s (V.EvKey (V.KChar 'd') []) -> return $ canvasMoveRight s (V.EvKey (V.KChar 'y') []) -> return $ beginStyleSelect s (V.EvKey (V.KChar 'v') []) -> return $ beginCanvasSizePrompt s (V.EvKey (V.KChar 's') [V.MCtrl]) -> return $ askForSaveFilename False s (V.EvKey (V.KChar 'r') [V.MCtrl]) -> return $ beginLayerRename s (V.EvKey (V.KChar 'x') [V.MCtrl]) -> return $ deleteSelectedLayer s (V.EvKey (V.KChar 'n') [V.MCtrl]) -> return $ selectNextLayer s (V.EvKey (V.KChar 'p') [V.MCtrl]) -> return $ selectPrevLayer s (V.EvKey (V.KChar 'u') [V.MCtrl]) -> return $ moveCurrentLayerUp s (V.EvKey (V.KChar 'd') [V.MCtrl]) -> return $ moveCurrentLayerDown s (V.EvKey (V.KChar 'v') [V.MCtrl]) -> return $ toggleCurrentLayer s (V.EvKey (V.KChar 'C') []) -> return $ recenterCanvas s (V.EvKey (V.KChar 'f') []) -> return $ beginFgPaletteSelect s (V.EvKey (V.KChar 'b') []) -> return $ beginBgPaletteSelect s (V.EvKey (V.KChar '>') []) -> return $ increaseToolSize s (V.EvKey (V.KChar '<') []) -> return $ decreaseToolSize s (V.EvKey V.KEsc []) | isJust (s^.dragging) -> return $ cancelDragging s (V.EvKey (V.KChar c) []) | isDigit c -> return $ setToolByChar c s (V.EvKey (V.KChar 'c') []) -> return $ whenTool s charTools beginCharacterSelect (V.EvKey (V.KChar '+') []) -> increaseCanvasSize s (V.EvKey (V.KChar '-') []) -> decreaseCanvasSize s (V.EvKey (V.KChar 'a') [V.MCtrl]) -> addLayer s (V.EvKey (V.KChar 'u') []) -> undo s (V.EvKey (V.KChar 'r') []) -> redo s _ -> return s handleEvent s _ = continue s