diff --git a/simpleKanaIME.hs b/simpleKanaIME.hs new file mode 100644 index 0000000..ee6751b --- /dev/null +++ b/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)