otherlibs/labltk/builtin/image.ml


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

##ifdef CAMLTK

let cTKtoCAMLimage s =
  let res = tkEval [|TkToken "image"; TkToken "type"; TkToken s|] in
  match res with
  | "bitmap" -> ImageBitmap (BitmapImage s)
  | "photo" -> ImagePhoto (PhotoImage s)
  | _ -> raise (TkError ("unknown image type \"" ^ res ^ "\""))
;;

let names () =
  let res = tkEval [|TkToken "image"; TkToken "names"|] in
  let names = splitlist res in
  List.map cTKtoCAMLimage names
;;

##else

let cTKtoCAMLimage s =
  let res = tkEval [|TkToken "image"; TkToken "type"; TkToken s|] in
  match res with
  | "bitmap" -> `Bitmap s
  | "photo" -> `Photo s
  | _ -> raise (TkError ("unknown image type \"" ^ res ^ "\""))
;;

let names () =
  let res = tkEval [|TkToken "image"; TkToken "names"|] in
  let names = splitlist res in
  List.map cTKtoCAMLimage names
;;

##endif