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
|
##ifdef CAMLTK
let cCAMLtoTKcolor = function
NamedColor x -> TkToken x
| Black -> TkToken "black"
| White -> TkToken "white"
| Red -> TkToken "red"
| Green -> TkToken "green"
| Blue -> TkToken "blue"
| Yellow -> TkToken "yellow"
;;
let cTKtoCAMLcolor = function s -> NamedColor s
;;
let cCAMLtoTKcursor = function
XCursor s -> TkToken s
| XCursorFg (s,fg) ->
TkQuote(TkTokenList [TkToken s; cCAMLtoTKcolor fg])
| XCursortFgBg (s,fg,bg) ->
TkQuote(TkTokenList [TkToken s; cCAMLtoTKcolor fg; cCAMLtoTKcolor bg])
| CursorFileFg (s,fg) ->
TkQuote(TkTokenList [TkToken ("@"^s); cCAMLtoTKcolor fg])
| CursorMaskFile (s,m,fg,bg) ->
TkQuote(TkTokenList [TkToken ("@"^s); TkToken m; cCAMLtoTKcolor fg; cCAMLtoTKcolor bg])
;;
##else
let cCAMLtoTKcolor : color -> tkArgs = function
| `Color x -> TkToken x
| `Black -> TkToken "black"
| `White -> TkToken "white"
| `Red -> TkToken "red"
| `Green -> TkToken "green"
| `Blue -> TkToken "blue"
| `Yellow -> TkToken "yellow"
;;
let cTKtoCAMLcolor = function s -> `Color s
;;
let cCAMLtoTKcursor : cursor -> tkArgs = function
| `Xcursor s -> TkToken s
| `Xcursorfg (s,fg) ->
TkQuote(TkTokenList [TkToken s; cCAMLtoTKcolor fg])
| `Xcursorfgbg (s,fg,bg) ->
TkQuote(TkTokenList [TkToken s; cCAMLtoTKcolor fg; cCAMLtoTKcolor bg])
| `Cursorfilefg (s,fg) ->
TkQuote(TkTokenList [TkToken ("@"^s); cCAMLtoTKcolor fg])
| `Cursormaskfile (s,m,fg,bg) ->
TkQuote(TkTokenList [TkToken ("@"^s); TkToken m; cCAMLtoTKcolor fg; cCAMLtoTKcolor bg])
;;
##endif
|
