(* Push button type *)

open Ws_widget_types
open Ws_types

type events =
  [ Ws_swidget.events
  | `ButtonClicked ]

class ['a] t parent (style_init : Ws_style.button_style) =
  object (self)
    inherit ['a] Ws_swidget.t parent as super

    constraint 'a = [> events ]

    val style = style_init
    val mutable is_pressed = false
    val mutable is_down = false
    val mutable is_in = false

    method redraw d =
      let mode =
	if is_down then `ButtonPressed
	else
	  if is_active then
	    if is_in then `ActiveMouseOver else `Active
	  else
	    if is_in then `MouseOver else `Default
      in
	style#draw d mode

    method size_changed =
      style#set_size (r_size region)

    method enter_notify =
      is_in <- true;
      if is_pressed then
	is_down <- true;
      self#need_redraw

    method leave_notify =
      is_in <- false;
      if is_pressed then
	is_down <- false;
      self#need_redraw

    method button_press b p m =
      if b = 1 then
	begin
	  is_pressed <- true;
	  is_down <- true;
	  self#need_redraw
	end
      else
	super#button_press b p m

    method button_release b p m =
      if b = 1 then
	begin
	  if is_down && is_pressed then self#clicked;
	  is_pressed <- false;
	  is_down <- false;
	  self#need_redraw
	end
      else
	super#button_release b p m

    method clicked =
      self#post_event `ButtonClicked

    initializer
      let _ = self#request_notify ButtonNotify
      and _ = self#request_notify CrossingNotify in
	self#set_bg style#bg;
	self#bind_key (1, 0, (Ws_key.Kchar 32)) (fun _ -> self#clicked; true)
  end

let on_click f =
  function
      `ButtonClicked -> f ()
    | _ -> ()

let create ?region ?text ?label ?pos ?size ?onclick parent =
  let style = parent#get_app#style in
  let bs = style#button_style in
  let (bt : events t) = new t parent bs
  and set_opt f = function Some x -> f x | _ -> () in
    set_opt bt#set_pos pos;
    set_opt (fun f -> bt#connect (on_click f)) onclick;
    begin
      match text with
	  Some t -> bs#set_label (style#button_textlabel t)
	| None -> set_opt bs#set_label label
    end;
    set_opt bt#set_region region;
    if region = None then begin
      match size with
	  Some x -> bt#set_size x
	| None -> bt#set_size (bs#size_hint)
    end;
    bt