(************************************************************
   ticker.ml		Created      : Sat Mar 15 15:28:56 2003
  			Last modified: Sat Mar 15 15:43:11 2003
  Compile: ocamlc -thread -I +labltk labltk.cma /usr/local/lib/ocaml/unix.cma threads.cma ticker.ml -o ticker #
  FTP Directory: sources/ocaml #
************************************************************)
(**
   ただ表示をきりかえるだけの ticker 幅が変わって騒がしい!?
  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

*)

open Tk

let ticker (content_ref, label) = 
  let content = Array.of_list !content_ref in
  let font = "-ricoh-gothic-medium-r-*-*-14-*" in
  let time = 10 in
  let size = Array.length content in
  let rec iter i =
    Label.configure ~font ~text:content.(i) label;
    Unix.sleep time;
    iter ((i+1) mod size) in
  iter 0

let _ =
  let content = ref [ "ぴろしき"; "英樹感激"; "すもももももももものうち" ] in
  let window = openTk () in
  let label = Label.create ~text:"ほげほげほげほげほげほげ" window in
  pack [label];
  ignore (Thread.create ticker (content, label));
  mainLoop ()