haskell-examples/hoverSentence.hs
2025-03-04 04:04:53 +00:00

62 lines
1.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLabels #-}
{-
this receives a list of strings, thus it's fully compatible with xcdatHS.
when you hover the mouse over a word, it shows the word in stdout.
-}
module Main where
import qualified GI.Gtk as Gtk
import qualified GI.Gio as Gio
import qualified Data.Text as T
import Control.Monad (void)
createWordLabel :: T.Text -> IO Gtk.Widget
createWordLabel word = do
label <- Gtk.labelNew (Just word)
-- Gesture for hover detection
motionController <- Gtk.eventControllerMotionNew
Gtk.widgetAddController label motionController
-- Print only when hovering an actual word
void $ Gtk.on motionController #enter $ \_ _ -> putStrLn (T.unpack word)
Gtk.toWidget label
main :: IO ()
main = do
app <- Gtk.applicationNew (Just "com.example.YomichanHover") []
void $ Gio.onApplicationActivate app $ do
window <- Gtk.applicationWindowNew app
Gtk.windowSetTitle window (Just "Yomichan Hover")
Gtk.windowSetDefaultSize window 400 100
-- Outer box (centers content)
outerBox <- Gtk.boxNew Gtk.OrientationVertical 0
Gtk.widgetSetHalign outerBox Gtk.AlignCenter
Gtk.widgetSetValign outerBox Gtk.AlignCenter
-- Sentence box (wraps words tightly)
sentenceBox <- Gtk.boxNew Gtk.OrientationHorizontal 0 -- 0 spacing = no visual spaces
Gtk.widgetSetHalign sentenceBox Gtk.AlignCenter
let tokens = ["これ", "", "日本語", "", "文章", "です"]
widgets <- mapM createWordLabel tokens
mapM_ (Gtk.boxAppend sentenceBox) widgets
Gtk.boxAppend outerBox sentenceBox
Gtk.windowSetChild window (Just outerBox)
void $ Gtk.on window #closeRequest $ do
Gio.applicationQuit app
return False
Gtk.widgetSetVisible window True
_ <- Gio.applicationRun app Nothing
return ()