Add simpleKanaIME.hs

simpleKanaIME.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings, OverloadedLabels, ImplicitParams #-}
+
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import System.Environment (getArgs, getProgName)
+import Data.GI.Base
+import qualified GI.Gtk as Gtk
+import qualified Graphics.X11.Xlib as X11
+import Graphics.X11.Xlib.Misc
+import Graphics.X11.Xlib.Types
+import Foreign.C.Types
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Word
+
+
+-- | Hardcoded kana table: QWERTY key string -> Kana
+kanaMap :: Map.Map String Text
+kanaMap = Map.fromList
+  [ ("1", "ぬ"), ("2", "ふ"), ("3", "あ"), ("4", "う"), ("5", "え"), ("6", "お")
+  , ("7", "や"), ("8", "ゆ"), ("9", "よ"), ("0", "わ"), ("-", "ほ"), ("^", "へ")
+  , ("q", "た"), ("w", "て"), ("e", "い"), ("r", "す"), ("t", "か"), ("y", "ん")
+  , ("u", "な"), ("i", "に"), ("o", "ら"), ("p", "せ")
+  , ("a", "ち"), ("s", "と"), ("d", "し"), ("f", "は"), ("g", "き"), ("h", "く")
+  , ("j", "ま"), ("k", "の"), ("l", "り"), (";", "れ"), (":", "け")
+  , ("z", "つ"), ("x", "さ"), ("c", "そ"), ("v", "ひ"), ("b", "こ"), ("n", "み")
+  , ("m", "も"), (",", "ね"), (".", "る"), ("/", "め"), ("\\", "ろ")
+  ]
+
+-- | Convert GDK keyval (Word32) to string (e.g., "e", "a", etc.)
+parseKeycode :: Word32 -> IO String
+parseKeycode keycode = do
+    display <- X11.openDisplay ""
+    let keycodeW8 = fromIntegral keycode :: Word8
+    keysym <- keycodeToKeysym display keycodeW8 0
+    return (keysymToString keysym)
+
+
+-- | GTK main logic
+activate :: Gtk.Application -> IO ()
+activate app = do
+  window <- new Gtk.ApplicationWindow
+    [ #application := app
+    , #title := "Kana Practice"
+    ]
+
+  label <- new Gtk.Label [ #label := "Press a kana key" ]
+  #setChild window (Just label)
+
+  controller <- Gtk.new Gtk.EventControllerKey []
+  Gtk.widgetAddController window controller
+
+  Gtk.on controller #keyPressed $ \_ keyval _ -> do
+    keyStr <- liftIO (parseKeycode keyval)
+    let kana = Map.lookup keyStr kanaMap
+    case kana of
+      Just k  -> #setLabel label k
+      Nothing -> #setLabel label "?"
+    pure True
+
+  #show window
+
+main :: IO ()
+main = do
+  app <- new Gtk.Application
+    [ #applicationId := "org.example.kana"
+    , On #activate (activate ?self)
+    ]
+  args <- getArgs
+  progName <- getProgName
+  void $ #run app (Just $ progName : args)