module Examples.VtyDemo (

  main

) where

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

import qualified Yavie as K   ( Event(..), Key(..), Modifier(..), Button(..) )
import           Yavie hiding ( Event(..), Key(..), Modifier(..), Button(..) )

main :: IO ()
main = runYavie myConfig

myConfig :: YavieConfig IO Vty ()
myConfig = YavieConfig {
  withInitEditor   = defaultWithInitEditor ,
  initialize       = mkVty ,
  finalize         = shutdown ,
  displaySize      = getDisplaySize ,
  drawDisplay      = drawDisplayVty ,
  keybind          = defaultKeybind defaultCmdbind ,
  romode           = defaultRomode ,
  runAction        = runIOAction ,
  getReadOnlyFlag  = defaultGetReadOnlyFlag ,
  supplyEvent      = setDemoEvent ,
  isEventDriven    = False
}

setDemoEvent :: Vty -> ( K.Event -> IO Bool ) -> IO ()
setDemoEvent vty act = do
  demoRef <- newIORef $ map charToEvent demoStr
  doWhile_ $ demoEvent vty demoRef >>= act
                             
demoStr :: String
demoStr = "i\n\n\n\n\t\tYavie is Yet Another VI Editor\n" ++
          "\t\t日本語表示も問題無し\n\ESC" ++
          "i\n\n\n\t\tmade by Yoshikuni Jujo\n\ESC" ++
          "i\t\ttoday: \ESC:today\n\ESCkkkJJ" ++
          "/today\nddggPI\t\t\t\t\ESC" ++
          "Gi\n\n\n\n\n\ESCo\t\tPlease enjoy!\ESC" ++
          "O\t\tこのプログラムをまなみにささげます\ESC" ++
          "/まなみ\nRxxx\ESC" ++
          "gg0ft~/Yavie\nl~~~~lxr-" ++
          "/YAVIE\no\n\t\tversion 0.0.1\ESCkkI\t\ESCjjI\t\t\ESC" ++
          "/made\ndd/version\npj0fmcw\t      \ESC" ++
          "jcc\t\tYavie はオープンソースであり自由に配布可能です\ESC" ++
          "O\ESCjo\n\t\t\tYoshikuni Jujo を応援してください!\ESCGddddgg0" ++
          "G7k8dd" ++
          "/Yoshikuni Jujo を\no\t\t詳細な情報は無い " ++
          "don't input\t:help sponsor<ENTER>\n\n" ++
          "\t\t終了するには\t\t\t  :q!<Enter>\ESCgg0" ++
          "/Yoshikuni Jujo を\ndj" ++
          "\ESCq"

charToEvent :: Char -> K.Event
charToEvent '\n'   = K.EvKey K.KEnter       [ ]
charToEvent '\ESC' = K.EvKey K.KEsc         [ ]
charToEvent c      = K.EvKey ( K.KASCII c ) [ ]

demoEvent :: Vty -> IORef [ K.Event ] -> IO K.Event
demoEvent vty devs = do
  evs <- readIORef devs
  case evs of
       [] ->
         fmap convertEvent $ next_event vty
       [ K.EvKey ( K.KASCII 'q' ) [ ] ] -> do
         ev <- fmap convertEvent $ next_event vty
         writeIORef devs $ map charToEvent "gg10dd:q!\n" ++ [ ev ]
         return $ K.EvKey K.KEsc [ ]
       (ev:_) -> do
         threadDelay 100000
         modifyIORef devs tail
         return ev

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 KBackTab     = K.KUnknown
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

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

drawDisplayVty :: Vty -> IO DisplayLines -> IO ()
drawDisplayVty vty getLns = do
  dl <- getLns
  let ( cx, cy ) = getCursorPos dl
      lns        = displayLinesWithSel dl
      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