(***********************************************************************)

(*                                                                     *)

(*                 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.          *)

(*                                                                     *)

(***********************************************************************)

open Camltk

(*

 * Progress indicators

 *)

let okcolor = NamedColor "#3cb371"

and kocolor = NamedColor "#dc5c5c"

let new_vertical parent w h =

  let c = Canvas.create_named parent "fillbox"

            [Width (Pixels w); Height (Pixels h); BorderWidth (Pixels 1);

             Relief Sunken]

  in

  let i = Canvas.create_rectangle c (Pixels 0) (Pixels 0) (Pixels w) (Pixels 0)

            [FillColor okcolor; Outline okcolor]

  in

    c, (function

           0 -> Canvas.configure_rectangle c i [FillColor okcolor;

                                                Outline okcolor];

                Canvas.coords_set c i [Pixels 0; Pixels 0;

                                        Pixels w; Pixels 0]

         | -1 -> Canvas.configure_rectangle c i [FillColor kocolor;

                                                 Outline kocolor]

         | n ->

             let percent = if n > 100 then 100 else n in

             let hf = percent*h/100 in

               Canvas.coords_set c i [Pixels 0; Pixels 0;

                                       Pixels w; Pixels hf])

let new_horizontal parent w h =

  let c = Canvas.create_named parent "fillbox"

            [Width (Pixels w); Height (Pixels h); BorderWidth (Pixels 1);

             Relief Sunken]

  in

  let i = Canvas.create_rectangle c (Pixels 0) (Pixels 0) (Pixels 0) (Pixels h)

            [FillColor okcolor; Outline okcolor]

  in

    c, (function

           0 -> Canvas.configure_rectangle c i [FillColor okcolor;

                                                Outline okcolor];

                Canvas.coords_set c i [Pixels 0; Pixels 0;

                                        Pixels 0; Pixels h]

         | -1 -> Canvas.configure_rectangle c i [FillColor kocolor;

                                                 Outline kocolor]

         | n ->

             let percent = if n > 100 then 100 else n in

             let wf = percent*w/100 in

               Canvas.coords_set c i [Pixels 0; Pixels 0;

                                       Pixels wf; Pixels h])