yavie-vty.hs

module Main ( main ) where

import Graphics.Vty
  ( Vty, Cursor(..), DisplayRegion(..),
    Event(..), Key(..), Modifier(..),  Button(..),
    mkVty, shutdown, update, next_event, display_bounds, terminal,
    pic_for_image, pic_cursor, string, vert_cat,
    with_style, def_attr, reverse_video )
import Control.Monad.Tools

import           Yavie
import           Yavie.Editor
import           Yavie.Keybind ( Cmdbind )
import qualified Yavie.Keybind as K
import           Yavie.Keybind.Vi
import Data.Time
import System.Locale
import Control.Monad.State

main :: IO ()
main = runYavie myConfig

myCmdbind :: Cmdbind ()
myCmdbind "today" = do
  bind defaultInsertmode
  modify $ setIOAction $ \ed -> do
    time  <- getToday
    return $ insertStringAfter ( "\n\n" ++ time ++ "\n" )
           $ cursorEndOfLine ed
  where
  getToday = do
    tz    <- getCurrentTimeZone
    lDay  <- fmap ( localDay . utcToLocalTime tz ) getCurrentTime
    return $ formatTime defaultTimeLocale "%Y.%m.%d %a." lDay
myCmdbind cmd = defaultCmdbind cmd
  

myConfig :: YavieConfig IO Vty ()
myConfig = YavieConfig {

  isEventDriven    = False ,

  withInitEditor   = defaultWithInitEditor ,
  initialize       = mkVty ,
  finalize         = shutdown ,
  displaySize      = getDisplaySize ,
  drawDisplay      = drawDisplayVty ,

  supplyEvent      = \vty act -> doWhile_ $
                       fmap convertEvent ( next_event vty ) >>= act ,

  keybind          = defaultKeybind myCmdbind ,
  romode           = defaultRomode ,

  runAction      = runIOAction ,
  getReadOnlyFlag  = defaultGetReadOnlyFlag

}

getDisplaySize :: Vty -> IO ( Int, Int )
getDisplaySize vty = do
  DisplayRegion w h <- display_bounds $ terminal vty
  return ( fromIntegral w, fromIntegral h )

drawDisplayVty :: Vty -> IO ( Editor c ) -> IO ()
drawDisplayVty vty getLns = do
  ed <- getLns
  let ( cx, cy ) = cursorPosOfDpy ed
      lns        = displayVisualLines ed
      img = vert_cat $ map ( \( s, ln ) -> string ( getAttr s ) $ ln ++ " " ) lns
      pic = ( pic_for_image img ) { pic_cursor = Cursor ( fromIntegral cx )
                                                        ( fromIntegral cy ) }
  update vty pic
  where
  getAttr True  = def_attr `with_style` reverse_video
  getAttr False = def_attr

convertEvent :: Event -> K.Event
convertEvent ( EvKey k ms )       =
  K.EvKey ( convertKey k ) ( map convertModifier ms )
convertEvent ( EvMouse x y b ms ) =
  K.EvMouse x y ( convertButton b ) ( map convertModifier ms )
convertEvent ( EvResize w h )     = K.EvResize w h

convertKey :: Key -> K.Key
convertKey KEsc            = K.KEsc
convertKey ( KFun n )      = K.KFun n
convertKey ( KASCII '\t' ) = K.KTab
convertKey KBackTab        = K.KBackTab
convertKey KPrtScr         = K.KPrtScr
convertKey KPause          = K.KPause
convertKey ( KASCII c )    = K.KASCII c
convertKey KBS             = K.KBS
convertKey KIns            = K.KIns
convertKey KHome           = K.KHome
convertKey KPageUp         = K.KPageUp
convertKey KDel            = K.KDel
convertKey KEnd            = K.KEnd
convertKey KPageDown       = K.KPageDown
convertKey KNP5            = K.KUnknown
convertKey KUp             = K.KUp
convertKey KMenu           = K.KMenu
convertKey KLeft           = K.KLeft
convertKey KDown           = K.KDown
convertKey KRight          = K.KRight
convertKey KEnter          = K.KEnter

convertModifier :: Modifier -> K.Modifier
convertModifier MShift = K.MShift
convertModifier MCtrl  = K.MCtrl
convertModifier MMeta  = K.MMeta
convertModifier MAlt   = K.MAlt

convertButton :: Button -> K.Button
convertButton BLeft   = K.BLeft
convertButton BMiddle = K.BMiddle
convertButton BRight  = K.BRight