1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE OverloadedStrings #-}
-- Example of using a PangoLayout
import Data.IORef
import Data.Monoid ((<>))
import qualified Data.Text as T
import Graphics.UI.Gtk
import Graphics.Rendering.Cairo
loremIpsum = "Lorem ipsum dolor sit amet, consectetur adipisicing elit,\
\ sed do eiusmod tempor incididunt ut labore et dolore magna\
\ aliqua. Ut enim ad minim veniam, quis nostrud exercitation\
\ ullamco laboris nisi ut aliquip ex ea commodo consequat.\
\ Duis aute irure dolor in reprehenderit in voluptate\
\ velit esse cillum dolore eu fugiat nulla pariatur.\
\ Excepteur sint occaecat cupidatat non proident, sunt in culpa\
\ qui officia deserunt mollit anim id est laborum."
data Buffer = Buffer T.Text Int
defaultBuffer = Buffer loremIpsum (T.length loremIpsum)
displayBuffer (Buffer str pos) =
before <> "<CURSOR>" <> after
where (before,after) = T.splitAt pos str
displayBufferPreedit (Buffer str pos) preeditStr preeditPos =
before <> "[" <> prebefore <> "<CURSOR>" <> preafter <> "]" <> after
where (before,after) = T.splitAt pos str
(prebefore, preafter) = T.splitAt preeditPos preeditStr
insertStr new (Buffer str pos) = Buffer (before<>new<>after) (pos+T.length new)
where (before,after) = T.splitAt pos str
deleteChar b@(Buffer str 0) = b
deleteChar (Buffer str pos) = Buffer (T.init before <> after) (pos-1)
where (before,after) = T.splitAt pos str
moveLeft b@(Buffer str pos) | pos==0 = b
| otherwise = Buffer str (pos-1)
moveRight b@(Buffer str pos) | pos==T.length str = b
| otherwise = Buffer str (pos+1)
main = do
initGUI
-- Create the main window.
win <- windowNew
on win objectDestroy mainQuit
-- Create a drawing area in which we can render text.
area <- drawingAreaNew
containerAdd win area
widgetSetSizeRequest area 100 100
-- Our widget's data
buffer <- newIORef defaultBuffer
preeditRef <- newIORef Nothing
-- Create a Cairo Context that contains information about the current font,
-- etc.
ctxt <- cairoCreateContext Nothing
lay <- layoutEmpty ctxt
layoutSetWrap lay WrapWholeWords
let relayout = do
buffer@(Buffer _ cursor) <- readIORef buffer
preedit <- readIORef preeditRef
case preedit of
Nothing -> do
layoutSetText lay (displayBuffer buffer)
layoutSetAttributes lay []
Just (str,attrs,pos) -> do
layoutSetText lay (displayBufferPreedit buffer str pos)
layoutSetAttributes lay (map (shiftAttribute (cursor + 1))
(concat attrs))
widgetQueueDraw area
relayout
-- Wrap the layout to a different width each time the window is resized.
on area sizeAllocate $ \(Rectangle _ _ w _) ->
layoutSetWidth lay (Just (fromIntegral w))
-- Setup the handler to draw the layout.
on area draw $ updateArea area lay
-- Set up input method
im <- imMulticontextNew
on im imContextPreeditStart $ do
writeIORef preeditRef (Just ("",[],0))
relayout
on im imContextPreeditEnd $ do
writeIORef preeditRef Nothing
relayout
on im imContextPreeditChanged $ do
writeIORef preeditRef . Just =<< imContextGetPreeditString im
relayout
on im imContextCommit $ \str -> do
modifyIORef buffer (insertStr str)
relayout
on im imContextRetrieveSurrounding $ do
Buffer text pos <- readIORef buffer
imContextSetSurrounding im text pos
return True
on im imContextDeleteSurrounding' $ \off nchars -> do
putStrLn $ "delete-surrounding("++show off++","++show nchars++")"
return False
on win realize $ do
imContextSetClientWindow im =<< widgetGetWindow win
on win focusInEvent $ liftIO (imContextFocusIn im) >> return False
on win focusOutEvent $ liftIO (imContextFocusOut im) >> return False
on win keyReleaseEvent $ imContextFilterKeypress im
on win keyPressEvent $ do
imHandled <- imContextFilterKeypress im
if imHandled then return True else do
mod <- interpretKeyPress
case mod of
Just f -> liftIO $ modifyIORef buffer f >> relayout >> return True
Nothing -> return False
widgetShowAll win
mainGUI
updateArea :: DrawingArea -> PangoLayout -> Render ()
updateArea area lay = do
moveTo 0 0
showLayout lay
interpretKeyPress :: EventM EKey (Maybe (Buffer -> Buffer))
interpretKeyPress = do
modifiers <- eventModifier
if modifiers /= [] then return Nothing else do
keyName <- eventKeyName
keyChar <- fmap keyToChar eventKeyVal
case keyChar of
Just ch -> do
-- This does not appear to get called; the IM handles
-- unmodified keypresses.
liftIO $ putStrLn "Literal character not handled by IM"
returnJust (insertStr $ T.singleton ch)
Nothing -> do
case keyName of
"Left" -> returnJust moveLeft
"Right" -> returnJust moveRight
"BackSpace" -> returnJust deleteChar
_ -> return Nothing
where returnJust = return . Just
shiftAttribute :: Int -> PangoAttribute -> PangoAttribute
shiftAttribute x attr = attr { paStart = x + paStart attr,
paEnd = x + paEnd attr }
|
