Update keyPress.hs

This commit is contained in:
千住柱間 2025-01-31 04:23:35 +00:00
commit 2904d11e51

View file

@ -1,136 +1,36 @@
-- Copyright © 2025 Hashirama Senju
{-# LANGUAGE OverloadedStrings, OverloadedLabels, ImplicitParams #-}
import Control.Monad
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import System.Environment (getArgs, getProgName)
import Data.Int (Int32)
import Data.Maybe
import qualified GI.Gtk as Gtk
import Data.GI.Base
import GI.Gdk as Gdk
import GI.Gdk as Gdk hiding (Display)
import qualified Graphics.X11.Xlib as X11 -- yes, we're using xlib
import Graphics.X11.Xlib.Misc
import Graphics.X11.Xlib.Types
import Foreign.C.Types
import Data.Text (Text, unpack)
import Text.Read (readMaybe)
import Data.Word (Word32)
import Data.Word
-- TODO:
-- use this instead of a table:
-- https://hackage.haskell.org/package/X11-1.10.3/docs/Graphics-X11-Xlib-Misc.html#v:keycodeToKeysym
keymap :: [(Word32, String)]
keymap =
[ (9, "# Esc")
, (67, "# F1")
, (68, "# F2")
, (69, "# F3")
, (70, "# F4")
, (71, "# F5")
, (72, "# F6")
, (73, "# F7")
, (74, "# F8")
, (75, "# F9")
, (76, "# F10")
, (95, "# F11")
, (96, "# F12")
, (111, "# PrintScrn")
, (78, "# Scroll Lock")
, (110, "# Pause")
, (49, "# `")
, (10, "# 1")
, (11, "# 2")
, (12, "# 3")
, (13, "# 4")
, (14, "# 5")
, (15, "# 6")
, (16, "# 7")
, (17, "# 8")
, (18, "# 9")
, (19, "# 0")
, (20, "# -")
, (21, "# =")
, (22, "# Backspace")
, (106, "# Insert")
, (97, "# Home")
, (99, "# Page Up")
, (77, "# Num Lock")
, (112, "# KP /")
, (63, "# KP *")
, (82, "# KP -")
, (23, "# Tab")
, (24, "# Q")
, (25, "# W")
, (26, "# E")
, (27, "# R")
, (28, "# T")
, (29, "# Y")
, (30, "# U")
, (31, "# I")
, (32, "# O")
, (33, "# P")
, (34, "# [")
, (35, "# ]")
, (36, "# Return")
, (107, "# Delete")
, (103, "# End")
, (105, "# Page Down")
, (79, "# KP 7")
, (80, "# KP 8")
, (81, "# KP 9")
, (86, "# KP +")
, (66, "# Caps Lock")
, (38, "# A")
, (39, "# S")
, (40, "# D")
, (41, "# F")
, (42, "# G")
, (43, "# H")
, (44, "# J")
, (45, "# K")
, (46, "# L")
, (47, "# ;")
, (48, "# '")
, (83, "# KP 4")
, (84, "# KP 5")
, (85, "# KP 6")
, (50, "# Shift Left")
, (94, "# International")
, (52, "# Z")
, (53, "# X")
, (54, "# C")
, (55, "# V")
, (56, "# B")
, (57, "# N")
, (58, "# M")
, (59, "# ,")
, (60, "# .")
, (61, "# /")
, (62, "# Shift Right")
, (51, "# \\")
, (98, "# Cursor Up")
, (87, "# KP 1")
, (88, "# KP 2")
, (89, "# KP 3")
, (108, "# KP Enter")
, (37, "# Ctrl Left")
, (115, "# Logo Left (-> Option)")
, (64, "# Alt Left (-> Command)")
, (65, "# Space")
, (113, "# Alt Right (-> Command)")
, (116, "# Logo Right (-> Option)")
, (117, "# Menu (-> International)")
, (109, "# Ctrl Right")
, (100, "# Cursor Left")
, (104, "# Cursor Down")
, (102, "# Cursor Right")
, (90, "# KP 0")
, (91, "# KP .")
, (133, "# ModKey")
]
parseKeycode :: Word32 -> IO String
parseKeycode keycode = do
display <- X11.openDisplay "" -- Open the display (IO Display)
let keycodeW8 = fromIntegral (keycode :: Word32) :: Word8 -- Convert keycode to Word8
keysym <- keycodeToKeysym display keycodeW8 (0 :: CInt) -- Get keysym from keycode (IO X11.KeySym)
let toStringCode = keysymToString keysym -- This is IO String
return toStringCode -- Return the result as IO String
handleKeyEvent :: Word32 -> IO ()
handleKeyEvent keyval =
case lookup keyval keymap of
Just keyName -> putStrLn keyName
Nothing -> putStrLn "Unknown key"
activate :: Gtk.Application -> IO ()
activate app = do
@ -147,7 +47,8 @@ activate app = do
Gtk.on controller #keyPressed $ \_ keyval _ -> do
handleKeyEvent $ keyval -- keyval is translated using our hardcoded table
toStringCode <- liftIO (parseKeycode keyval) -- it works, but i personally dont like this hackery, but we can work on it later.
print toStringCode
return True