Re: [Caml-list] Re: Feeding the OCaml GUI troll

[Ville-Pertti Keinonen <will@exomi.com>]

[-- Attachment #1: Type: text/plain, Size: 1732 bytes --]

On Thu, 2005-09-01 at 23:15 +1000, skaller wrote:

> I am. My idea is this: GET RID OF CALLBACKS.
> The idea is to use (user space) threads instead.
> 
> The big problem with GUI's is that they're passive.
> You write 'event handlers' and have to store the current
> state manually. By control inverting the code, you can
> just use a thread for each widget.

Have you actually done this in a GUI context, or do you just find it
conceptually attractive?

I've experimented with GUI concepts and event mechanisms in OCaml, and
created an event mechanism that could relatively easily be used in a
sort-of control inverted form by manually wrapping things into
continuations.  I never ended up making use of that form of events for
the actual low-level GUI functionality, because it always seemed easier
to just use methods or attach callbacks to events and use explicit
state.  Now that could simply be because I was sort-of porting a GUI
library that I had written earlier (in C++ and Scheme) and I'm rather
used to GUI mechanisms layered around inheritance (one of the few places
where it actually seems natural to me).

> For example for a button something like:
> 
> 	let rec wait_down () =
  ...

> 	and wait_up () =
  ...

> is purely functional: it uses the program counter
> to maintain state, instead of a mutable state variable.

But consider that the state of a button isn't quite that simple.
Tracking the state explicitly isn't difficult - attached is an actual
push button class implementation in a traditional imperative/OO style.

There's 3 boolean variables (8 states, although half of them are
impossible) tracked locally by the simplest stateful widget.  It also
has keyboard focus state, tracked by a superclass.


[-- Attachment #2: ws_button.ml --]
[-- Type: text/plain, Size: 2262 bytes --]

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