------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- events.sa: Event classes
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>

-- Please see the file "Documenation"
-- Classes
-- $TK_EVENT       - generic event
-- TK_EVENT_INCL   - Code and modifiers common to all events
-- TK_EVENT        - Standard mouse and window events
-- TK_BUTTON_EVENT - Mouse button related events
-- TK_KEY_EVENT    - Key related events
----------------------- EVENTS and EVENT MODIFIERS --------------
abstract class $TK_EVENT is
    -- Events consist of 
    --   Event + modifiers + detail
    -- Events fall into three categories
    --   standard events (EVENT)
    --   mouse button events (BUTTON_EVENT)
    --   keyboard events (KEY_EVENT)
    -- All types of events share the same set of modifiers in common
    -- but different types of detail and actual events
    -- Modifiers are essentially preconditions that must be satisfied
    -- along with the event.
    
    -- Only the event need be specified; the rest is optional
    -- 
    -- Examples:
    --   BUTTON_EVENT::Press.double+1 = Double click on mouse button 1 
    --   BUTTON_EVENT::Press+1        = Single click on mouse button 1 
    --   KEY_EVENT::Press.Meta.Control+'d'
    --                                = meta and control and the letter 'd'
    --   EVENT::Motion.Mouse_1        = Mouse motion while button 1 is pressed
    --   EVENT::Widget_enter          = Mouse entering a widget
    -- 
    -- There are shortcuts for the common mouse events
    --   BUTTON_EVENT::B1                 =
    --              BUTTON_EVENT::Press+1 = Click on mouse button 1 
    --  BUTTON_EVENT::B2                  =
    --              BUTTON_EVENT::Press+2 = Click on mouse button 2 
    -- 

   str: STR;
    -- String that specifies the event to tk
    
    cb_str: STR;
    -- String used to specify information for the callback
    -- Not yet specified for all events
    
end;
-------------------------------------------------------------------
immutable class TK_EVENT_INFO is
   -- Information about an event. Created from the argument string.
   -- This should really be part of an even hierarchy.
    --  Implementation detail: Remember that the window id gets added onto
    --  the beginning of the callback string. Offset all args by 1
    -- 
    --  Please see
    -- http://www.icsi.berkeley.edu/~sather/Documentation/Gui/TclTkDocs/TkCmd/bind.n.html
    -- 
    -- 0 = window id 
    -- # = 1
    -- a b c d = 2 3 4 5
    -- f h k m = 6 7 8 9
    -- o p s t = 10 11 12 13
    -- w       = 14
   --  x y A B = 15 16 17 18
    -- E K N R = 18 19 20 21
    -- T W X Y = 22 23 24 25
   
    shared debug: BOOL := true;
    private attr args: ARRAY{STR};
    
    create(args: ARRAY{STR}): SAME is
	-- Create from the array of arguments that comes back from tcl
	-- #ERR+"Num args:"+args.size+" Args:"+args.str+"\n";
	res: SAME;
	return res.args(args);
    end;
    
    str: STR is 
	-- Return the args as a single string
      res ::= "Num args:"+args.size+" args:"+args.str+"\n";
      res := "Is valid key:"+has_key+"\n";
      if has_key then
	 res := res+"Key:"+key+"\n";
      end;
      res := res+"Is valid button:"+has_button_number+"\n";
      if has_button_number then
	 res := res+"Button number:"+button_number+"\n";
      end;
      if has_coordinates then
	 x,y:INT;
	 mouse_coordinates(out x,out y);
	 res := res+"Mouse coordinates:"+x+","+y+"\n";
      end;
      return res;
    end;
    
    has_button_number: BOOL is return valid(args[3]) end;
    button_number: INT pre has_button_number is  
      -- #ERR+"Button string:"+args[3];
	return args[3].cursor.int; 
    end;
    
    has_coordinates: BOOL is return valid(args[15]) and valid(args[16]); end;
    mouse_coordinates(out x,out y: INT) is
	x := args[15].cursor.int;
	y := args[16].cursor.int;
    end;
    
    has_key:BOOL is return valid_ascii(args[17]); end;
    key:CHAR pre has_key is 
      return args[17][1]; 
    end;
   
    private valid(s: STR): BOOL is
	-- Return true if the field is valid, i.e. the first character
	-- is not the @ sign. Use valid_ascii for that field
	return (s[0] /= '@');
    end;
    
    private valid_ascii(s: STR): BOOL is
	-- Return true if the field is valid, i.e. the first character
	-- is not the @ sign. The second character then holds the actual char
	-- Specially for the %A field. May be needed for other fields that
	-- can return an @ sign as a valid value
	return (s[0] = '&')
    end;
    
    private deb(msg: STR): BOOL is
	-- If checking is on, and the debug flag is set, the message will be
	-- printed
	if debug then #ERR+msg+"\n"; end;
	return true;
    end;
end;
-------------------------------------------------------------------
immutable class TK_EVENT_INCL is
    -- Used by inclusion in all events.
    -- All modifiers are specified here
    private attr internal_str: STR;
    private attr detail: STR;
    private attr has_detail: BOOL; -- By default detail is not specified

    private const default_cb: STR  := "@# @a @b @c @d @f @h @k @m @o @p @s @t @w @x @y @@A @B @E @K @N @R @T @W @X @Y";
    -- No callback info until a string is actualy set, no information is provided
    
    str: STR is 
	-- Return the string that Tcl needs to describe this event
	if void(detail) or detail.size = 0 then
	    return "<"+internal_str+">"; 
	else return "<"+internal_str+"-"+detail+">";  end;
    end;
    
    private create(s: STR): SAME is
	-- Should not be created directly, but by one of the other
	-- calls.
	res:SAME;
	return res.internal_str(s);
    end;
    
    private set_detail(s: STR): SAME is
	-- Set the detail field of this event.
	verify_non_void(s);
	if has_detail then raise "Detail already specified!\n"; end;
	return detail(s).has_detail(true) 
    end;
    
    private prepend(c: STR): SAME is
	-- Prepend some new modifier
	verify_non_void(c);
	return internal_str(c+"-"+internal_str);
    end;
    
    -- Modification routines. Self must already be created
    Control:SAME is return prepend("Control") end;
    -- Event Modifier: hold down the control key as well to trigger the
    -- event
    
    Meta:SAME is return prepend("Meta") end;
    -- Event Modifier: hold down the meta key as well to trigger the
    -- event
    
    Shift:SAME is return prepend("Shift") end;
    -- Event Modifier: hold down the shift key as well to trigger the
    -- event
    
   
    Alt:SAME is return prepend("Alt") end;
    -- Event Modifier: hold down the alt key as well to trigger the
    -- event
    
    Caps_lock:SAME is return prepend("Lock") end;   --  lock,any are pSather
    -- Event Modifier: hold down the caps lock key as well to trigger the
    -- event
   
    Ignore_others:SAME is return prepend("Any") end; -- keywords
    
    Double:SAME is return prepend("Double") end;
    -- Double occurrence of the same event, usually a click
    
    Triple:SAME is return prepend("Triple") end;
    
    -- Note: Events that the following modifiers refer to HOLDING the mouse
    -- down during the event and are rarely useful
    
    Mouse_1:SAME is return prepend("Button1") end;
    -- Modifier: while mouse button 1 is being held down
    
    Mouse_2:SAME is return prepend("Button2") end;
    Mouse_3:SAME is return prepend("Button3") end;
    
    
    private verify_non_void(c: STR) is
	-- Make sure that an event is set
	if void(internal_str) then 
	    raise "Must specify an event before adding a modifier:"+c;
	end;
    end;
end;
-------------------------------------------------------------------
immutable class TK_EVENT < $TK_EVENT is
    -- Standard mouse and window events
    -- Eg: TK_EVENT::Widget_enter
    --     TK_EVENT::Widget_enter.Control
    --              (enter a widget when the control button is pressed)
    --     TK_EVENT::Visibility.Mouse_1(when a widget becomes visible and 
    --                 mouse button 1 is pressed)
    include TK_EVENT_INCL;
    
    private attr cb_stored: STR;
    -- String used to get the callback info from the widget
    
    cb_str: STR is 
	-- Return the callback specification string. Use the default string
	-- until strings have been provided for all event types
	if void(cb_stored) then return default_cb else return cb_stored end; 
    end;
    
    private cb(s: STR): SAME is
	-- Set the callback string for this event (void otherwise)
	return cb_stored(s);
    end;
    
    -- Creation routines
    Widget_enter: SAME is return #("Enter") end; -- Not  enter key!
    Motion: SAME is return #("Motion") end;
    Leave: SAME is return #("Leave") end;
    Visibility: SAME is return #("Visibility") end;
    Destroy: SAME is return #("Destroy") end;
    Expose: SAME is return #("Expose") end;
    
end;
-------------------------------------------------------------------
immutable class TK_BUTTON_EVENT < $TK_EVENT is
    -- Mouse button related events
    -- Egs:
    -- The common mouse button events can be specified by
    --   TK_BUTTON_EVENT::B1          Click with mouse button 1
    --   TK_BUTTON_EVENT::B1.Double   Double click with mouse button 1
    -- In general:
    --   TK_BUTTON_EVENT::Press+1      Press mouse button 1
    --   TK_BUTTON_EVENT::Release+2    Release mouse button 2
    --   TK_BUTTON_EVENT::Press.Double+1  Double press (click) button 1
    
    include TK_EVENT_INCL;
    
    const cb_str: STR := "%# @a %b @c @d @f @h @k @m @o @p %s @t @w %x %y @@A @B @E @K @N @R @T @W %X %Y";
    -- Same callback string for all button events
    
    -- Creation routines
    Press: SAME is return #("ButtonPress") end;
    -- Event Creation: Mouse Button press event
    
    Release: SAME is return #("ButtonRelease") end;
    -- Event Creation: Mouse Button release event
    
    B1: SAME is return #SAME("1").has_detail(true) end;
    -- Event Creation: Mouse Button 1 press
    B2: SAME is return #SAME("2").has_detail(true) end;
    B3: SAME is return #SAME("3").has_detail(true) end;
    
    -- Modification routines
    plus(i: INT): SAME pre i >0 and i <= 5 is
	-- Add on a detail field onto the event, indicating which button
	-- (i). An error if you do this twice or call it after calling
	-- one of B1, B2 or B3
	return set_detail(i.str);
    end;
    
end;
-------------------------------------------------------------------
immutable class TK_KEY_EVENT < $TK_EVENT is
    -- Keyboard key related events. Can be used to indicate pressing a 
    -- particular key.
    -- Eg:
    --   TK_KEY_EVENT::Press.Return  Hit the return key
    --   TK_KEY_EVENT::Release.Tab   Release the tab key
    --   TK_KEY_EVENT::Press+'c'     Hit the character "c"
    include TK_EVENT_INCL;
    
    private attr cb_stored: STR;
    -- String used to get the callback info from the widget

   const cb_str: STR := "%# @a @b @c @d @f @h %k @m @o @p %s @t @w %x %y &%A @B @E %K @N @R %T %W %X %Y";
   
    -- Creation routines
    Press: SAME is return #("KeyPress") end;
    Release: SAME is return #("KeyRelease") end;
    
    -- Modification routines
    plus(c: CHAR): SAME pre c.is_alphanum is
	-- Detail field. Only works for alphnumeric keys
	verify_non_void(c.str);
	
	return detail(c.str).has_detail(true);
    end;
    
    -- Common key events that correspond to special (non alpha-numeric) keys
    -- Look at /usr/include/keysymdef.h
    Return: SAME is return set_detail("Return") end;
    Backspace: SAME is return set_detail("BackSpace") end;
    Tab: SAME is return set_detail("Tab") end;
    Linefeed: SAME is return set_detail("Linefeed") end;
    Pause: SAME is return set_detail("Pause") end;
    ScrollLock: SAME is return set_detail("Scroll_Lock") end;
    Escape: SAME is return set_detail("Escape") end;
    Delete: SAME is return set_detail("Delete") end;
    Home: SAME is return set_detail("Home") end;
    Left: SAME is return set_detail("Left") end;
    Right: SAME is return set_detail("Right") end;
    Prior: SAME is return set_detail("Prior") end;
    Up: SAME is return set_detail("Up") end;
    Down: SAME is return set_detail("Down") end;
    
    Function(n: INT): SAME
      pre n > 0 and n < 13
    is
	return set_detail("F"+n.str) 
    end;
    
    Dollar: SAME is return set_detail("dollar") end;
    Space: SAME is return set_detail("space") end;
    Exclamation: SAME is return set_detail("exclam") end;
    Percent: SAME is return set_detail("percent") end;
    Ampersand: SAME is return set_detail("ampersand") end;
    Apostrophe: SAME is return set_detail("apostrophe") end;
    ParenLeft: SAME is return set_detail("parenleft") end;
    ParenRight: SAME is return set_detail("parenright") end;
    Asterisk: SAME is return set_detail("asterisk") end;
    Plus: SAME is return set_detail("plus") end;
    Quoteright: SAME is return set_detail("quoteright") end;
    Comma: SAME is return set_detail("comma") end;
    Minus: SAME is return set_detail("minus") end;
    Period: SAME is return set_detail("period") end;
    Slash: SAME is return set_detail("slash") end;
    BracketLeft: SAME is return set_detail("bracketleft") end;
    BracketRight: SAME is return set_detail("bracketright") end;
    Backslash: SAME is return set_detail("backslash") end;
    Underscore: SAME is return set_detail("underscore") end;
    Grave: SAME is return set_detail("grave") end;
    BraceLeft: SAME is return set_detail("braceleft") end;
    BraceRight: SAME is return set_detail("braceright") end;
   
end; -- class TK_KEY_EVENT
-------------------------------------------------------------------
