module Main where

import Graphics.UI.Gtk
import Graphics.Rendering.Cairo
import Data.IORef

main :: IO ()
main = do

  pc <- cairoCreateContext Nothing
  ohayou <- layoutText pc "おはよう"

  initGUI
  window <- windowNew
  im     <- imMulticontextNew

  frame  <- frameNew
  containerAdd window frame
  canvas <- drawingAreaNew
  containerAdd frame canvas
  widgetModifyBg canvas StateNormal ( Color 65535 65535 65535 )

  preeditRef <- newIORef ""
  buffer     <- newIORef ""

  on im imContextPreeditStart $
    return ()
  on im imContextPreeditEnd $ do
    str <- readIORef preeditRef
    putStr   "preedit end"
    putStrLn str
--    layoutSetText ohayou str
--    widgetQueueDraw canvas
  on im imContextPreeditChanged $ do
    ( str, _, _ ) <- imContextGetPreeditString im
    putStr   "preedit changed"
    putStrLn str
    pre <- readIORef buffer
    writeIORef preeditRef str
    layoutSetText ohayou $ pre ++ str
    widgetQueueDraw canvas
  on im imContextCommit $ \str -> do
    modifyIORef buffer (++ str)
    ret <- readIORef buffer
    layoutSetText ohayou ret
    widgetQueueDraw canvas
    putStrLn str

  on canvas exposeEvent $ do
    win <- eventWindow
    liftIO $ displayLayout win ohayou
{-
    win <- eventWindow
    liftIO $ do
      putStrLn "canvas exposed"
      renderWithDrawable  win $ do
        moveTo 0 0
        showLayout ohayou
    return True
-}

  onDestroy window mainQuit
  on window realize $ imContextSetClientWindow im . Just =<< widgetGetDrawWindow window
  on window focusInEvent $ liftIO ( imContextFocusIn im ) >> return False
  on window keyPressEvent $ do
    imHandled <- imContextFilterKeypress im
    if imHandled then return True else do
      modifiers <- eventModifier
      keyName   <- eventKeyName
      keyChar   <- fmap keyToChar eventKeyVal
      liftIO $ do
        putStr "modifiers : "
        print modifiers
        putStr "keyname   : "
        print keyName
        putStr "keychar   : "
        print keyChar
        case keyName of
             "Return" -> modifyIORef buffer (++ "\n")
             _        -> return ()
      return True

  widgetShowAll window
  mainGUI

-- displayLayout :: 
displayLayout win lay = do
      putStrLn "canvas exposed"
      renderWithDrawable  win $ do
        moveTo 0 0
        showLayout lay
      return True