Blob Blame History Raw
(***********************************************************************)
(*                                                                     *)
(*                 MLTk, Tcl/Tk interface of OCaml                     *)
(*                                                                     *)
(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
(*               projet Cristal, INRIA Rocquencourt                    *)
(*            Jacques Garrigue, Kyoto University RIMS                  *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  en Automatique and Kyoto University.  All rights reserved.         *)
(*  This file is distributed under the terms of the GNU Library        *)
(*  General Public License, with the special exception on linking      *)
(*  described in file LICENSE found in the OCaml source tree.          *)
(*                                                                     *)
(***********************************************************************)
(* Delayed global, a.k.a cache&carry *)
let autodef f =
  let v = ref None in
  (function () ->
     match !v with
       None ->
         let x = f() in
           v := Some x;
           x
     | Some x -> x)

open Camltk

(* allows Data in options *)
let create_photo options =
  let hasopt = ref None in
  (* Check options *)
  List.iter (function
      Data s ->
        begin match !hasopt with
          None -> hasopt := Some (Data s)
        | Some _ -> raise (Protocol.TkError "two data sources in options")
        end
    | File f ->
        begin match !hasopt with
          None -> hasopt := Some (File f)
        | Some _ -> raise (Protocol.TkError "two data sources in options")
        end
    | o -> ())
    options;
  match !hasopt with
    None -> raise (Protocol.TkError "no data source in options")
  | Some (Data s) ->
      begin
        let tmpfile = Filename.temp_file "img" "" in
        let oc = open_out_bin tmpfile in
        output_string oc s;
        close_out oc;
        let newopts =
          List.map (function
            | Data s -> File tmpfile
            | o -> o)
            options in
        try
          let i = Imagephoto.create newopts in
          (try Sys.remove tmpfile with Sys_error _ -> ());
          i
        with
          e ->
            (try Sys.remove tmpfile with Sys_error _ -> ());
            raise e
      end
  | Some (File s) -> Imagephoto.create options
  | _ -> assert false