59 lines
1.5 KiB
Haskell
59 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE OverloadedLabels #-}
|
|
|
|
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)
|
|
|
|
-- Colors for hover effects
|
|
defaultBg :: T.Text
|
|
defaultBg = "rgba(255,255,255,0)" -- Transparent background
|
|
|
|
hoverBg :: T.Text
|
|
hoverBg = "rgba(200,200,255,1)" -- Light blue on hover
|
|
|
|
createWordLabel :: Int -> T.Text -> IO Gtk.Widget
|
|
createWordLabel idx word = do
|
|
label <- Gtk.labelNew (Just word)
|
|
|
|
-- Gesture for click events
|
|
gesture <- Gtk.gestureClickNew
|
|
Gtk.widgetAddController label gesture
|
|
|
|
void $ Gtk.onGestureClickPressed gesture $ \_ _ _ -> do
|
|
putStrLn $ "Clicked token " ++ show idx ++ ": " ++ T.unpack word
|
|
|
|
Gtk.toWidget label
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
app <- Gtk.applicationNew (Just "com.example.TokenClicker") []
|
|
|
|
void $ Gio.onApplicationActivate app $ do
|
|
window <- Gtk.applicationWindowNew app
|
|
Gtk.windowSetTitle window (Just "Token Clicker")
|
|
Gtk.windowSetDefaultSize window 400 100
|
|
|
|
box <- Gtk.boxNew Gtk.OrientationHorizontal 0 -- Set spacing to 0
|
|
|
|
|
|
let tokens = ["これ", "は", "日本語", "の", "文章", "です"]
|
|
|
|
-- Create labels for each token
|
|
widgets <- mapM (uncurry createWordLabel) (zip [0..] tokens)
|
|
mapM_ (Gtk.boxAppend box) widgets
|
|
|
|
Gtk.windowSetChild window (Just box)
|
|
|
|
void $ Gtk.on window #closeRequest $ do
|
|
Gio.applicationQuit app
|
|
return False
|
|
|
|
Gtk.widgetSetVisible window True
|
|
|
|
_ <- Gio.applicationRun app Nothing
|
|
return ()
|