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
|
-- Demo to show off entry completion.
import Graphics.UI.Gtk
import Data.Char
import Data.List
data ColorDesc = ColorDesc {
cdColor :: Color,
cdName :: String
} deriving Show
compareCol :: ColumnId ColorDesc String
compareCol = makeColumnIdString 0
invertColor (Color r g b) = Color (32767+r) (32767+g) (32767+b)
--Color (65535-r) (65535-g) (65535-b)
parseColor s = ColorDesc c (dropWhile isSpace (upperToSpace name))
where
s1 = dropWhile isSpace s
(s2,s3) = span isDigit s1
s4 = dropWhile isSpace s3
(s5,s6) = span isDigit s4
s7 = dropWhile isSpace s6
(s8,s9) = span isDigit s7
n1 = read ('0':s2)
n2 = read ('0':s5)
n3 = read ('0':s8)
c = Color (n1*256+n1) (n2*256+n2) (n3*256+n3)
name = dropWhile isSpace s9
upperToSpace [] = []
upperToSpace (x:xs) | isUpper x = ' ':toLower x:upperToSpace xs
| otherwise = x:upperToSpace xs
main =
do
initGUI
window <- windowNew
contents <- readFile "rgb.txt"
let killDups [] = []
killDups [x] = [x]
killDups (x:y:xs) | cdName x==cdName y = killDups (y:xs)
| otherwise = x:killDups (y:xs)
cols = killDups $ map parseColor (drop 1 (lines contents))
store <- listStoreNew cols
customStoreSetColumn store compareCol cdName
entry <- entryNew
completion <- entryCompletionNew
entrySetCompletion entry completion
set completion [entryCompletionModel := Just store]
cell <- cellRendererTextNew
set cell [cellTextBackgroundSet := True,
cellTextForegroundSet := True]
cellLayoutPackStart completion cell True
cellLayoutSetAttributes completion cell store
(\cd -> [cellText := cdName cd,
cellTextBackgroundColor := cdColor cd,
cellTextForegroundColor := invertColor (cdColor cd)])
entryCompletionSetMatchFunc completion (matchFunc store)
on completion matchSelected $ \model iter -> do
color <- treeModelGetValue model iter compareCol
entrySetText entry color
return True
set window [containerChild := entry]
widgetShowAll window
on window objectDestroy mainQuit
mainGUI
matchFunc :: ListStore ColorDesc -> String -> TreeIter -> IO Bool
matchFunc model str iter = do
--putStrLn ("iter is "++show iter)
tp <- treeModelGetPath model iter
r <- case tp of
(i:_) -> do row <- listStoreGetValue model i
return $ any (isPrefixOf (map toLower str))
(words (map toLower (cdName row)))
otherwise -> return False
return r
|
