summaryrefslogtreecommitdiff
path: root/otherlibs/labltk/builtin/builtini_GetCursor.ml
blob: 8c63876cbe800e4b2816d1a863d47d2c9246a546 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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])